sundials-2.5.0/0000755000175000017500000000000011767174700014234 5ustar sylvestresylvestresundials-2.5.0/INSTALL_NOTES0000600000175000017500000005014311741421110016206 0ustar sylvestresylvestre SUNDIALS Installation Instructions Release 2.7.0, March 2011 These are generic installation instructions. For complete installation instructions, consult the user guide for any of the SUNDIALS solvers. Contents: [A] Preliminaries A.1. Libraries and exported headers [B] autotools-based installation B.1. Basic Installation B.2. Installation names B.3. Compilers and Options B.3.1. General options B.3.2. Options for Fortran support B.3.3. Options for Blas/Lapack support B.3.4. Options for MPI support B.3.5. Options for library support B.3.6. Environment variables B.4. Configuration examples [C] CMake-based installation C.1. Prerequisites C.2. Configuration and build ================ A. Preliminaries ================ The SUNDIALS suite (or an individual solver) is distributed as a compressed archive (.tar.gz). The name of the distribution archive is of the form 'solver'-x.y.z.tar.gz, where 'solver' is one of: 'sundials', 'cvode', 'cvodes', 'ida', 'idas', or 'kinsol', and x.y.z represents the version number (of the SUNDIALS suite or of the individual solver). To begin the installation, first uncompress and expand the sources, by issuing % tar xzf solver-x.y.z.tar.gz This will extract source files under a directory 'solver'-x.y.z. In the remainder of this chapter, we make the following distinctions: 'srcdir' is the directory 'solver'-x.y.z created above; i.e., the directory containing the SUNDIALS sources. 'builddir' is the directory under which SUNDIALS is built; i.e., the directory from within which the configure or ccmake command is issued. NOTE: When using the autoconf configure script, this directory can be the same as 'srcdir'. However, when using ccmake, insource builds are prohibited. 'instdir' is the directory under which the SUNDIALS exported header files and libraries will be installed. Typically, header files are exported under a directory 'instdir'/include while libraries are installed under 'instdir'/lib, with 'instdir' specified with the --prefix flag to configure. See below for more details on the installation directories, including the special cases of the SUNDIALS examples. NOTE: The installation directory 'instdir' should NOT be the same as the source directory 'srcdir'. SUNDIALS provides two build alternatives: 1) autotools-based build system. This options, suitable for *nix systems (Linux, Unix, Mac OS X, cygwin, mingw, etc.) is based on running a 'configure' shell script which generates all required makefiles. 2) CMake-based build system. This option is available on a variety of platforms (*nix, Windows, Mac OS, etc) but relies on additional software (freely available CMake). ----------------------------------- A.1. Libraries and exported headers ----------------------------------- By default, 'make install' will install the SUNDIALS libraries under 'libdir' and the public header files under 'includedir'. The default values for these directories are 'instdir'/lib and 'instdir'/include, respectively, but can be changed at the configuration stage. The SUNDIALS libraries and header files are summarized below (names are relative to 'libdir' for libraries and to 'includedir' for header files) SHARED module header files: sundials/sundials_types.h sundials/sundials_math.h sundials/sundials_config.h sundias/sundials_nvector.h sundials/sundials_smalldense.h sundials/sundials_dense.h sundials/sundials_iterative.h sundials/sundials_band.h sundials/sundials_spbcgs.h sundials/sundials_sptfqmr.h sundials/sundials_spgmr.h sundials/sundials_lapack.h sundials/sundials_fnvector.h NVECTOR_SERIAL module libraries: libsundials_nvecserial.{a,so} libsundials_fnvecserial.a header files: nvector/nvector_serial.h NVECTOR_PARALLEL module libraries: libsundials_nvecparallel.{a,so} libsundials_fnvecparallel.a header files: nvector/nvector_parallel.h CVODE module libraries: libsundials_cvode.{a,so} libsundials_fcvode.a header files: cvode/cvode.h cvode/cvode_direct.h cvode/cvode_dense.h cvode/cvode_band.h cvode/cvode_diag.h cvode/cvode_spils.h cvode/cvode_bandpre.h cvode/cvode_bbdpre.h cvode/cvode_spgmr.h cvode/cvode_spbcgs.h cvode/cvode_sptfqmr.h cvode/cvode_impl.h cvode/cvode_lapack.h CVODES module library: libsundials_cvodes.{a,so} header files: cvodes/cvodes.h cvodes/cvodes_direct.h cvodes/cvodes_dense.h cvodes/cvodes_band.h cvodes/cvodes_diag.h cvodes/cvodes_spils.h cvodes/cvodes_bandpre.h cvodes/cvodes_bbdpre.h cvodes/cvodes_spgmr.h cvodes/cvodes_spbcgs.h cvodes/cvodes_sptfqmr.h cvodes/cvodes_impl.h cvodes/cvodes_lapack.h IDA module library: libsundials_ida.{a,so} header files: ida/ida.h ida/ida_direct.h ida/ida_dense.h ida/ida_band.h ida/ida_spils.h ida/ida_spgmr.h ida/ida_spbcgs.h ida/ida_sptfqmr.h ida/ida_bbdpre.h ida/ida_impl.h ida/dia_lapack.h IDAS module library: libsundials_idas.{a,so} header files: idas/idas.h idas/idas_direct.h idas/idas_dense.h idas/idas_band.h idas/idas_spils.h idas/idas_spgmr.h idas/idas_spbcgs.h idas/idas_sptfqmr.h idas/idas_bbdpre.h idas/idas_impl.h idas/dia_lapack.h KINSOL module libraries: libsundials_kinsol.{a,so} libsundials_fkinsol.a header files: kinsol/kinsol.h kinsol/kinsol_dense.h kinsol/kinsol_band.h kinsol/kinsol_spils.h kinsol/kinsol_spgmr.h kinsol/kinsol_spbcgs.h kinsol/kinsol_sptfqmr.h kinsol/kinsol_bbdpre.h kinsol/kinsol_impl.h =============================== B. autotools-based installation =============================== ----------------------- B.1. Basic Installation ----------------------- The installation procedure outlined below will work on commodity Linux/Unix systems without modification. However, users are still encouraged to carefully read the entire chapter before attempting to install the SUNDIALS suite, in case non-default choices are desired for compilers, compilation options, or the like. Instead of reading the option list below, the user may invoke the configuration script with the help flag to view a complete listing of available options, which may be done by issuing % ./configure --help from within the 'srcdir' directory created above. The installation steps for SUNDIALS can be as simple as % tar xzf solver-x.y.z.tar.gz % cd solver-x.y.z % ./configure % make % make install in which case the SUNDIALS header files and libraries are installed under /usr/local/include and /usr/local/lib, respectively. Note that, by default, the example programs are not built and installed. If disk space is a priority, then to delete all temporary files created by building SUNDIALS, issue % make clean To prepare the SUNDIALS distribution for a new install (using, for example, different options and/or installation destinations), issue % make distclean ----------------------- B.2. Installation names ----------------------- By default, 'make install' will install the SUNDIALS libraries under 'libdir' and the public header files under 'includedir'. The default values for these directories are 'instdir'/lib and 'instdir'/include, respectively, but can be changed using the configure script options --prefix, --exec-prefix, --includedir, and --libdir (see below). For example, a global installation of SUNDIALS on a *NIX system could be accomplished using % ./configure --prefix=/opt/sundials-2.3.0 Although all installed libraries reside under 'libdir', the public header files are further organized into subdirectories under 'includedir'. The installed libraries and exported header files are listed for reference in Section A.1. A typical user program need not explicitly include any of the shared SUNDIALS header files from under the 'includedir'/sundials directory since they are explicitly included by the appropriate solver header files (e.g., cvode_dense.h includes sundials_dense.h). However, it is both legal and safe to do so (e.g., the functions declared in sundials_smalldense.h could be used in building a preconditioner. -------------------------- B.3. Compilers and Options -------------------------- Some systems require unusual options for compilation or linking that the `configure' script does not know about. Run `./configure --help' for details on some of the pertinent environment variables. You can give `configure' initial values for these variables by setting them in the environment. You can do that on the command line like this: % ./configure CC=gcc CFLAGS=-O2 F77=g77 FFLAGS=-O Here is a detailed description of the configure options that are pertinent to SUNDIALS. In what follows, 'build_tree' is the directory from where 'configure' was invoked. ---------------------- B.3.1. General options ---------------------- --help -h print a summary of the options to `configure', and exit. --quiet --silent -q do not print messages saying which checks are being made. To suppress all normal output, redirect it to `/dev/null' (any error messages will still be shown). --prefix=PREFIX Location for architecture-independent files. Default: PREFIX=/usr/local --exec-prefix=EPREFIX Location for architecture-dependent files. Default: EPREFIX=/usr/local --includedir=DIR Alternate location for header files. Default: DIR=PREFIX/include --libdir=DIR Alternate location for libraries. Default: DIR=EPREFIX/lib --disable-solver Although each existing solver module is built by default, support for a given solver can be explicitly disabled using this option. The valid values for solver are: cvode, cvodes, ida, and kinsol. --enable-examples Available example programs are not built by default. Use this option to enable compilation of all pertinent example programs. Upon completion of the 'make' command, the example executables will be created under solver-specific subdirectories of 'builddir'/examples: 'builddir'/examples/'solver'/serial : serial C examples 'builddir'/examples/'solver'/parallel : parallel C examples 'builddir'/examples/'solver'/fcmix_serial : serial Fortran examples 'builddir'/examples/'solver'/fcmix_parallel : parallel Fortran examples Note: Some of these subdirectories may not exist depending upon the solver and/or the configuration options given. --with-exinstdir=DIR Alternate location for example sources and sample output files (valid only if examples are enabled). Note that installtion of example files can be completely disabled by issuing DIR=no (in case building the examples is desired only as a test of the SUNDIALS libraries). Default: DIR=EPREFIX/examples --with-cppflags=ARG Specify C preprocessor flags (overrides the environment variable CPPFLAGS) (e.g., ARG=-I if necessary header files are located in nonstandard locations). --with-cflags=ARG Specify C compilation flags (overrides the environment variable CFLAGS) --with-ldflags=ARG Specify linker flags (overrides the environment variable LDFLAGS) (e.g., ARG=-L if required libraries are located in nonstandard locations). --with-libs=ARG Specify additional libraries to be used (e.g., ARG=-l to link with the library named libfoo.a or libfoo.so). --with-precision=ARG By default, sundials will define a real number (internally referred to as realtype) to be a double-precision floating-point numeric data type (double C-type); however, this option may be used to build sundials with realtype alternatively defined as a single-precision floating-point numeric data type (float C-type) if ARG=single, or as a long double C-type if ARG=extended. Default: ARG=double ---------------------------------- B.3.2. Options for Fortran support ---------------------------------- --disable-fcmix Using this option will disable all F77 support. The fcvode, fida, fkinsol and fnvector modules will not be built regardless of availability. --with-fflags=ARG Specify F77 compilation flags (overrides the environment variable FFLAGS) -------------------------------------- B.3.3. Options for Blas/Lapack support -------------------------------------- --disable-lapack Disable support for the linear solver module based on Blas/Lapack. --with-blas=ARG Specifies the BLAS library to be used --with-lapack=ARG Specifies the LAPACK library to be used ------------------------------ B.3.4. Options for MPI support ------------------------------ The following configuration options are only applicable to the parallel sundials packages: --disable-mpi Using this option will completely disable MPI support. --with-mpicc=ARG --with-mpif77=ARG By default, the configuration utility script will use the MPI compiler scripts named mpicc and mpif77 to compile the parallelized sundials subroutines; however, for reasons of compatibility, different executable names may be specified via the above options. Also, ARG=no can be used to disable the use of MPI compiler scripts, thus causing the serial C and F compilers to be used to compile the parallelized sundials functions and examples. --with-mpi-root=MPIDIR This option may be used to specify which MPI implementation should be used. The sundials configuration script will automatically check under the subdirectories MPIDIR/include and MPIDIR/lib for the necessary header files and libraries. The subdirectory MPIDIR/bin will also be searched for the C and F MPI compiler scripts, unless the user uses --with-mpicc=no or --with-mpif77=no. --with-mpi-incdir=INCDIR --with-mpi-libdir=LIBDIR --with-mpi-libs=LIBS These options may be used if the user would prefer not to use a preexisting MPI compiler script, but instead would rather use a serial complier and provide the flags necessary to compile the MPI-aware subroutines in sundials. Often an MPI implementation will have unique library names and so it may be necessary to specify the appropriate libraries to use (e.g., LIBS=-lmpich). Default: INCDIR=MPIDIR/include, LIBDIR=MPIDIR/lib and LIBS=-lmpi --with-mpi-flags=ARG Specify additional MPI-specific flags. ---------------------------------- B.3.5. Options for library support ---------------------------------- By default, only static libraries are built, but the following option may be used to build shared libraries on supported platforms. --enable-shared Using this particular option will result in both static and shared versions of the available sundials libraries being built if the systsupports shared libraries. To build only shared libraries also specify --disable-static. Note: The fcvode and fkinsol libraries can only be built as static libraries because they contain references to externally defined symbols, namely user-supplied F77 subroutines. Although the F77 interfaces to the serial and parallel implementations of the supplied nvector module do not contain any unresolvable external symbols, the libraries are still built as static libraries for the purpose of consistency. ---------------------------- B.3.6. Environment variables ---------------------------- The following environment variables can be locally (re)defined for use during the configuration of sundials. See the next section for illustrations of these. CC F77 Since the configuration script uses the first C and F77 compilers found in the current executable search path, then each relevant shell variable (CC and F77) must be locally (re)defined in order to use a different compiler. For example, to use xcc (executable name of chosen compiler) as the C language compiler, use CC=xcc in the configure step. CFLAGS FFLAGS Use these environment variables to override the default C and F77 compilation flags. --------------------------- B.4. Configuration examples --------------------------- The following examples are meant to help demonstrate proper usage of the configure options. To build SUNDIALS using the default C and Fortran compilers, and default mpicc and mpif77 parallel compilers, enable compilation of examples, and install them under the default directory /home/myname/sundials/examples, use % ./configure --prefix=/home/myname/sundials --enable-examples To disable installation of the examples, use: % ./configure --prefix=/home/myname/sundials \ --enable-examples --with-examples-instdir=no The following example builds SUNDIALS using gcc as the serial C compiler, g77 as the serial Fortran compiler, mpicc as the parallel C compiler, mpif77 as the parallel Fortran compiler, and uses the -g3 C compilation flag: % ./configure CC=gcc F77=g77 --with-cflags=-g3 --with-fflags=-g3 \ --with-mpicc=/usr/apps/mpich/1.2.4/bin/mpicc \ --with-mpif77=/usr/apps/mpich/1.2.4/bin/mpif77 The next example again builds SUNDIALS using gcc as the serial C compiler, but the --with-mpicc=no option explicitly disables the use of the corresponding MPI compiler script. In addition, since the --with-mpi-root option is given, the compilation flags -I/usr/apps/mpich/1.2.4/include and -L/usr/apps/mpich/1.2.4/lib are passed to gcc when compiling the MPI-enabled functions. The --disable-examples option explicitly disables the examples. The --with-mpi-libs option is required so that the configure script can check if gcc can link with the appropriate MPI library. % ./configure CC=gcc --disable-examples --with-mpicc=no \ --with-mpi-root=/usr/apps/mpich/1.2.4 \ --with-mpi-libs=-lmpich =========================== C. CMake-based installation =========================== Using CMake as a build system for the SUNDIALS libraries has the advantage that GUI based build configuration is possible. Also build files for Windows development environments can be easily generated. On the Windows platform compilers such as the Borland C++ compiler or Visual C++ compiler are natively supported. The installation options are very similar to the options mentioned above. Note, however, that CMake may not support all features and plattforms that are supported by the autotools build system. ------------------ C.1. Prerequisites ------------------ You may need to get CMake if it isn't available on your system already. In order to use the CMake build system, you need a fairly recent CMake version. You can download it from http://www.cmake.org www.cmake.org. ---------------------------- C.2. Configuration and build ---------------------------- We assume here a *nix system. For other systems, the required steps are very similar and are explained in more detail in the SUNDIALS user guides. The installation steps are as follows: - uncompress solver-x.y.z.tar.gz to obtain 'srcdir' - create the directories 'builddir' and 'instdir' - change directory to 'builddir' - run ccmake with 'srcdir' as an argument You should now see the ccmake curses interface. Press 'c' to configure your build with the default options. (If you don't have curses on your system and cannot use ccmake, you can configure cmake with command line options very similar to ./configure of the autotools. You can read about this on the cmake webpage.) In the dialog you can adjust the build options. For details see the options above in the autotools section. To adjust advanced options press 't' to show all the options and settings CMake offers. After adjusting some options, for instance enabling the examples by turning ENABLE_EXAMPLES to ON, you need to press 'c' again. Depending on the options, you will see new options at the top of the list, marked with a star. After adjusting the new options, press 'c' again. Once all options have been set, you can press 'g' to generate the make files. Now you can build and install the sundials library: % make % make install sundials-2.5.0/CMakeLists.txt0000600000175000017500000006036011741421110016747 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.10 $ # $Date: 2010/12/15 22:28:16 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # Top level CMakeLists.txt for SUNDIALS (for cmake build system) # ------------------------------------------------------------- # Initial commands # ------------------------------------------------------------- # Require a fairly recent cmake version CMAKE_MINIMUM_REQUIRED(VERSION 2.2) # Project SUNDIALS (initially only C supported) PROJECT(sundials C) # Set some variables with info on the SUNDIALS project SET(PACKAGE_BUGREPORT "radu@llnl.gov") SET(PACKAGE_NAME "SUNDIALS") SET(PACKAGE_STRING "SUNDIALS 2.4.0") SET(PACKAGE_TARNAME "sundials") SET(PACKAGE_VERSION "2.4.0") # Prohibit in-source build IF("${CMAKE_SOURCE_DIR}" STREQUAL "${CMAKE_BINARY_DIR}") MESSAGE(FATAL_ERROR "In-source build prohibited.") ENDIF("${CMAKE_SOURCE_DIR}" STREQUAL "${CMAKE_BINARY_DIR}") # Hide/show some cache variables MARK_AS_ADVANCED(EXECUTABLE_OUTPUT_PATH LIBRARY_OUTPUT_PATH) MARK_AS_ADVANCED(CLEAR CMAKE_C_COMPILER CMAKE_C_FLAGS CMAKE_C_FLAGS_DEBUG CMAKE_C_FLAGS_MINSIZEREL CMAKE_C_FLAGS_RELEASE CMAKE_C_FLAGS_RELWITHDEB) # Specify the VERSION and SOVERSION for shared libraries SET(cvodelib_VERSION "1.0.0") SET(cvodelib_SOVERSION "1") SET(cvodeslib_VERSION "2.0.0") SET(cvodeslib_SOVERSION "2") SET(idalib_VERSION "2.0.0") SET(idalib_SOVERSION "2") SET(idaslib_VERSION "0.0.0") SET(idaslib_SOVERSION "0") SET(kinsollib_VERSION "1.0.0") SET(kinsollib_SOVERSION "1") SET(cpodeslib_VERSION "0.0.0") SET(cpodeslib_SOVERSION "0") SET(nveclib_VERSION "0.0.2") SET(nveclib_SOVERSION "0") # Specify the location of additional CMAKE modules SET(CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/config) # ------------------------------------------------------------- # MACRO definitions # ------------------------------------------------------------- # Macros to hide/show cached variables. # These two macros can be used to "hide" or "show" in the # list of cached variables various variables and/or options # that depend on other options. # Note that once a variable is modified, it will preserve its # value (hidding it merely makes it internal) MACRO(HIDE_VARIABLE var) IF(DEFINED ${var}) SET(${var} "${${var}}" CACHE INTERNAL "") ENDIF(DEFINED ${var}) ENDMACRO(HIDE_VARIABLE) MACRO(SHOW_VARIABLE var type doc default) IF(DEFINED ${var}) SET(${var} "${${var}}" CACHE "${type}" "${doc}" FORCE) ELSE(DEFINED ${var}) SET(${var} "${default}" CACHE "${type}" "${doc}") ENDIF(DEFINED ${var}) ENDMACRO(SHOW_VARIABLE) # Macros to append a common suffix or prefix to the elements of a list MACRO(ADD_SUFFIX rootlist suffix) SET(outlist ) FOREACH(root ${${rootlist}}) LIST(APPEND outlist ${root}${suffix}) ENDFOREACH(root) SET(${rootlist} ${outlist}) ENDMACRO(ADD_SUFFIX) MACRO(ADD_PREFIX prefix rootlist) SET(outlist ) FOREACH(root ${${rootlist}}) LIST(APPEND outlist ${prefix}${root}) ENDFOREACH(root) SET(${rootlist} ${outlist}) ENDMACRO(ADD_PREFIX) # Macro to print warning that some features will be disabled # due to some failure. MACRO(PRINT_WARNING message action) MESSAGE("WARNING: ${message}.\n ${action}.") ENDMACRO(PRINT_WARNING) # Returns an unquoted string. Note that CMake will readily turn such # strings back into lists, due to the duality of lists and # semicolon-separated strings. So be careful how you use it. MACRO(LIST2STRING alist astring) FOREACH(elem ${${alist}}) SET(${astring} "${${astring}} ${elem}") ENDFOREACH(elem) ENDMACRO(LIST2STRING) # ------------------------------------------------------------- # Which modules to build? # ------------------------------------------------------------- # For each SUNDIALS solver available (i.e. for which we have the # sources), give the user the option of enabling/disabling it. IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvode") OPTION(BUILD_CVODE "Build the CVODE library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvode") SET(BUILD_CVODE OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvode") IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvodes") OPTION(BUILD_CVODES "Build the CVODES library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvodes") SET(BUILD_CVODES OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cvodes") IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/ida") OPTION(BUILD_IDA "Build the IDA library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/ida") SET(BUILD_IDA OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/ida") IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/idas") OPTION(BUILD_IDAS "Build the IDAS library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/idas") SET(BUILD_IDAS OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/idas") IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/kinsol") OPTION(BUILD_KINSOL "Build the KINSOL library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/kinsol") SET(BUILD_KINSOL OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/kinsol") IF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cpodes") OPTION(BUILD_CPODES "Build the CPODES library" ON) ELSE(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cpodes") SET(BUILD_CPODES OFF) ENDIF(IS_DIRECTORY "${sundials_SOURCE_DIR}/src/cpodes") # ------------------------------------------------------------- # Other configuration options # ------------------------------------------------------------- # Option that allows users to build static and/or shared libraries # ---------------------------------------------------------------- OPTION(BUILD_STATIC_LIBS "Build static libraries" ON) OPTION(BUILD_SHARED_LIBS "Build shared libraries" OFF) # Prepare substitution variable SUNDIALS_EXPORT for sundials_config.h # When building shared SUNDIALS libraries under Windows, use # #define SUNDIALS_EXPORT __declspec(dllexport) # When linking to shared SUNDIALS libraries under Windows, use # #define SUNDIALS_EXPORT __declspec(dllimport) # In all other cases (other platforms or static libraries # under Windows), the SUNDIALS_EXPORT macro is empty IF(BUILD_SHARED_LIBS AND WIN32) SET(SUNDIALS_EXPORT "#ifdef BUILD_SUNDIALS_LIBRARY #define SUNDIALS_EXPORT __declspec(dllexport) #else #define SUNDIALS_EXPORT __declspec(dllimport) #endif") ELSE(BUILD_SHARED_LIBS AND WIN32) SET(SUNDIALS_EXPORT "#define SUNDIALS_EXPORT") ENDIF(BUILD_SHARED_LIBS AND WIN32) # Make sure we build at least one type of libraries IF(NOT BUILD_STATIC_LIBS AND NOT BUILD_SHARED_LIBS) PRINT_WARNING("Both static and shared library generation were disabled" "Building static libraries was re-enabled") SET(BUILD_STATIC_LIBS ON CACHE BOOL "Build static libraries" FORCE) ENDIF(NOT BUILD_STATIC_LIBS AND NOT BUILD_SHARED_LIBS) # Option to specify precision # --------------------------- SET(SUNDIALS_PRECISION "double" CACHE STRING "double, single or extended") # prepare substitution variable PRECISION_LEVEL for sundials_config.h STRING(TOUPPER ${SUNDIALS_PRECISION} SUNDIALS_PRECISION) SET(PRECISION_LEVEL "#define SUNDIALS_${SUNDIALS_PRECISION}_PRECISION 1") # Option to use the generic math libraries (UNIX only) # ---------------------------------------------------- IF(UNIX) OPTION(USE_GENERIC_MATH "Use generic (std-c) math libraries" ON) IF(USE_GENERIC_MATH) # executables will be linked against -lm SET(EXTRA_LINK_LIBS -lm) # prepare substitution variable GENERIC_MATH_LIB for sundials_config.h SET(GENERIC_MATH_LIB "#define SUNDIALS_USE_GENERIC_MATH") ENDIF(USE_GENERIC_MATH) ENDIF(UNIX) # ------------------------------------------------------------- # Enable Fortran support? # ------------------------------------------------------------- # FCMIX support is an option only if at least one solver that # provides such an interface is built. IF(BUILD_CVODE OR BUILD_IDA OR BUILD_KINSOL) SHOW_VARIABLE(FCMIX_ENABLE BOOL "Enable Fortran-C support" OFF) ELSE(BUILD_CVODE OR BUILD_IDA OR BUILD_KINSOL) HIDE_VARIABLE(FCMIX_ENABLE) ENDIF(BUILD_CVODE OR BUILD_IDA OR BUILD_KINSOL) # ------------------------------------------------------------- # Enable BLAS/LAPACK support? # ------------------------------------------------------------- OPTION(LAPACK_ENABLE "Enable Lapack support" OFF) IF(NOT LAPACK_ENABLE) HIDE_VARIABLE(SUNDIALS_F77_FUNC_CASE) HIDE_VARIABLE(SUNDIALS_F77_FUNC_UNDERSCORES) HIDE_VARIABLE(LAPACK_LIBRARIES) ENDIF(NOT LAPACK_ENABLE) # ------------------------------------------------------------- # Enable MPI support? # ------------------------------------------------------------- OPTION(MPI_ENABLE "Enable MPI support" OFF) IF(NOT MPI_ENABLE) HIDE_VARIABLE(MPI_INCLUDE_PATH) HIDE_VARIABLE(MPI_LIBRARIES) HIDE_VARIABLE(MPI_EXTRA_LIBRARIES) HIDE_VARIABLE(MPI_MPICC) HIDE_VARIABLE(MPI_MPIF77) ENDIF(NOT MPI_ENABLE) # ------------------------------------------------------------- # Enable examples? # ------------------------------------------------------------- OPTION(EXAMPLES_ENABLE "Build the SUNDIALS examples" OFF) IF(EXAMPLES_ENABLE) # If examples are enabled, set different options # The examples will be linked with the library corresponding to the build type. # Whenever building shared libraries, use them to link the examples. IF(BUILD_SHARED_LIBS) SET(LINK_LIBRARY_TYPE "shared") ELSE(BUILD_SHARED_LIBS) SET(LINK_LIBRARY_TYPE "static") ENDIF(BUILD_SHARED_LIBS) # Check if example files are to be exported SHOW_VARIABLE(EXAMPLES_INSTALL BOOL "Install example files" ON) # If examples are to be exported, check where we should install them. IF(EXAMPLES_INSTALL) SHOW_VARIABLE(EXAMPLES_INSTALL_PATH STRING "Output directory for installing example files" "${CMAKE_INSTALL_PREFIX}/examples") IF(NOT EXAMPLES_INSTALL_PATH) PRINT_WARNING("The example installation path is empty" "Example installation path was reset to its default value") SET(EXAMPLES_INSTALL_PATH "${CMAKE_INSTALL_PREFIX}/examples" CACHE STRING "Output directory for installing example files" FORCE) ENDIF(NOT EXAMPLES_INSTALL_PATH) ELSE(EXAMPLES_INSTALL) HIDE_VARIABLE(EXAMPLES_INSTALL_PATH) ENDIF(EXAMPLES_INSTALL) ELSE(EXAMPLES_ENABLE) # If examples are disabled, hide all options related to # building and installing the SUNDIALS examples HIDE_VARIABLE(EXAMPLES_INSTALL) HIDE_VARIABLE(EXAMPLES_INSTALL_PATH) ENDIF(EXAMPLES_ENABLE) # ------------------------------------------------------------- # Add any other necessary compiler flags & definitions # ------------------------------------------------------------- # Under Windows, add compiler directive to inhibit warnings # about use of unsecure functions IF(WIN32) ADD_DEFINITIONS(-D_CRT_SECURE_NO_WARNINGS) ENDIF(WIN32) # ------------------------------------------------------------- # A Fortran compiler is needed if: # (a) FCMIX is enabled # (b) LAPACK is enabled (for the name-mangling scheme) # ------------------------------------------------------------- IF(FCMIX_ENABLE OR LAPACK_ENABLE) INCLUDE(SundialsFortran) IF(NOT F77_FOUND AND FCMIX_ENABLE) PRINT_WARNING("Fortran compiler not functional" "FCMIX support will not be provided") ENDIF(NOT F77_FOUND AND FCMIX_ENABLE) ENDIF(FCMIX_ENABLE OR LAPACK_ENABLE) # ------------------------------------------------------------- # Check if we need an alternate way of specifying the Fortran # name-mangling scheme if we were unable to infer it using a # compiler. # Ask the user to specify the case and number of appended underscores # corresponding to the Fortran name-mangling scheme of symbol names # that do not themselves contain underscores (recall that this is all # we really need for the interfaces to LAPACK). # Note: the default scheme is lower case - one underscore # ------------------------------------------------------------- IF(LAPACK_ENABLE AND NOT F77SCHEME_FOUND) # Specify the case for the Fortran name-mangling scheme SHOW_VARIABLE(SUNDIALS_F77_FUNC_CASE STRING "case of Fortran function names (lower/upper)" "lower") # Specify the number of appended underscores for the Fortran name-mangling scheme SHOW_VARIABLE(SUNDIALS_F77_FUNC_UNDERSCORES STRING "number of underscores appended to Fortran function names" "one") # Based on the given case and number of underscores, # set the C preprocessor macro definition IF(${SUNDIALS_F77_FUNC_CASE} MATCHES "lower") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "none") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "mysub") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "none") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "one") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "mysub_") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "one") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "two") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "mysub__") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "two") ELSE(${SUNDIALS_F77_FUNC_CASE} MATCHES "lower") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "none") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "MYSUB") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "none") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "one") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "MYSUB_") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "one") IF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "two") SET(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "MYSUB__") ENDIF(${SUNDIALS_F77_FUNC_UNDERSCORES} MATCHES "two") ENDIF(${SUNDIALS_F77_FUNC_CASE} MATCHES "lower") # Since the SUNDIALS codes never use symbol names containing # underscores, set a default scheme (probably wrong) for symbols # with underscores. SET(CMAKE_Fortran_SCHEME_WITH_UNDERSCORES "my_sub_") # We now "have" a scheme. SET(F77SCHEME_FOUND TRUE) ENDIF(LAPACK_ENABLE AND NOT F77SCHEME_FOUND) # ------------------------------------------------------------- # If we have a name-mangling scheme (either automatically # inferred or provided by the user), set the SUNDIALS # compiler preprocessor macro definitions. # ------------------------------------------------------------- SET(F77_MANGLE_MACRO1 "") SET(F77_MANGLE_MACRO2 "") IF(F77SCHEME_FOUND) # Symbols WITHOUT underscores IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) name") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub_") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) name ## _") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub_") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub__") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) name ## __") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "mysub__") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) NAME") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB_") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) NAME ## _") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB_") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB__") SET(F77_MANGLE_MACRO1 "#define SUNDIALS_F77_FUNC(name,NAME) NAME ## __") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MYSUB__") # Symbols with underscores IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) name") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub_") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) name ## _") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub_") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub__") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) name ## __") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "my_sub__") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) NAME") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB_") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## _") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB_") IF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB__") SET(F77_MANGLE_MACRO2 "#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## __") ENDIF(${CMAKE_Fortran_SCHEME_NO_UNDERSCORES} MATCHES "MY_SUB__") ENDIF(F77SCHEME_FOUND) # ------------------------------------------------------------- # Find (and test) the Lapack libraries # ------------------------------------------------------------- # If LAPACK is needed, first try to find the appropriate # libraries and linker flags needed to link against them. # Macro to be inserted in sundials_config.h SET(BLAS_LAPACK_MACRO "#define SUNDIALS_BLAS_LAPACK 0") IF(LAPACK_ENABLE) INCLUDE(SundialsLapack) IF(LAPACK_FOUND) SET(BLAS_LAPACK_MACRO "#define SUNDIALS_BLAS_LAPACK 1") ELSE(LAPACK_FOUND) SHOW_VARIABLE(LAPACK_LIBRARIES STRING "Lapack libraries" "${LAPACK_LIBRARIES}") SHOW_VARIABLE(LAPACK_LINKER_FLAGS STRING "Lapack required linker flags" "${LAPACK_LINKER_FLAGS}") ENDIF(LAPACK_FOUND) IF(LAPACK_LIBRARIES AND NOT LAPACK_FOUND) PRINT_WARNING("LAPACK not functional" "Blas/Lapack support will not be provided") ENDIF(LAPACK_LIBRARIES AND NOT LAPACK_FOUND) ELSE(LAPACK_ENABLE) HIDE_VARIABLE(LAPACK_LIBRARIES) HIDE_VARIABLE(LAPACK_LINKER_FLAGS) ENDIF(LAPACK_ENABLE) # ------------------------------------------------------------- # Decide how to compile MPI codes. # ------------------------------------------------------------- IF(MPI_ENABLE) INCLUDE(SundialsMPIC) IF(NOT MPIC_FOUND) PRINT_WARNING("MPI not functional" "Parallel support will not be provided") ENDIF(NOT MPIC_FOUND) IF(MPIC_MPI2) SET(F77_MPI_COMM_F2C "#define SUNDIALS_MPI_COMM_F2C 1") ELSE(MPIC_MPI2) SET(F77_MPI_COMM_F2C "#define SUNDIALS_MPI_COMM_F2C 0") ENDIF(MPIC_MPI2) IF(MPIC_FOUND AND FCMIX_ENABLE) INCLUDE(SundialsMPIF) ENDIF(MPIC_FOUND AND FCMIX_ENABLE) ENDIF(MPI_ENABLE) # ------------------------------------------------------------- # Configure the header file sundials_config.h # ------------------------------------------------------------- # All required substitution variables should be available at this point. # Generate the header file and place it in the binary dir. CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/include/sundials/sundials_config.in ${PROJECT_BINARY_DIR}/include/sundials/sundials_config.h ) # Add the include directory in the source tree and the one in # the binary tree (for the header file sundials_config.h) INCLUDE_DIRECTORIES(${PROJECT_SOURCE_DIR}/include ${PROJECT_BINARY_DIR}/include) # ------------------------------------------------------------- # Add selected modules to the build system # ------------------------------------------------------------- # Shared components ADD_SUBDIRECTORY(src/sundials) ADD_SUBDIRECTORY(src/nvec_ser) IF(MPIC_FOUND) ADD_SUBDIRECTORY(src/nvec_par) ENDIF(MPIC_FOUND) # CVODE library IF(BUILD_CVODE) ADD_SUBDIRECTORY(src/cvode) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(src/cvode/fcmix) ENDIF(FCMIX_ENABLE AND F77_FOUND) ENDIF(BUILD_CVODE) # CVODES library IF(BUILD_CVODES) ADD_SUBDIRECTORY(src/cvodes) ENDIF(BUILD_CVODES) # IDA library IF(BUILD_IDA) ADD_SUBDIRECTORY(src/ida) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(src/ida/fcmix) ENDIF(FCMIX_ENABLE AND F77_FOUND) ENDIF(BUILD_IDA) # IDAS library IF(BUILD_IDAS) ADD_SUBDIRECTORY(src/idas) ENDIF(BUILD_IDAS) # KINSOL library IF(BUILD_KINSOL) ADD_SUBDIRECTORY(src/kinsol) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(src/kinsol/fcmix) ENDIF(FCMIX_ENABLE AND F77_FOUND) ENDIF(BUILD_KINSOL) # CPODES library IF(BUILD_CPODES) ADD_SUBDIRECTORY(src/cpodes) ENDIF(BUILD_CPODES) # ------------------------------------------------------------- # Include the subdirectories corresponding to various examples # ------------------------------------------------------------- # If building and installing the examples is enabled, include # the subdirectories for those examples that will be built. # Also, if we will generate exported example Makefiles, set # variables needed in generating them from templates. IF(EXAMPLES_ENABLE) IF(EXAMPLES_INSTALL) SET(SHELL "sh") SET(prefix "${CMAKE_INSTALL_PREFIX}") SET(exec_prefix "${CMAKE_INSTALL_PREFIX}") SET(includedir "${prefix}/include") SET(libdir "${exec_prefix}/lib") SET(CPP "${CMAKE_C_COMPILER}") SET(CC "${CMAKE_C_COMPILER}") SET(CPPFLAGS "${CMAKE_C_FLAGS_RELEASE}") SET(CFLAGS "${CMAKE_C_FLAGS_RELEASE}") SET(LDFLAGS "${CMAKE_EXE_LINKER_FLAGS_RELEASE}") LIST2STRING(EXTRA_LINK_LIBS LIBS) IF(F77_FOUND) SET(F77 "${CMAKE_Fortran_COMPILER}") SET(F77_LNKR "${CMAKE_Fortran_COMPILER}") SET(FFLAGS "${CMAKE_Fortran_FLAGS_RELEASE}") SET(F77_LDFLAGS "${CMAKE_Fortran_FLAGS_RELEASE}") LIST2STRING(EXTRA_LINK_LIBS F77_LIBS) ENDIF(F77_FOUND) IF(LAPACK_FOUND) LIST2STRING(LAPACK_LIBRARIES BLAS_LAPACK_LIBS) SET(BLAS_LAPACK_LIBS "${LAPACK_LINKER_FLAGS} ${BLAS_LAPACK_LIBS}") ENDIF(LAPACK_FOUND) IF(MPIC_FOUND) IF(MPI_MPICC) SET(MPICC "${MPI_MPICC}") SET(MPI_INC_DIR ".") SET(MPI_LIB_DIR ".") SET(MPI_LIBS "") SET(MPI_FLAGS "") ELSE(MPI_MPICC) SET(MPICC "${CMAKE_C_COMPILER}") SET(MPI_INC_DIR "${MPI_INCLUDE_PATH}") SET(MPI_LIB_DIR ".") LIST2STRING(MPI_LIBRARIES MPI_LIBS) ENDIF(MPI_MPICC) ENDIF(MPIC_FOUND) IF(MPIF_FOUND) IF(MPI_MPIF77) SET(MPIF77 "${MPI_MPIF77}") SET(MPIF77_LNKR "${MPI_MPIF77}") ELSE(MPI_MPIF77) SET(MPIF77 "${CMAKE_Fortran_COMPILER}") SET(MPIF77_LNKR "${CMAKE_Fortran_COMPILER}") SET(MPI_INC_DIR "${MPI_INCLUDE_PATH}") SET(MPI_LIB_DIR ".") LIST2STRING(MPI_LIBRARIES MPI_LIBS) ENDIF(MPI_MPIF77) ENDIF(MPIF_FOUND) ENDIF(EXAMPLES_INSTALL) IF(BUILD_CVODE) ADD_SUBDIRECTORY(examples/cvode/serial) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(examples/cvode/fcmix_serial) ENDIF(FCMIX_ENABLE AND F77_FOUND) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/cvode/parallel) ENDIF(MPIC_FOUND) IF(MPIF_FOUND) ADD_SUBDIRECTORY(examples/cvode/fcmix_parallel) ENDIF(MPIF_FOUND) ENDIF(BUILD_CVODE) IF(BUILD_CVODES) ADD_SUBDIRECTORY(examples/cvodes/serial) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/cvodes/parallel) ENDIF(MPIC_FOUND) ENDIF(BUILD_CVODES) IF(BUILD_IDA) ADD_SUBDIRECTORY(examples/ida/serial) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(examples/ida/fcmix_serial) ENDIF(FCMIX_ENABLE AND F77_FOUND) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/ida/parallel) ENDIF(MPIC_FOUND) IF(MPIF_FOUND) ADD_SUBDIRECTORY(examples/ida/fcmix_parallel) ENDIF(MPIF_FOUND) ENDIF(BUILD_IDA) IF(BUILD_IDAS) ADD_SUBDIRECTORY(examples/idas/serial) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/idas/parallel) ENDIF(MPIC_FOUND) ENDIF(BUILD_IDAS) IF(BUILD_KINSOL) ADD_SUBDIRECTORY(examples/kinsol/serial) IF(FCMIX_ENABLE AND F77_FOUND) ADD_SUBDIRECTORY(examples/kinsol/fcmix_serial) ENDIF(FCMIX_ENABLE AND F77_FOUND) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/kinsol/parallel) ENDIF(MPIC_FOUND) IF(MPIF_FOUND) ADD_SUBDIRECTORY(examples/kinsol/fcmix_parallel) ENDIF(MPIF_FOUND) ENDIF(BUILD_KINSOL) IF(BUILD_CPODES) ADD_SUBDIRECTORY(examples/cpodes/serial) IF(MPIC_FOUND) ADD_SUBDIRECTORY(examples/cpodes/parallel) ENDIF(MPIC_FOUND) ENDIF(BUILD_CPODES) ENDIF(EXAMPLES_ENABLE) #---------------------------------- # Install configuration header file #---------------------------------- # install configured header file INSTALL( FILES ${PROJECT_BINARY_DIR}/include/sundials/sundials_config.h DESTINATION include/sundials ) sundials-2.5.0/Makefile.in0000600000175000017500000001240411741421110016250 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.17 $ # $Date: 2012/04/06 22:24:37 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Main Makefile for SUNDIALS suite # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ bindir = @bindir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ SLV_MODULES = @SLV_MODULES@ EXS_MODULES = @EXS_MODULES@ ALL_MODULES = @SLV_MODULES@ @EXS_MODULES@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir) mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs # ----------------------------------------------------------------- all: @for i in ${ALL_MODULES} ; do \ if test -d $${i} ; then \ echo "----------------------"; \ echo "Make $${i}..." ; \ echo "----------------------"; \ cd $${i} ; \ ${MAKE} ; \ cd ${abs_builddir} ; \ echo "" ; \ fi ; \ done install: $(mkinstalldirs) $(bindir) $(INSTALL_PROG) $(top_builddir)/bin/sundials-config $(bindir)/ @if test -f $(top_builddir)/bin/fortran-update.sh ; then \ $(INSTALL_PROG) $(top_builddir)/bin/fortran-update.sh $(bindir)/ ;\ fi @for i in ${SLV_MODULES} ; do \ if test -d $${i} ; then \ echo "----------------------"; \ echo "Install $${i}..." ; \ echo "----------------------"; \ cd $${i} ; \ ${MAKE} install ; \ cd ${abs_builddir} ; \ echo "" ; \ fi ; \ done @if test "X${EXS_MODULES}" = "X" ; then \ : ; \ else \ if test "X${EXS_INSTDIR}" = "Xno"; then \ echo "" ; \ echo "" ; \ echo "Examples were built but installation was disabled." ; \ echo "" ; \ echo "" ; \ else \ for i in ${EXS_MODULES} ; do \ echo "----------------------"; \ echo "Install $${i}..." ; \ echo "----------------------"; \ cd $${i} ; \ ${MAKE} install ; \ cd ${abs_builddir} ; \ echo "" ; \ done ; \ fi ; \ fi clean: @for i in ${ALL_MODULES} ; do \ if test -d $${i} ; then \ cd $${i} ; \ ${MAKE} clean ; \ cd ${abs_builddir} ; \ fi ; \ done uninstall: rm -f $(bindir)/sundials-config rm -f $(bindir)/fortran-update.sh @for i in ${ALL_MODULES} ; do \ if test -d $${i} ; then \ echo "----------------------"; \ echo "Uninstall $${i}..." ; \ echo "----------------------"; \ cd $${i} ; \ ${MAKE} uninstall ; \ cd ${abs_builddir} ; \ fi ; \ done # --------------------------------------------------------------------- distclean: @for i in ${ALL_MODULES} ; do \ if test -d $${i} ; then \ cd $${i}; \ ${MAKE} distclean; \ cd ${abs_builddir} ; \ fi ; \ done rm -f $(top_builddir)/config.log rm -f $(top_builddir)/config.status rm -f $(top_builddir)/config.cache rm -f $(top_builddir)/config.h rm -f $(top_builddir)/libtool rm -f $(top_builddir)/bin/sundials-config rm -f $(top_builddir)/bin/fortran-update.sh rm -f Makefile sundials-2.5.0/config/0000755000175000017500000000000011767174700015501 5ustar sylvestresylvestresundials-2.5.0/config/cust_general.m40000600000175000017500000001033611741421110020367 0ustar sylvestresylvestre# This file is part of Autoconf. -*- Autoconf -*- # Parameterized macros. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # _AC_MSG_LOG_CONFTEST_GENERAL # ---------------------------- m4_define([_AC_MSG_LOG_CONFTEST_GENERAL], [echo "$as_me: failed program was:" >&AS_MESSAGE_LOG_FD if test -f conftest.c ; then sed 's/^/| /' conftest.c >&AS_MESSAGE_LOG_FD elif test -f conftest.cc ; then sed 's/^/| /' conftest.cc >&AS_MESSAGE_LOG_FD elif test -f conftest.f ; then sed 's/^/| /' conftest.f >&AS_MESSAGE_LOG_FD elif test -f conftest.${FC_SRCEXT-f} ; then sed 's/^/| /' conftest.${FC_SRCEXT-f} >&AS_MESSAGE_LOG_FD fi ]) # _AC_LINKONLY_IFELSE(PROGRAM, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # ------------------------------------------------------------------ # Try to link PROGRAM (empty). # This macro can be used during the selection of a compiler. m4_define([_AC_LINKONLY_IFELSE], [m4_ifvaln([$1], [AC_LANG_CONFTEST([$1])])dnl AS_IF([_AC_EVAL_STDERR($ac_linkonly) && AC_TRY_COMMAND([test -z "$ac_[]_AC_LANG_ABBREV[]_werror_flag" || test ! -s conftest.err]) && AC_TRY_COMMAND([test -s conftest$ac_exeext])], [$2], [_AC_MSG_LOG_CONFTEST_GENERAL m4_ifvaln([$3], [$3])dnl])[]dnl rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext m4_ifval([$1], [conftest.$ac_ext])[]dnl ])# _AC_LINKONLY_IFELSE # AC_LINKONLY_IFELSE(PROGRAM, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # ----------------------------------------------------------------- # Try to link PROGRAM. Requires that the compiler for the current # language was checked for, hence do not use this macro in macros looking # for a compiler. AC_DEFUN([AC_LINKONLY_IFELSE], [AC_LANG_COMPILER_REQUIRE()dnl _AC_LINKONLY_IFELSE($@)]) sundials-2.5.0/config/SundialsLapack.cmake0000600000175000017500000000701311741421110021350 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.1 $ # $Date: 2009/02/17 02:58:46 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2008, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # BLAS/LAPACK tests for SUNDIALS CMake-based configuration. # # SET(LAPACK_FOUND FALSE) # If LAPACK libraries are undefined, try to find them (if we have # a working Fortran compiler) or look for them in the most # obvious place... if(NOT LAPACK_LIBRARIES) if(F77_FOUND) include(FindLAPACK) else(F77_FOUND) find_library(LAPACK_LIBRARIES NAMES lapack PATHS /usr/lib /usr/local/lib "$ENV{ProgramFiles}/LAPACK/Lib" ) endif(F77_FOUND) endif(NOT LAPACK_LIBRARIES) # If using a GNU C compiler, it is quite likely we'll want LAPACK_LINKER_FLAGS # to include -lg2c (if not already present) if(CMAKE_COMPILER_IS_GNUCC AND NOT LAPACK_LINKER_FLAGS MATCHES "g2c") set(LAPACK_LINKER_FLAGS "${LAPACK_LINKER_FLAGS} -lg2c") endif(CMAKE_COMPILER_IS_GNUCC AND NOT LAPACK_LINKER_FLAGS MATCHES "g2c") # If we have the LAPACK libraries, test them if(LAPACK_LIBRARIES) message(STATUS "Looking for LAPACK libraries... OK") # Create the LapackTest directory set(LapackTest_DIR ${PROJECT_BINARY_DIR}/LapackTest) file(MAKE_DIRECTORY ${LapackTest_DIR}) # Create a CMakeLists.txt file file(WRITE ${LapackTest_DIR}/CMakeLists.txt "PROJECT(ltest C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "SET(CMAKE_EXE_LINKER_FLAGS \"\${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}\")\n" "ADD_EXECUTABLE(ltest ltest.c)\n" "TARGET_LINK_LIBRARIES(ltest ${LAPACK_LIBRARIES})\n") # Create a C source file which calls a Blas function (dcopy) and an Lapack function (dgetrf) file(WRITE ${LapackTest_DIR}/ltest.c "${F77_MANGLE_MACRO1}\n" "#define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY)\n" "#define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF)\n" "extern void dcopy_f77(int *n, const double *x, const int *inc_x, double *y, const int *inc_y);\n" "extern void dgetrf_f77(const int *m, const int *n, double *a, int *lda, int *ipiv, int *info);\n" "int main(){\n" "int n=1;\n" "double x, y;\n" "dcopy_f77(&n, &x, &n, &y, &n);\n" "dgetrf_f77(&n, &n, &x, &n, &n, &n);\n" "return(0);\n" "}\n") # Attempt to link the "ltest" executable try_compile(LTEST_OK ${LapackTest_DIR} ${LapackTest_DIR} ltest OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. file(REMOVE_RECURSE ${LapackTest_DIR}/CMakeFiles) # Process test result if(LTEST_OK) message(STATUS "Checking if Lapack works... OK") set(LAPACK_FOUND TRUE) else(LTEST_OK) message(STATUS "Checking if Lapack works... FAILED") endif(LTEST_OK) else(LAPACK_LIBRARIES) message(STATUS "Looking for LAPACK libraries... FAILED") endif(LAPACK_LIBRARIES) sundials-2.5.0/config/mod_fortran.m40000600000175000017500000001346611741421110020235 0ustar sylvestresylvestre# This file is part of Autoconf. -*- Autoconf -*- # Fortran languages support. # Copyright (C) 2001, 2003 # Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # Fortran vs. Fortran 77: # This file contains macros for both "Fortran 77" and "Fortran", where # the former is the "classic" autoconf Fortran interface and is intended # for legacy F77 codes, while the latter is intended to support newer Fortran # dialects. Fortran 77 uses environment variables F77, FFLAGS, and FLIBS, # while Fortran uses FC, FCFLAGS, and FCLIBS. For each user-callable AC_* # macro, there is generally both an F77 and an FC version, where both versions # share the same _AC_*_FC_* backend. This backend macro requires that # the appropriate language be AC_LANG_PUSH'ed, and uses _AC_LANG_ABBREV and # _AC_LANG_PREFIX in order to name cache and environment variables, etc. # _AC_PROG_FC_V_OUTPUT([FLAG = $ac_cv_prog_{f77/fc}_v]) # ------------------------------------------------- # Link a trivial Fortran program, compiling with a verbose output FLAG # (whose default value, $ac_cv_prog_{f77/fc}_v, is computed by # _AC_PROG_FC_V), and return the output in $ac_{f77/fc}_v_output. This # output is processed in the way expected by _AC_FC_LIBRARY_LDFLAGS, # so that any link flags that are echoed by the compiler appear as # space-separated items. AC_DEFUN([_AC_PROG_FC_V_OUTPUT], [_AC_FORTRAN_ASSERT()dnl AC_LANG_CONFTEST([AC_LANG_PROGRAM([])]) # Compile and link our simple test program by passing a flag (argument # 1 to this macro) to the Fortran compiler in order to get # "verbose" output that we can then parse for the Fortran linker # flags. ac_save_FFLAGS=$[]_AC_LANG_PREFIX[]FLAGS _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS m4_default([$1], [$ac_cv_prog_[]_AC_LANG_ABBREV[]_v])" (eval echo $as_me:__oline__: \"$ac_link\") >&AS_MESSAGE_LOG_FD ac_[]_AC_LANG_ABBREV[]_v_output=`eval $ac_link AS_MESSAGE_LOG_FD>&1 2>&1 | grep -v 'Driving:'` echo "$ac_[]_AC_LANG_ABBREV[]_v_output" >&AS_MESSAGE_LOG_FD _AC_LANG_PREFIX[]FLAGS=$ac_save_FFLAGS rm -f conftest* # On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where # /foo, /bar, and /baz are search directories for the Fortran linker. # Here, we change these into -L/foo -L/bar -L/baz (and put it first): ac_[]_AC_LANG_ABBREV[]_v_output="`echo $ac_[]_AC_LANG_ABBREV[]_v_output | grep 'LPATH is:' | sed 's,.*LPATH is\(: *[[^ ]]*\).*,\1,;s,: */, -L/,g'` $ac_[]_AC_LANG_ABBREV[]_v_output" case $ac_[]_AC_LANG_ABBREV[]_v_output in # If we are using xlf then replace all the commas with spaces. *xlfentry*) ac_[]_AC_LANG_ABBREV[]_v_output=`echo $ac_[]_AC_LANG_ABBREV[]_v_output | sed 's/,/ /g'` ;; # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted # $LIBS confuse us, and the libraries appear later in the output anyway). *mGLOB_options_string*) ac_[]_AC_LANG_ABBREV[]_v_output=`echo $ac_[]_AC_LANG_ABBREV[]_v_output | sed 's/"-mGLOB[[^"]]*"/ /g'` ;; # Portland Group compiler has quoted -cmdline argument *-cmdline*) ac_[]_AC_LANG_ABBREV[]_v_output=`echo $ac_[]_AC_LANG_ABBREV[]_v_output | sed "s/-cmdline '[[^']]*'/ /g"` ;; # If we are using Cray Fortran then delete quotes. # Use "\"" instead of '"' for font-lock-mode. # FIXME: a more general fix for quoted arguments with spaces? *cft90*) ac_[]_AC_LANG_ABBREV[]_v_output=`echo $ac_[]_AC_LANG_ABBREV[]_v_output | sed "s/\"//g"` ;; esac ])# _AC_PROG_FC_V_OUTPUT sundials-2.5.0/config/config.sub0000700000175000017500000007662711741421110017452 0ustar sylvestresylvestre#! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2005-12-11' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] CPU-MFR-OPSYS $0 [OPTION] ALIAS Canonicalize a configuration name. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.sub ($timestamp) Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" exit 1 ;; *local*) # First pass through any local machine types. echo $1 exit ;; * ) break ;; esac done case $# in 0) echo "$me: missing argument$help" >&2 exit 1;; 1) ;; *) echo "$me: too many arguments$help" >&2 exit 1;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple | -axis | -knuth | -cray) os= basic_machine=$1 ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 ;; -scout) ;; -wrs) os=-vxworks basic_machine=$1 ;; -chorusos*) os=-chorusos basic_machine=$1 ;; -chorusrdb) os=-chorusrdb basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco6) os=-sco5v6 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5v6*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -udk*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; -mint | -mint[0-9]*) basic_machine=m68k-atari os=-mint ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ | m32r | m32rle | m68000 | m68k | m88k | maxq | mcore \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ | mips64vr | mips64vrel \ | mips64orion | mips64orionel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ | mt \ | msp430 \ | ns16k | ns32k \ | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ | pyramid \ | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b \ | strongarm \ | tahoe | thumb | tic4x | tic80 | tron \ | v850 | v850e \ | we32k \ | x86 | xscale | xscalee[bl] | xstormy16 | xtensa \ | z8k) basic_machine=$basic_machine-unknown ;; m32c) basic_machine=$basic_machine-unknown ;; m6811 | m68hc11 | m6812 | m68hc12) # Motorola 68HC11/12. basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; ms1) basic_machine=mt-unknown ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i*86 | x86_64) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ | m88110-* | m88k-* | maxq-* | mcore-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ | mips64vr-* | mips64vrel-* \ | mips64orion-* | mips64orionel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ | pyramid-* \ | romp-* | rs6000-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ | tahoe-* | thumb-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ | tron-* \ | v850-* | v850e-* | vax-* \ | we32k-* \ | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \ | xstormy16-* | xtensa-* \ | ymp-* \ | z8k-*) ;; m32c-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 386bsd) basic_machine=i386-unknown os=-bsd ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; a29khif) basic_machine=a29k-amd os=-udi ;; abacus) basic_machine=abacus-unknown ;; adobe68k) basic_machine=m68010-adobe os=-scout ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-unknown ;; amigaos | amigados) basic_machine=m68k-unknown os=-amigaos ;; amigaunix | amix) basic_machine=m68k-unknown os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; apollo68bsd) basic_machine=m68k-apollo os=-bsd ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; c90) basic_machine=c90-cray os=-unicos ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | j90) basic_machine=j90-cray os=-unicos ;; craynv) basic_machine=craynv-cray os=-unicosmp ;; cr16c) basic_machine=cr16c-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; crx) basic_machine=crx-unknown os=-elf ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=-tops10 ;; decsystem20* | dec20*) basic_machine=pdp10-dec os=-tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; es1800 | OSE68k | ose68k | ose | OSE) basic_machine=m68k-ericsson os=-ose ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; go32) basic_machine=i386-pc os=-go32 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; h8300xray) basic_machine=h8300-hitachi os=-xray ;; h8500hms) basic_machine=h8500-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) basic_machine=hppa1.1-hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; hppaosf) basic_machine=hppa1.1-hp os=-osf ;; hppro) basic_machine=hppa1.1-hp os=-proelf ;; i370-ibm* | ibm*) basic_machine=i370-ibm ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i*86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i*86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i*86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; i386mach) basic_machine=i386-mach os=-mach ;; i386-vsta | vsta) basic_machine=i386-unknown os=-vsta ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; miniframe) basic_machine=m68000-convergent ;; *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) basic_machine=m68k-atari os=-mint ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; monitor) basic_machine=m68k-rom68k os=-coff ;; morphos) basic_machine=powerpc-unknown os=-morphos ;; msdos) basic_machine=i386-pc os=-msdos ;; ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; mvs) basic_machine=i370-ibm os=-mvs ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; netbsd386) basic_machine=i386-unknown os=-netbsd ;; netwinder) basic_machine=armv4l-rebel os=-linux ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; necv70) basic_machine=v70-nec os=-sysv ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; mon960) basic_machine=i960-intel os=-mon960 ;; nonstopux) basic_machine=mips-compaq os=-nonstopux ;; np1) basic_machine=np1-gould ;; nsr-tandem) basic_machine=nsr-tandem ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=-proelf ;; openrisc | openrisc-*) basic_machine=or32-unknown ;; os400) basic_machine=powerpc-ibm os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson os=-ose ;; os68k) basic_machine=m68k-none os=-os68k ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; pentium4) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium4-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; ppc) basic_machine=powerpc-unknown ;; ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64) basic_machine=powerpc64-unknown ;; ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64le | powerpc64little | ppc64-le | powerpc64-little) basic_machine=powerpc64le-unknown ;; ppc64le-* | powerpc64little-*) basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; pw32) basic_machine=i586-unknown os=-pw32 ;; rdos) basic_machine=i386-pc os=-rdos ;; rom68k) basic_machine=m68k-rom68k os=-coff ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; s390 | s390-*) basic_machine=s390-ibm ;; s390x | s390x-*) basic_machine=s390x-ibm ;; sa29200) basic_machine=a29k-amd os=-udi ;; sb1) basic_machine=mipsisa64sb1-unknown ;; sb1el) basic_machine=mipsisa64sb1el-unknown ;; sei) basic_machine=mips-sei os=-seiux ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sh64) basic_machine=sh64-unknown ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; st2000) basic_machine=m68k-tandem ;; stratus) basic_machine=i860-stratus os=-sysv4 ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; sv1) basic_machine=sv1-cray os=-unicos ;; symmetry) basic_machine=i386-sequent os=-dynix ;; t3e) basic_machine=alphaev5-cray os=-unicos ;; t90) basic_machine=t90-cray os=-unicos ;; tic54x | c54x*) basic_machine=tic54x-unknown os=-coff ;; tic55x | c55x*) basic_machine=tic55x-unknown os=-coff ;; tic6x | c6x*) basic_machine=tic6x-unknown os=-coff ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; toad1) basic_machine=pdp10-xkl os=-tops20 ;; tower | tower-32) basic_machine=m68k-ncr ;; tpf) basic_machine=s390x-ibm os=-tpf ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; v810 | necv810) basic_machine=v810-nec os=-none ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; w65*) basic_machine=w65-wdc os=-none ;; w89k-*) basic_machine=hppa1.1-winbond os=-proelf ;; xbox) basic_machine=i686-pc os=-mingw32 ;; xps | xps100) basic_machine=xps100-honeywell ;; ymp) basic_machine=ymp-cray os=-unicos ;; z8k-*-coff) basic_machine=z8k-unknown os=-sim ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. w89k) basic_machine=hppa1.1-winbond ;; op50n) basic_machine=hppa1.1-oki ;; op60c) basic_machine=hppa1.1-oki ;; romp) basic_machine=romp-ibm ;; mmix) basic_machine=mmix-knuth ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp10) # there are many clones, so DEC is not a safe bet basic_machine=pdp10-unknown ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; mac | mpw | mac-mpw) basic_machine=m68k-apple ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; *-unknown) # Make sure to match an already-canonicalized machine name. ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* | -openbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ | -skyos* | -haiku* | -rdos*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) case $basic_machine in x86-* | i*86-*) ;; *) os=-nto$os ;; esac ;; -nto-qnx*) ;; -nto*) os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; -linux-dietlibc) os=-linux-dietlibc ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -opened*) os=-openedition ;; -os400*) os=-os400 ;; -wince*) os=-wince ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -atheos*) os=-atheos ;; -syllable*) os=-syllable ;; -386bsd) os=-bsd ;; -ctix* | -uts*) os=-sysv ;; -nova*) os=-rtmk-nova ;; -ns2 ) os=-nextstep2 ;; -nsk*) os=-nsk ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -tpf*) os=-tpf ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -ose*) os=-ose ;; -es1800*) os=-ose ;; -xenix) os=-xenix ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) os=-mint ;; -aros*) os=-aros ;; -kaos*) os=-kaos ;; -zvmoe) os=-zvmoe ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in *-acorn) os=-riscix1.2 ;; arm*-rebel) os=-linux ;; arm*-semi) os=-aout ;; c4x-* | tic4x-*) os=-coff ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 # This also exists in the configure program, but was not the # default. # os=-sunos4 ;; m68*-cisco) os=-aout ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; or32-*) os=-coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-haiku) os=-haiku ;; *-ibm) os=-aix ;; *-knuth) os=-mmixware ;; *-wec) os=-proelf ;; *-winbond) os=-proelf ;; *-oki) os=-proelf ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f30[01]-fujitsu | f700-fujitsu) os=-uxpv ;; *-rom68k) os=-coff ;; *-*bug) os=-coff ;; *-apple) os=-macos ;; *-atari*) os=-mint ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -aix*) vendor=ibm ;; -beos*) vendor=be ;; -hpux*) vendor=hp ;; -mpeix*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs* | -opened*) vendor=ibm ;; -os400*) vendor=ibm ;; -ptx*) vendor=sequent ;; -tpf*) vendor=ibm ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; -aux*) vendor=apple ;; -hms*) vendor=hitachi ;; -mpw* | -macos*) vendor=apple ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) vendor=atari ;; -vos*) vendor=stratus ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: sundials-2.5.0/config/install-sh0000700000175000017500000001273611741421110017462 0ustar sylvestresylvestre#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: chmodcmd="" else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 sundials-2.5.0/config/FindMPI.cmake0000600000175000017500000000207611741421110017704 0ustar sylvestresylvestre# - Find MPI # This module looks for MPI (Message Passing Interface) support # it will define the following values # MPI_INCLUDE_PATH = cached location of mpi.h # MPI_LIBRARIES = cached list of libraries to link in (mpi mpich etc) FIND_PATH(MPI_INCLUDE_PATH mpi.h PATHS /usr/local/include /usr/include /usr/include/mpi /usr/local/mpi/include "$ENV{ProgramFiles}/MPICH/SDK/Include" "$ENV{ProgramFiles}/MPICH2/include" "C:/Program Files/MPICH/SDK/Include" ) FIND_LIBRARY(MPI_LIBRARIES NAMES mpich2 mpi mpich PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "$ENV{ProgramFiles}/MPICH2/Lib" "C:/Program Files/MPICH/SDK/Lib" ) FIND_LIBRARY(MPI_EXTRA_LIBRARIES NAMES mpi++ PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "C:/Program Files/MPICH/SDK/Lib" DOC "If a second mpi library is necessary, specify it here.") MARK_AS_ADVANCED(MPI_EXTRA_LIBRARIES) IF(MPI_EXTRA_LIBRARIES) SET(MPI_LIBRARIES ${MPI_LIBRARIES} ${MPI_EXTRA_LIBRARIES}) ENDIF(MPI_EXTRA_LIBRARIES) sundials-2.5.0/config/rminstalldirs0000700000175000017500000000060711741421110020265 0ustar sylvestresylvestre#! /bin/sh # rminstalldirs -- remove directory if empty with checks # Author: Radu Serban for arg in ${1+"$@"} ; do path=`echo "$arg" | sed -e 's,/$,,' | tr -s '/'` case "$path" in -* ) path="./$path" ;; esac if test -d "$path" ; then if test x"`ls -A "$path"`" = x ; then echo "rmdir $path" rmdir "$path" > /dev/null 2>&1 || errstatus=$? fi fi donesundials-2.5.0/config/FindBLAS.cmake0000600000175000017500000001143711741421110020001 0ustar sylvestresylvestre# - Find BLAS library # This module finds an installed fortran library that implements the BLAS # linear-algebra interface (see http://www.netlib.org/blas/). # The list of libraries searched for is taken # from the autoconf macro file, acx_blas.m4 (distributed at # http://ac-archive.sourceforge.net/ac-archive/acx_blas.html). # # This module sets the following variables: # BLAS_FOUND - set to true if a library implementing the BLAS interface # is found # BLAS_LINKER_FLAGS - uncached list of required linker flags (excluding -l # and -L). # BLAS_LIBRARIES - uncached list of libraries (using full path name) to # link against to use BLAS # include(CheckFortranFunctionExists) macro(Check_Fortran_Libraries LIBRARIES _prefix _name _flags _list) # This macro checks for the existence of the combination of fortran libraries # given by _list. If the combination is found, this macro checks (using the # Check_Fortran_Function_Exists macro) whether can link against that library # combination using the name of a routine given by _name using the linker # flags given by _flags. If the combination of libraries is found and passes # the link test, LIBRARIES is set to the list of complete library paths that # have been found. Otherwise, LIBRARIES is set to FALSE. # N.B. _prefix is the prefix applied to the names of all cached variables that # are generated internally and marked advanced by this macro. set(_libraries_work TRUE) set(${LIBRARIES}) set(_combined_name) foreach(_library ${_list}) set(_combined_name ${_combined_name}_${_library}) if(_libraries_work) find_library(${_prefix}_${_library}_LIBRARY NAMES ${_library} PATHS /usr/local/lib /usr/lib ) mark_as_advanced(${_prefix}_${_library}_LIBRARY) set(${LIBRARIES} ${${LIBRARIES}} ${${_prefix}_${_library}_LIBRARY}) set(_libraries_work ${${_prefix}_${_library}_LIBRARY}) endif(_libraries_work) endforeach(_library ${_list}) if(_libraries_work) # Test this combination of libraries. set(CMAKE_REQUIRED_LIBRARIES ${_flags} ${${LIBRARIES}}) #message("DEBUG: CMAKE_REQUIRED_LIBRARIES = ${CMAKE_REQUIRED_LIBRARIES}") check_fortran_function_exists(${_name} ${_prefix}${_combined_name}_WORKS) set(CMAKE_REQUIRED_LIBRARIES) mark_as_advanced(${_prefix}${_combined_name}_WORKS) set(_libraries_work ${${_prefix}${_combined_name}_WORKS}) endif(_libraries_work) if(NOT _libraries_work) set(${LIBRARIES} FALSE) endif(NOT _libraries_work) #message("DEBUG: ${LIBRARIES} = ${${LIBRARIES}}") endmacro(Check_Fortran_Libraries) set(BLAS_LINKER_FLAGS) set(BLAS_LIBRARIES) if(NOT BLAS_LIBRARIES) # BLAS in ATLAS library? (http://math-atlas.sourceforge.net/) check_fortran_libraries( BLAS_LIBRARIES BLAS cblas_dgemm "" "cblas;f77blas;atlas" ) endif(NOT BLAS_LIBRARIES) # BLAS in PhiPACK libraries? (requires generic BLAS lib, too) if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "sgemm;dgemm;blas" ) endif(NOT BLAS_LIBRARIES) # BLAS in Alpha CXML library? if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "cxml" ) endif(NOT BLAS_LIBRARIES) # BLAS in Alpha DXML library? (now called CXML, see above) if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "dxml" ) endif(NOT BLAS_LIBRARIES) # BLAS in Sun Performance library? if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "-xlic_lib=sunperf" "sunperf;sunmath" ) if(BLAS_LIBRARIES) set(BLAS_LINKER_FLAGS "-xlic_lib=sunperf") endif(BLAS_LIBRARIES) endif(NOT BLAS_LIBRARIES) # BLAS in SCSL library? (SGI/Cray Scientific Library) if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "scsl" ) endif(NOT BLAS_LIBRARIES) # BLAS in SGIMATH library? if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "complib.sgimath" ) endif(NOT BLAS_LIBRARIES) # BLAS in IBM ESSL library? (requires generic BLAS lib, too) if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "essl;blas" ) endif(NOT BLAS_LIBRARIES) # Generic BLAS library? if(NOT BLAS_LIBRARIES) check_fortran_libraries( BLAS_LIBRARIES BLAS sgemm "" "blas" ) endif(NOT BLAS_LIBRARIES) if(BLAS_LIBRARIES) set(BLAS_FOUND TRUE) else(BLAS_LIBRARIES) set(BLAS_FOUND FALSE) endif(BLAS_LIBRARIES) if(NOT BLAS_FIND_QUIETLY) if(BLAS_FOUND) message(STATUS "A library with BLAS API found.") else(BLAS_FOUND) if(BLAS_FIND_REQUIRED) message(FATAL_ERROR "A library with BLAS API not found. Please specify library location." ) else(BLAS_FIND_REQUIRED) message(STATUS "A library with BLAS API not found. Please specify library location." ) endif(BLAS_FIND_REQUIRED) endif(BLAS_FOUND) endif(NOT BLAS_FIND_QUIETLY) sundials-2.5.0/config/FindLAPACK.cmake0000600000175000017500000000660411741421110020213 0ustar sylvestresylvestre# - Find LAPACK library # This module finds an installed fortran library that implements the LAPACK # linear-algebra interface (see http://www.netlib.org/lapack/). # # The approach follows that taken for the autoconf macro file, acx_lapack.m4 # (distributed at http://ac-archive.sourceforge.net/ac-archive/acx_lapack.html). # # This module sets the following variables: # LAPACK_FOUND - set to true if a library implementing the LAPACK interface # is found # LAPACK_LINKER_FLAGS - uncached list of required linker flags (excluding -l # and -L). # LAPACK_LIBRARIES - uncached list of libraries (using full path name) to # link against to use LAPACK # include(CheckFortranFunctionExists) set(LAPACK_FOUND FALSE) if(LAPACK_FIND_QUIETLY OR NOT LAPACK_FIND_REQUIRED) find_package(BLAS) else(LAPACK_FIND_QUIETLY OR NOT LAPACK_FIND_REQUIRED) find_package(BLAS REQUIRED) endif(LAPACK_FIND_QUIETLY OR NOT LAPACK_FIND_REQUIRED) if(BLAS_FOUND) set(LAPACK_LINKER_FLAGS ${BLAS_LINKER_FLAGS}) # LAPACK linked to by default? (is sometimes included in BLAS lib) set(CMAKE_REQUIRED_LIBRARIES ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES}) check_fortran_function_exists(cheev LAPACK_BLAS_WORKS) mark_as_advanced(LAPACK_BLAS_WORKS) if(LAPACK_BLAS_WORKS) set(LAPACK_FOUND TRUE) set(LAPACK_LIBRARIES ${BLAS_LIBRARIES}) endif(LAPACK_BLAS_WORKS) # Generic LAPACK library? if(NOT LAPACK_FOUND) find_library(LAPACK_LAPACK_LIBRARY NAMES lapack PATHS /usr/local/lib /usr/lib ) mark_as_advanced(LAPACK_LAPACK_LIBRARY) if(LAPACK_LAPACK_LIBRARY) set(LAPACK_LIBRARIES ${LAPACK_LAPACK_LIBRARY} ${BLAS_LIBRARIES}) # Test this combination of libraries. set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES}) check_fortran_function_exists(cheev LAPACK_LAPACK_WORKS) mark_as_advanced(LAPACK_LAPACK_WORKS) set(CMAKE_REQUIRED_LIBRARIES) if(LAPACK_LAPACK_WORKS) set(LAPACK_FOUND TRUE) else(LAPACK_LAPACK_WORKS) set(LAPACK_LIBRARIES) endif(LAPACK_LAPACK_WORKS) endif(LAPACK_LAPACK_LIBRARY) endif(NOT LAPACK_FOUND) # Generic LAPACK rs6k library? if(NOT LAPACK_FOUND) find_library(LAPACK_RS6K_LIBRARY NAMES lapack_rs6k PATHS /usr/local/lib /usr/lib ) mark_as_advanced(LAPACK_RS6K_LIBRARY) if(LAPACK_RS6K_LIBRARY) set(LAPACK_LIBRARIES ${LAPACK_RS6K_LIBRARY} ${BLAS_LIBRARIES}) # Test this combination of libraries. set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES}) check_fortran_function_exists(cheev LAPACK_RS6K_WORKS) mark_as_advanced(LAPACK_RS6K_WORKS) set(CMAKE_REQUIRED_LIBRARIES) if(LAPACK_RS6K_WORKS) set(LAPACK_FOUND TRUE) else(LAPACK_RS6K_WORKS) set(LAPACK_LIBRARIES) endif(LAPACK_RS6K_WORKS) endif(LAPACK_RS6K_LIBRARY) endif(NOT LAPACK_FOUND) else(BLAS_FOUND) message(STATUS "LAPACK requires BLAS") endif(BLAS_FOUND) if(NOT LAPACK_FIND_QUIETLY) if(LAPACK_FOUND) message(STATUS "A library with LAPACK API found.") else(LAPACK_FOUND) if(LAPACK_FIND_REQUIRED) message(FATAL_ERROR "A library with LAPACK API not found. Please specify library location." ) else(LAPACK_FIND_REQUIRED) message(STATUS "A library with LAPACK API not found. Please specify library location." ) endif(LAPACK_FIND_REQUIRED) endif(LAPACK_FOUND) endif(NOT LAPACK_FIND_QUIETLY) sundials-2.5.0/config/SundialsMPIF.cmake0000600000175000017500000001020211741421110020702 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.1 $ # $Date: 2009/02/17 02:58:46 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2008, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # MPI-Fortran tests for SUNDIALS CMake-based configuration. # # set(MPIF_FOUND FALSE) # Local variable indicating whether to test MPI set(MPIF_PERFORM_TEST FALSE) # By default, we try to use the MPI compiler script # Search for the MPIF77 compiler script find_program(MPI_MPIF77 NAMES mpif77 DOC "mpif77 program") if(MPI_MPIF77) message(STATUS "Looking for MPI Fortran compiler script... ${MPI_MPIF77}") # Test the MPI compiler script set(MPIF_PERFORM_TEST TRUE) else(MPI_MPIF77) message(STATUS "Looking for MPI Fortran compiler script... FAILED") # If not already available, search for MPI headers and libraries. if(NOT MPI_LIBRARIES) find_path(MPI_INCLUDE_PATH mpi.h PATHS /usr/local/include /usr/include /usr/include/mpi /usr/local/mpi/include "$ENV{ProgramFiles}/MPICH/SDK/Include" "$ENV{ProgramFiles}/MPICH2/include" "C:/Program Files/MPICH/SDK/Include" ) find_library(MPI_LIBRARIES NAMES mpich2 mpi mpich PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "$ENV{ProgramFiles}/MPICH2/Lib" "C:/Program Files/MPICH/SDK/Lib" ) find_library(MPI_EXTRA_LIBRARIES NAMES mpi++ PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "C:/Program Files/MPICH/SDK/Lib" DOC "If a second mpi library is necessary, specify it here.") if(MPI_EXTRA_LIBRARIES) set(MPI_LIBRARIES ${MPI_LIBRARIES} ${MPI_EXTRA_LIBRARIES}) endif(MPI_EXTRA_LIBRARIES) endif(NOT MPI_LIBRARIES) if(MPI_LIBRARIES) message(STATUS "Looking for MPI libraries... ${MPI_LIBRARIES}") # Test the MPI libraries set(MPIF_PERFORM_TEST TRUE) else(MPI_LIBRARIES) message(STATUS "Looking for MPI libraries... FAILED") endif(MPI_LIBRARIES) endif(MPI_MPIF77) # If we have what to test, do it now if(MPIF_PERFORM_TEST) # Create the MPITest directory set(MPITest_DIR ${PROJECT_BINARY_DIR}/MPITest) file(MAKE_DIRECTORY ${MPITest_DIR}) # Create a CMakeLists.txt file which will generate the "mpiftest" executable if(MPI_MPIF77) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpiftest Fortran)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_Fortran_COMPILER ${MPI_MPIF77})\n" "SET(CMAKE_Fortran_FLAGS \"${TMP_Fortran_FLAGS}\")\n" "ADD_EXECUTABLE(mpiftest mpiftest.f)\n") else(MPI_MPIF77) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpiftest Fortran)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_Fortran_FLAGS \"${TMP_Fortran_FLAGS}\")\n" "INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH})\n" "ADD_EXECUTABLE(mpiftest mpiftest.f)\n" "TARGET_LINK_LIBRARIES(mpiftest ${MPI_LIBRARIES})\n") endif(MPI_MPIF77) # Create a simple F77 source which only calls the MPI_Init and MPI_Finalize functions file(WRITE ${MPITest_DIR}/mpiftest.f " INCLUDE \"mpif.h\"\n" " INTEGER IER\n" " CALL MPI_INIT(IER)\n" " CALL MPI_FINALIZE(IER)\n" " STOP\n" " END\n") # Use TRY_COMPILE to make the target "mpiftest" try_compile(MPITEST_OK ${MPITest_DIR} ${MPITest_DIR} mpiftest OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. file(REMOVE_RECURSE ${MPITest_DIR}/CMakeFiles) # Process test result if(MPITEST_OK) message(STATUS "Trying to compile and link a simple MPI Fortran program... OK") set(MPIF_FOUND TRUE) else(MPITEST_OK) message(STATUS "Trying to compile and link a simple MPI Fortran program... FAILED") endif(MPITEST_OK) endif(MPIF_PERFORM_TEST)sundials-2.5.0/config/SundialsFortran.cmake0000600000175000017500000002042311741421110021570 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.1 $ # $Date: 2009/02/17 02:58:46 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2008, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # Fortran-related tests for SUNDIALS CMake-based configuration. # # Determining the name-mangling scheme # ------------------------------------ # In general, names of symbols with and without underscore may be mangled # differently (e.g. g77 mangles mysub to mysub_ and my_sub to my_sub__), # we have to consider both cases. # Method: # 1) create a library from a Fortran source file which defines a function "mysub" # 2) attempt to link with this library a C source file which calls the "mysub" # function using various possible schemes (6 different schemes, corresponding # to all combinations lower/upper case and none/one/two underscores) # 3) define the name-mangling scheme based on the test that was successful. # On exit, if we were able to infer the scheme, the variables # CMAKE_Fortran_SCHEME_NO_UNDERSCORES and CMAKE_Fortran_SCHEME_WITH_UNDERSCORES # contain the mangled names for "mysub" and "my_sub", respectively. set(F77_FOUND FALSE) set(F77SCHEME_FOUND FALSE) set(CMAKE_Fortran_SCHEME_NO_UNDERSCORES "") set(CMAKE_Fortran_SCHEME_WITH_UNDERSCORES "") include(CMakeDetermineFortranCompiler) if(CMAKE_Fortran_COMPILER) message(STATUS "Searching for a Fortran compiler... ${CMAKE_Fortran_COMPILER}") # Enable the language for next steps enable_language(Fortran) mark_as_advanced(CLEAR CMAKE_Fortran_COMPILER CMAKE_Fortran_FLAGS CMAKE_Fortran_FLAGS_DEBUG CMAKE_Fortran_FLAGS_MINSIZEREL CMAKE_Fortran_FLAGS_RELEASE CMAKE_Fortran_FLAGS_RELWITHDEB) # Create the FortranTest directory set(FortranTest_DIR ${PROJECT_BINARY_DIR}/FortranTest) file(MAKE_DIRECTORY ${FortranTest_DIR}) # Create a CMakeLists.txt file which will generate the "flib" library # and an executable "ftest" file(WRITE ${FortranTest_DIR}/CMakeLists.txt "PROJECT(ftest Fortran)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_Fortran_FLAGS \"${CMAKE_Fortran_FLAGS}\")\n" "SET(CMAKE_Fortran_FLAGS_RELEASE \"${CMAKE_Fortran_FLAGS_RELEASE}\")\n" "SET(CMAKE_Fortran_FLAGS_DEBUG \"${CMAKE_Fortran_FLAGS_DEBUG}\")\n" "SET(CMAKE_Fortran_FLAGS_RELWITHDEBUGINFO \"${CMAKE_Fortran_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_Fortran_FLAGS_MINSIZE \"${CMAKE_Fortran_FLAGS_MINSIZE}\")\n" "ADD_LIBRARY(flib flib.f)\n" "ADD_EXECUTABLE(ftest ftest.f)\n" "TARGET_LINK_LIBRARIES(ftest flib)\n") # Create the Fortran source flib.f which defines two subroutines, "mysub" and "my_sub" file(WRITE ${FortranTest_DIR}/flib.f " SUBROUTINE mysub\n" " RETURN\n" " END\n" " SUBROUTINE my_sub\n" " RETURN\n" " END\n") # Create the Fortran source ftest.f which calls "mysub" and "my_sub" file(WRITE ${FortranTest_DIR}/ftest.f " PROGRAM ftest\n" " CALL mysub()\n" " CALL my_sub()\n" " END\n") # Use TRY_COMPILE to make the targets "flib" and "ftest" try_compile(FTEST_OK ${FortranTest_DIR} ${FortranTest_DIR} ftest OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. file(REMOVE_RECURSE ${FortranTest_DIR}/CMakeFiles) # Proceed based on test results if(FTEST_OK) message(STATUS "Trying to compile and link a simple Fortran program... OK") set(F77_FOUND TRUE) # Infer Fortran name-mangling scheme for symbols WITHOUT underscores. # Overwrite CMakeLists.txt with one which will generate the "ctest1" executable file(WRITE ${FortranTest_DIR}/CMakeLists.txt "PROJECT(ctest1 C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "ADD_EXECUTABLE(ctest1 ctest1.c)\n" "FIND_LIBRARY(FLIB flib ${FortranTest_DIR})\n" "TARGET_LINK_LIBRARIES(ctest1 \${FLIB})\n") # Define the list "options" of all possible schemes that we want to consider # Get its length and initialize the counter "iopt" to zero set(options mysub mysub_ mysub__ MYSUB MYSUB_ MYSUB__) list(LENGTH options imax) set(iopt 0) # We will attempt to sucessfully generate the "ctest1" executable as long as # there still are entries in the "options" list while(${iopt} LESS ${imax}) # Get the current list entry (current scheme) list(GET options ${iopt} opt) # Generate C source which calls the "mysub" function using the current scheme file(WRITE ${FortranTest_DIR}/ctest1.c "int main(){${opt}();return(0);}\n") # Use TRY_COMPILE to make the "ctest1" executable from the current C source # and linking to the previously created "flib" library. try_compile(CTEST_OK ${FortranTest_DIR} ${FortranTest_DIR} ctest1 OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. file(REMOVE_RECURSE ${FortranTest_DIR}/CMakeFiles) # Test if we successfully created the "ctest" executable. # If yes, save the current scheme, and set the counter "iopt" to "imax" # so that we exit the while loop. # Otherwise, increment the counter "iopt" and go back in the while loop. if(CTEST_OK) set(CMAKE_Fortran_SCHEME_NO_UNDERSCORES ${opt}) set(iopt ${imax}) else(CTEST_OK) math(EXPR iopt ${iopt}+1) endif(CTEST_OK) endwhile(${iopt} LESS ${imax}) # Infer Fortran name-mangling scheme for symbols WITH underscores. # Practically a duplicate of the previous steps. file(WRITE ${FortranTest_DIR}/CMakeLists.txt "PROJECT(ctest2 C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "ADD_EXECUTABLE(ctest2 ctest2.c)\n" "FIND_LIBRARY(FLIB flib ${FortranTest_DIR})\n" "TARGET_LINK_LIBRARIES(ctest2 \${FLIB})\n") set(options my_sub my_sub_ my_sub__ MY_SUB MY_SUB_ MY_SUB__) list(LENGTH options imax) set(iopt 0) while(${iopt} LESS ${imax}) list(GET options ${iopt} opt) file(WRITE ${FortranTest_DIR}/ctest2.c "int main(){${opt}();return(0);}\n") try_compile(CTEST_OK ${FortranTest_DIR} ${FortranTest_DIR} ctest2 OUTPUT_VARIABLE MY_OUTPUT) file(REMOVE_RECURSE ${FortranTest_DIR}/CMakeFiles) if(CTEST_OK) set(CMAKE_Fortran_SCHEME_WITH_UNDERSCORES ${opt}) set(iopt ${imax}) else(CTEST_OK) math(EXPR iopt ${iopt}+1) endif(CTEST_OK) endwhile(${iopt} LESS ${imax}) # Proceed based on whether the previous tests were successfull or not if(CMAKE_Fortran_SCHEME_NO_UNDERSCORES AND CMAKE_Fortran_SCHEME_WITH_UNDERSCORES) message(STATUS "Determining Fortran name-mangling scheme... OK") set(F77SCHEME_FOUND TRUE) else(CMAKE_Fortran_SCHEME_NO_UNDERSCORES AND CMAKE_Fortran_SCHEME_WITH_UNDERSCORES) message(STATUS "Determining Fortran name-mangling scheme... FAILED") endif(CMAKE_Fortran_SCHEME_NO_UNDERSCORES AND CMAKE_Fortran_SCHEME_WITH_UNDERSCORES) else(FTEST_OK) message(STATUS "Trying to compile and link a simple Fortran program... FAILED") endif(FTEST_OK) else(CMAKE_Fortran_COMPILER) message(STATUS "Searching for a Fortran compiler... FAILED") endif(CMAKE_Fortran_COMPILER) sundials-2.5.0/config/mkinstalldirs0000700000175000017500000000530011741421110020251 0ustar sylvestresylvestre#! /bin/sh # mkinstalldirs --- make directory hierarchy # Original author: Noah Friedman # Created: 1993-05-16 # Public domain. scriptversion=2003-09-26.19 errstatus=0 dirmode="" usage="\ Usage: mkinstalldirs [-h] [--help] [--version] [-m MODE] DIR ... Create each directory DIR (with mode MODE, if specified), including all leading file name components. " # process command line arguments while test $# -gt 0 ; do case $1 in -h | --help | --h*) # -h for help echo "$usage" exit 0 ;; -m) # -m PERM arg shift test $# -eq 0 && { echo "$usage" 1>&2; exit 1; } dirmode=$1 shift ;; --version) echo "$0 $scriptversion" exit 0 ;; --) # stop option processing shift break ;; -*) # unknown option echo "$usage" 1>&2 exit 1 ;; *) # first non-opt arg break ;; esac done for file do if test -d "$file"; then shift else break fi done case $# in 0) exit 0 ;; esac case $dirmode in '') if mkdir -p -- . 2>/dev/null; then echo "mkdir -p -- $*" exec mkdir -p -- "$@" else # On NextStep and OpenStep, the `mkdir' command does not # recognize any option. It will interpret all options as # directories to create, and then abort because `.' already # exists. test -d ./-p && rmdir ./-p test -d ./-- && rmdir ./-- fi ;; *) if mkdir -m "$dirmode" -p -- . 2>/dev/null; then echo "mkdir -m $dirmode -p -- $*" exec mkdir -m "$dirmode" -p -- "$@" else # Clean up after NextStep and OpenStep mkdir. for d in ./-m ./-p ./-- "./$dirmode"; do test -d $d && rmdir $d done fi ;; esac for file do set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` shift pathcomp= for d do pathcomp="$pathcomp$d" case $pathcomp in -*) pathcomp=./$pathcomp ;; esac if test ! -d "$pathcomp"; then echo "mkdir $pathcomp" mkdir "$pathcomp" || lasterr=$? if test ! -d "$pathcomp"; then errstatus=$lasterr else if test ! -z "$dirmode"; then echo "chmod $dirmode $pathcomp" lasterr="" chmod "$dirmode" "$pathcomp" || lasterr=$? if test ! -z "$lasterr"; then errstatus=$lasterr fi fi fi fi pathcomp="$pathcomp/" done done exit $errstatus # Local Variables: # mode: shell-script # sh-indentation: 2 # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-end: "$" # End: sundials-2.5.0/config/ltmain.sh0000600000175000017500000057775611741421110017322 0ustar sylvestresylvestre# ltmain.sh - Provide generalized library-building support services. # NOTE: Changing this file will not affect anything until you rerun configure. # # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005 # Free Software Foundation, Inc. # Originally by Gordon Matzigkeit , 1996 # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. basename="s,^.*/,,g" # Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh # is ksh but when the shell is invoked as "sh" and the current value of # the _XPG environment variable is not equal to 1 (one), the special # positional parameter $0, within a function call, is the name of the # function. progpath="$0" # The name of this program: progname=`echo "$progpath" | $SED $basename` modename="$progname" # Global variables: EXIT_SUCCESS=0 EXIT_FAILURE=1 PROGRAM=ltmain.sh PACKAGE=libtool VERSION=1.5.22 TIMESTAMP=" (1.1220.2.365 2005/12/18 22:14:06)" # See if we are running on zsh, and set the options which allow our # commands through without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Check that we have a working $echo. if test "X$1" = X--no-reexec; then # Discard the --no-reexec flag, and continue. shift elif test "X$1" = X--fallback-echo; then # Avoid inline document here, it may be left over : elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then # Yippee, $echo works! : else # Restart under the correct shell, and then maybe $echo will work. exec $SHELL "$progpath" --no-reexec ${1+"$@"} fi if test "X$1" = X--fallback-echo; then # used as fallback echo shift cat <&2 $echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 exit $EXIT_FAILURE fi # Global variables. mode=$default_mode nonopt= prev= prevopt= run= show="$echo" show_help= execute_dlfiles= duplicate_deps=no preserve_args= lo2o="s/\\.lo\$/.${objext}/" o2lo="s/\\.${objext}\$/.lo/" ##################################### # Shell function definitions: # This seems to be the best place for them # func_mktempdir [string] # Make a temporary directory that won't clash with other running # libtool processes, and avoids race conditions if possible. If # given, STRING is the basename for that directory. func_mktempdir () { my_template="${TMPDIR-/tmp}/${1-$progname}" if test "$run" = ":"; then # Return a directory name, but don't create it in dry-run mode my_tmpdir="${my_template}-$$" else # If mktemp works, use that first and foremost my_tmpdir=`mktemp -d "${my_template}-XXXXXXXX" 2>/dev/null` if test ! -d "$my_tmpdir"; then # Failing that, at least try and use $RANDOM to avoid a race my_tmpdir="${my_template}-${RANDOM-0}$$" save_mktempdir_umask=`umask` umask 0077 $mkdir "$my_tmpdir" umask $save_mktempdir_umask fi # If we're not in dry-run mode, bomb out on failure test -d "$my_tmpdir" || { $echo "cannot create temporary directory \`$my_tmpdir'" 1>&2 exit $EXIT_FAILURE } fi $echo "X$my_tmpdir" | $Xsed } # func_win32_libid arg # return the library type of file 'arg' # # Need a lot of goo to handle *both* DLLs and import libs # Has to be a shell function in order to 'eat' the argument # that is supplied when $file_magic_command is called. func_win32_libid () { win32_libid_type="unknown" win32_fileres=`file -L $1 2>/dev/null` case $win32_fileres in *ar\ archive\ import\ library*) # definitely import win32_libid_type="x86 archive import" ;; *ar\ archive*) # could be an import, or static if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null | \ $EGREP -e 'file format pe-i386(.*architecture: i386)?' >/dev/null ; then win32_nmres=`eval $NM -f posix -A $1 | \ $SED -n -e '1,100{/ I /{s,.*,import,;p;q;};}'` case $win32_nmres in import*) win32_libid_type="x86 archive import";; *) win32_libid_type="x86 archive static";; esac fi ;; *DLL*) win32_libid_type="x86 DLL" ;; *executable*) # but shell scripts are "executable" too... case $win32_fileres in *MS\ Windows\ PE\ Intel*) win32_libid_type="x86 DLL" ;; esac ;; esac $echo $win32_libid_type } # func_infer_tag arg # Infer tagged configuration to use if any are available and # if one wasn't chosen via the "--tag" command line option. # Only attempt this if the compiler in the base compile # command doesn't match the default compiler. # arg is usually of the form 'gcc ...' func_infer_tag () { if test -n "$available_tags" && test -z "$tagname"; then CC_quoted= for arg in $CC; do case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac CC_quoted="$CC_quoted $arg" done case $@ in # Blanks in the command may have been stripped by the calling shell, # but not from the CC environment variable when configure was run. " $CC "* | "$CC "* | " `$echo $CC` "* | "`$echo $CC` "* | " $CC_quoted"* | "$CC_quoted "* | " `$echo $CC_quoted` "* | "`$echo $CC_quoted` "*) ;; # Blanks at the start of $base_compile will cause this to fail # if we don't check for them as well. *) for z in $available_tags; do if grep "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then # Evaluate the configuration. eval "`${SED} -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`" CC_quoted= for arg in $CC; do # Double-quote args containing other shell metacharacters. case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac CC_quoted="$CC_quoted $arg" done case "$@ " in " $CC "* | "$CC "* | " `$echo $CC` "* | "`$echo $CC` "* | " $CC_quoted"* | "$CC_quoted "* | " `$echo $CC_quoted` "* | "`$echo $CC_quoted` "*) # The compiler in the base compile command matches # the one in the tagged configuration. # Assume this is the tagged configuration we want. tagname=$z break ;; esac fi done # If $tagname still isn't set, then no tagged configuration # was found and let the user know that the "--tag" command # line option must be used. # # # Modified by R.Serban (Nov. 28, 2006) to use the default # CC tag if unable to infer one if test -z "$tagname"; then tagname=CC # $echo "$modename: unable to infer tagged configuration" # $echo "$modename: specify a tag with \`--tag'" 1>&2 # exit $EXIT_FAILURE # else # $echo "$modename: using $tagname tagged configuration" fi ;; esac fi } # func_extract_an_archive dir oldlib func_extract_an_archive () { f_ex_an_ar_dir="$1"; shift f_ex_an_ar_oldlib="$1" $show "(cd $f_ex_an_ar_dir && $AR x $f_ex_an_ar_oldlib)" $run eval "(cd \$f_ex_an_ar_dir && $AR x \$f_ex_an_ar_oldlib)" || exit $? if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then : else $echo "$modename: ERROR: object name conflicts: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib" 1>&2 exit $EXIT_FAILURE fi } # func_extract_archives gentop oldlib ... func_extract_archives () { my_gentop="$1"; shift my_oldlibs=${1+"$@"} my_oldobjs="" my_xlib="" my_xabs="" my_xdir="" my_status="" $show "${rm}r $my_gentop" $run ${rm}r "$my_gentop" $show "$mkdir $my_gentop" $run $mkdir "$my_gentop" my_status=$? if test "$my_status" -ne 0 && test ! -d "$my_gentop"; then exit $my_status fi for my_xlib in $my_oldlibs; do # Extract the objects. case $my_xlib in [\\/]* | [A-Za-z]:[\\/]*) my_xabs="$my_xlib" ;; *) my_xabs=`pwd`"/$my_xlib" ;; esac my_xlib=`$echo "X$my_xlib" | $Xsed -e 's%^.*/%%'` my_xdir="$my_gentop/$my_xlib" $show "${rm}r $my_xdir" $run ${rm}r "$my_xdir" $show "$mkdir $my_xdir" $run $mkdir "$my_xdir" exit_status=$? if test "$exit_status" -ne 0 && test ! -d "$my_xdir"; then exit $exit_status fi case $host in *-darwin*) $show "Extracting $my_xabs" # Do not bother doing anything if just a dry run if test -z "$run"; then darwin_orig_dir=`pwd` cd $my_xdir || exit $? darwin_archive=$my_xabs darwin_curdir=`pwd` darwin_base_archive=`$echo "X$darwin_archive" | $Xsed -e 's%^.*/%%'` darwin_arches=`lipo -info "$darwin_archive" 2>/dev/null | $EGREP Architectures 2>/dev/null` if test -n "$darwin_arches"; then darwin_arches=`echo "$darwin_arches" | $SED -e 's/.*are://'` darwin_arch= $show "$darwin_base_archive has multiple architectures $darwin_arches" for darwin_arch in $darwin_arches ; do mkdir -p "unfat-$$/${darwin_base_archive}-${darwin_arch}" lipo -thin $darwin_arch -output "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}" "${darwin_archive}" cd "unfat-$$/${darwin_base_archive}-${darwin_arch}" func_extract_an_archive "`pwd`" "${darwin_base_archive}" cd "$darwin_curdir" $rm "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}" done # $darwin_arches ## Okay now we have a bunch of thin objects, gotta fatten them up :) darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print| xargs basename | sort -u | $NL2SP` darwin_file= darwin_files= for darwin_file in $darwin_filelist; do darwin_files=`find unfat-$$ -name $darwin_file -print | $NL2SP` lipo -create -output "$darwin_file" $darwin_files done # $darwin_filelist ${rm}r unfat-$$ cd "$darwin_orig_dir" else cd "$darwin_orig_dir" func_extract_an_archive "$my_xdir" "$my_xabs" fi # $darwin_arches fi # $run ;; *) func_extract_an_archive "$my_xdir" "$my_xabs" ;; esac my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | $NL2SP` done func_extract_archives_result="$my_oldobjs" } # End of Shell function definitions ##################################### # Darwin sucks eval std_shrext=\"$shrext_cmds\" disable_libs=no # Parse our command line options once, thoroughly. while test "$#" -gt 0 do arg="$1" shift case $arg in -*=*) optarg=`$echo "X$arg" | $Xsed -e 's/[-_a-zA-Z0-9]*=//'` ;; *) optarg= ;; esac # If the previous option needs an argument, assign it. if test -n "$prev"; then case $prev in execute_dlfiles) execute_dlfiles="$execute_dlfiles $arg" ;; tag) tagname="$arg" preserve_args="${preserve_args}=$arg" # Check whether tagname contains only valid characters case $tagname in *[!-_A-Za-z0-9,/]*) $echo "$progname: invalid tag name: $tagname" 1>&2 exit $EXIT_FAILURE ;; esac case $tagname in CC) # Don't test for the "default" C tag, as we know, it's there, but # not specially marked. ;; *) if grep "^# ### BEGIN LIBTOOL TAG CONFIG: $tagname$" < "$progpath" > /dev/null; then taglist="$taglist $tagname" # Evaluate the configuration. eval "`${SED} -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$tagname'$/,/^# ### END LIBTOOL TAG CONFIG: '$tagname'$/p' < $progpath`" else $echo "$progname: ignoring unknown tag $tagname" 1>&2 fi ;; esac ;; *) eval "$prev=\$arg" ;; esac prev= prevopt= continue fi # Have we seen a non-optional argument yet? case $arg in --help) show_help=yes ;; --version) $echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP" $echo $echo "Copyright (C) 2005 Free Software Foundation, Inc." $echo "This is free software; see the source for copying conditions. There is NO" $echo "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." exit $? ;; --config) ${SED} -e '1,/^# ### BEGIN LIBTOOL CONFIG/d' -e '/^# ### END LIBTOOL CONFIG/,$d' $progpath # Now print the configurations for the tags. for tagname in $taglist; do ${SED} -n -e "/^# ### BEGIN LIBTOOL TAG CONFIG: $tagname$/,/^# ### END LIBTOOL TAG CONFIG: $tagname$/p" < "$progpath" done exit $? ;; --debug) $echo "$progname: enabling shell trace mode" set -x preserve_args="$preserve_args $arg" ;; --dry-run | -n) run=: ;; --features) $echo "host: $host" if test "$build_libtool_libs" = yes; then $echo "enable shared libraries" else $echo "disable shared libraries" fi if test "$build_old_libs" = yes; then $echo "enable static libraries" else $echo "disable static libraries" fi exit $? ;; --finish) mode="finish" ;; --mode) prevopt="--mode" prev=mode ;; --mode=*) mode="$optarg" ;; --preserve-dup-deps) duplicate_deps="yes" ;; --quiet | --silent) show=: preserve_args="$preserve_args $arg" ;; --tag) prevopt="--tag" prev=tag preserve_args="$preserve_args --tag" ;; --tag=*) set tag "$optarg" ${1+"$@"} shift prev=tag preserve_args="$preserve_args --tag" ;; -dlopen) prevopt="-dlopen" prev=execute_dlfiles ;; -*) $echo "$modename: unrecognized option \`$arg'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE ;; *) nonopt="$arg" break ;; esac done if test -n "$prevopt"; then $echo "$modename: option \`$prevopt' requires an argument" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi case $disable_libs in no) ;; shared) build_libtool_libs=no build_old_libs=yes ;; static) build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac` ;; esac # If this variable is set in any of the actions, the command in it # will be execed at the end. This prevents here-documents from being # left over by shells. exec_cmd= if test -z "$show_help"; then # Infer the operation mode. if test -z "$mode"; then $echo "*** Warning: inferring the mode of operation is deprecated." 1>&2 $echo "*** Future versions of Libtool will require --mode=MODE be specified." 1>&2 case $nonopt in *cc | cc* | *++ | gcc* | *-gcc* | g++* | xlc*) mode=link for arg do case $arg in -c) mode=compile break ;; esac done ;; *db | *dbx | *strace | *truss) mode=execute ;; *install*|cp|mv) mode=install ;; *rm) mode=uninstall ;; *) # If we have no mode, but dlfiles were specified, then do execute mode. test -n "$execute_dlfiles" && mode=execute # Just use the default operation mode. if test -z "$mode"; then if test -n "$nonopt"; then $echo "$modename: warning: cannot infer operation mode from \`$nonopt'" 1>&2 else $echo "$modename: warning: cannot infer operation mode without MODE-ARGS" 1>&2 fi fi ;; esac fi # Only execute mode is allowed to have -dlopen flags. if test -n "$execute_dlfiles" && test "$mode" != execute; then $echo "$modename: unrecognized option \`-dlopen'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi # Change the help message to a mode-specific one. generic_help="$help" help="Try \`$modename --help --mode=$mode' for more information." # These modes are in order of execution frequency so that they run quickly. case $mode in # libtool compile mode compile) modename="$modename: compile" # Get the compilation command and the source file. base_compile= srcfile="$nonopt" # always keep a non-empty value in "srcfile" suppress_opt=yes suppress_output= arg_mode=normal libobj= later= for arg do case $arg_mode in arg ) # do not "continue". Instead, add this to base_compile lastarg="$arg" arg_mode=normal ;; target ) libobj="$arg" arg_mode=normal continue ;; normal ) # Accept any command-line options. case $arg in -o) if test -n "$libobj" ; then $echo "$modename: you cannot specify \`-o' more than once" 1>&2 exit $EXIT_FAILURE fi arg_mode=target continue ;; -static | -prefer-pic | -prefer-non-pic) later="$later $arg" continue ;; -no-suppress) suppress_opt=no continue ;; -Xcompiler) arg_mode=arg # the next one goes into the "base_compile" arg list continue # The current "srcfile" will either be retained or ;; # replaced later. I would guess that would be a bug. -Wc,*) args=`$echo "X$arg" | $Xsed -e "s/^-Wc,//"` lastarg= save_ifs="$IFS"; IFS=',' for arg in $args; do IFS="$save_ifs" # Double-quote args containing other shell metacharacters. # Many Bourne shells cannot handle close brackets correctly # in scan sets, so we specify it separately. case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac lastarg="$lastarg $arg" done IFS="$save_ifs" lastarg=`$echo "X$lastarg" | $Xsed -e "s/^ //"` # Add the arguments to base_compile. base_compile="$base_compile $lastarg" continue ;; * ) # Accept the current argument as the source file. # The previous "srcfile" becomes the current argument. # lastarg="$srcfile" srcfile="$arg" ;; esac # case $arg ;; esac # case $arg_mode # Aesthetically quote the previous argument. lastarg=`$echo "X$lastarg" | $Xsed -e "$sed_quote_subst"` case $lastarg in # Double-quote args containing other shell metacharacters. # Many Bourne shells cannot handle close brackets correctly # in scan sets, and some SunOS ksh mistreat backslash-escaping # in scan sets (worked around with variable expansion), # and furthermore cannot handle '|' '&' '(' ')' in scan sets # at all, so we specify them separately. *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") lastarg="\"$lastarg\"" ;; esac base_compile="$base_compile $lastarg" done # for arg case $arg_mode in arg) $echo "$modename: you must specify an argument for -Xcompile" exit $EXIT_FAILURE ;; target) $echo "$modename: you must specify a target with \`-o'" 1>&2 exit $EXIT_FAILURE ;; *) # Get the name of the library object. [ -z "$libobj" ] && libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'` ;; esac # Recognize several different file suffixes. # If the user specifies -o file.o, it is replaced with file.lo xform='[cCFSifmso]' case $libobj in *.ada) xform=ada ;; *.adb) xform=adb ;; *.ads) xform=ads ;; *.asm) xform=asm ;; *.c++) xform=c++ ;; *.cc) xform=cc ;; *.ii) xform=ii ;; *.class) xform=class ;; *.cpp) xform=cpp ;; *.cxx) xform=cxx ;; *.f90) xform=f90 ;; *.for) xform=for ;; *.java) xform=java ;; esac libobj=`$echo "X$libobj" | $Xsed -e "s/\.$xform$/.lo/"` case $libobj in *.lo) obj=`$echo "X$libobj" | $Xsed -e "$lo2o"` ;; *) $echo "$modename: cannot determine name of library object from \`$libobj'" 1>&2 exit $EXIT_FAILURE ;; esac func_infer_tag $base_compile for arg in $later; do case $arg in -static) build_old_libs=yes continue ;; -prefer-pic) pic_mode=yes continue ;; -prefer-non-pic) pic_mode=no continue ;; esac done qlibobj=`$echo "X$libobj" | $Xsed -e "$sed_quote_subst"` case $qlibobj in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") qlibobj="\"$qlibobj\"" ;; esac test "X$libobj" != "X$qlibobj" \ && $echo "X$libobj" | grep '[]~#^*{};<>?"'"'"' &()|`$[]' \ && $echo "$modename: libobj name \`$libobj' may not contain shell special characters." objname=`$echo "X$obj" | $Xsed -e 's%^.*/%%'` xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'` if test "X$xdir" = "X$obj"; then xdir= else xdir=$xdir/ fi lobj=${xdir}$objdir/$objname if test -z "$base_compile"; then $echo "$modename: you must specify a compilation command" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi # Delete any leftover library objects. if test "$build_old_libs" = yes; then removelist="$obj $lobj $libobj ${libobj}T" else removelist="$lobj $libobj ${libobj}T" fi $run $rm $removelist trap "$run $rm $removelist; exit $EXIT_FAILURE" 1 2 15 # On Cygwin there's no "real" PIC flag so we must build both object types case $host_os in cygwin* | mingw* | pw32* | os2*) pic_mode=default ;; esac if test "$pic_mode" = no && test "$deplibs_check_method" != pass_all; then # non-PIC code in shared libraries is not supported pic_mode=default fi # Calculate the filename of the output object if compiler does # not support -o with -c if test "$compiler_c_o" = no; then output_obj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\.[^.]*$%%'`.${objext} lockfile="$output_obj.lock" removelist="$removelist $output_obj $lockfile" trap "$run $rm $removelist; exit $EXIT_FAILURE" 1 2 15 else output_obj= need_locks=no lockfile= fi # Lock this critical section if it is needed # We use this script file to make the link, it avoids creating a new file if test "$need_locks" = yes; then until $run ln "$progpath" "$lockfile" 2>/dev/null; do $show "Waiting for $lockfile to be removed" sleep 2 done elif test "$need_locks" = warn; then if test -f "$lockfile"; then $echo "\ *** ERROR, $lockfile exists and contains: `cat $lockfile 2>/dev/null` This indicates that another process is trying to use the same temporary object file, and libtool could not work around it because your compiler does not support \`-c' and \`-o' together. If you repeat this compilation, it may succeed, by chance, but you had better avoid parallel builds (make -j) in this platform, or get a better compiler." $run $rm $removelist exit $EXIT_FAILURE fi $echo "$srcfile" > "$lockfile" fi if test -n "$fix_srcfile_path"; then eval srcfile=\"$fix_srcfile_path\" fi qsrcfile=`$echo "X$srcfile" | $Xsed -e "$sed_quote_subst"` case $qsrcfile in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") qsrcfile="\"$qsrcfile\"" ;; esac $run $rm "$libobj" "${libobj}T" # Create a libtool object file (analogous to a ".la" file), # but don't create it if we're doing a dry run. test -z "$run" && cat > ${libobj}T </dev/null`" != "X$srcfile"; then $echo "\ *** ERROR, $lockfile contains: `cat $lockfile 2>/dev/null` but it should contain: $srcfile This indicates that another process is trying to use the same temporary object file, and libtool could not work around it because your compiler does not support \`-c' and \`-o' together. If you repeat this compilation, it may succeed, by chance, but you had better avoid parallel builds (make -j) in this platform, or get a better compiler." $run $rm $removelist exit $EXIT_FAILURE fi # Just move the object if needed, then go on to compile the next one if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then $show "$mv $output_obj $lobj" if $run $mv $output_obj $lobj; then : else error=$? $run $rm $removelist exit $error fi fi # Append the name of the PIC object to the libtool object file. test -z "$run" && cat >> ${libobj}T <> ${libobj}T </dev/null`" != "X$srcfile"; then $echo "\ *** ERROR, $lockfile contains: `cat $lockfile 2>/dev/null` but it should contain: $srcfile This indicates that another process is trying to use the same temporary object file, and libtool could not work around it because your compiler does not support \`-c' and \`-o' together. If you repeat this compilation, it may succeed, by chance, but you had better avoid parallel builds (make -j) in this platform, or get a better compiler." $run $rm $removelist exit $EXIT_FAILURE fi # Just move the object if needed if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then $show "$mv $output_obj $obj" if $run $mv $output_obj $obj; then : else error=$? $run $rm $removelist exit $error fi fi # Append the name of the non-PIC object the libtool object file. # Only append if the libtool object file exists. test -z "$run" && cat >> ${libobj}T <> ${libobj}T <&2 fi if test -n "$link_static_flag"; then dlopen_self=$dlopen_self_static fi prefer_static_libs=yes else if test -z "$pic_flag" && test -n "$link_static_flag"; then dlopen_self=$dlopen_self_static fi prefer_static_libs=built fi build_libtool_libs=no build_old_libs=yes break ;; esac done # See if our shared archives depend on static archives. test -n "$old_archive_from_new_cmds" && build_old_libs=yes # Go through the arguments, transforming them on the way. while test "$#" -gt 0; do arg="$1" shift case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") qarg=\"`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`\" ### testsuite: skip nested quoting test ;; *) qarg=$arg ;; esac libtool_args="$libtool_args $qarg" # If the previous option needs an argument, assign it. if test -n "$prev"; then case $prev in output) compile_command="$compile_command @OUTPUT@" finalize_command="$finalize_command @OUTPUT@" ;; esac case $prev in dlfiles|dlprefiles) if test "$preload" = no; then # Add the symbol object into the linking commands. compile_command="$compile_command @SYMFILE@" finalize_command="$finalize_command @SYMFILE@" preload=yes fi case $arg in *.la | *.lo) ;; # We handle these cases below. force) if test "$dlself" = no; then dlself=needless export_dynamic=yes fi prev= continue ;; self) if test "$prev" = dlprefiles; then dlself=yes elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then dlself=yes else dlself=needless export_dynamic=yes fi prev= continue ;; *) if test "$prev" = dlfiles; then dlfiles="$dlfiles $arg" else dlprefiles="$dlprefiles $arg" fi prev= continue ;; esac ;; expsyms) export_symbols="$arg" if test ! -f "$arg"; then $echo "$modename: symbol file \`$arg' does not exist" exit $EXIT_FAILURE fi prev= continue ;; expsyms_regex) export_symbols_regex="$arg" prev= continue ;; inst_prefix) inst_prefix_dir="$arg" prev= continue ;; precious_regex) precious_files_regex="$arg" prev= continue ;; release) release="-$arg" prev= continue ;; objectlist) if test -f "$arg"; then save_arg=$arg moreargs= for fil in `cat $save_arg` do # moreargs="$moreargs $fil" arg=$fil # A libtool-controlled object. # Check to see that this really is a libtool object. if (${SED} -e '2q' $arg | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then pic_object= non_pic_object= # Read the .lo file # If there is no directory component, then add one. case $arg in */* | *\\*) . $arg ;; *) . ./$arg ;; esac if test -z "$pic_object" || \ test -z "$non_pic_object" || test "$pic_object" = none && \ test "$non_pic_object" = none; then $echo "$modename: cannot find name of object for \`$arg'" 1>&2 exit $EXIT_FAILURE fi # Extract subdirectory from the argument. xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` if test "X$xdir" = "X$arg"; then xdir= else xdir="$xdir/" fi if test "$pic_object" != none; then # Prepend the subdirectory the object is found in. pic_object="$xdir$pic_object" if test "$prev" = dlfiles; then if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then dlfiles="$dlfiles $pic_object" prev= continue else # If libtool objects are unsupported, then we need to preload. prev=dlprefiles fi fi # CHECK ME: I think I busted this. -Ossama if test "$prev" = dlprefiles; then # Preload the old-style object. dlprefiles="$dlprefiles $pic_object" prev= fi # A PIC object. libobjs="$libobjs $pic_object" arg="$pic_object" fi # Non-PIC object. if test "$non_pic_object" != none; then # Prepend the subdirectory the object is found in. non_pic_object="$xdir$non_pic_object" # A standard non-PIC object non_pic_objects="$non_pic_objects $non_pic_object" if test -z "$pic_object" || test "$pic_object" = none ; then arg="$non_pic_object" fi else # If the PIC object exists, use it instead. # $xdir was prepended to $pic_object above. non_pic_object="$pic_object" non_pic_objects="$non_pic_objects $non_pic_object" fi else # Only an error if not doing a dry-run. if test -z "$run"; then $echo "$modename: \`$arg' is not a valid libtool object" 1>&2 exit $EXIT_FAILURE else # Dry-run case. # Extract subdirectory from the argument. xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` if test "X$xdir" = "X$arg"; then xdir= else xdir="$xdir/" fi pic_object=`$echo "X${xdir}${objdir}/${arg}" | $Xsed -e "$lo2o"` non_pic_object=`$echo "X${xdir}${arg}" | $Xsed -e "$lo2o"` libobjs="$libobjs $pic_object" non_pic_objects="$non_pic_objects $non_pic_object" fi fi done else $echo "$modename: link input file \`$save_arg' does not exist" exit $EXIT_FAILURE fi arg=$save_arg prev= continue ;; rpath | xrpath) # We need an absolute path. case $arg in [\\/]* | [A-Za-z]:[\\/]*) ;; *) $echo "$modename: only absolute run-paths are allowed" 1>&2 exit $EXIT_FAILURE ;; esac if test "$prev" = rpath; then case "$rpath " in *" $arg "*) ;; *) rpath="$rpath $arg" ;; esac else case "$xrpath " in *" $arg "*) ;; *) xrpath="$xrpath $arg" ;; esac fi prev= continue ;; xcompiler) compiler_flags="$compiler_flags $qarg" prev= compile_command="$compile_command $qarg" finalize_command="$finalize_command $qarg" continue ;; xlinker) linker_flags="$linker_flags $qarg" compiler_flags="$compiler_flags $wl$qarg" prev= compile_command="$compile_command $wl$qarg" finalize_command="$finalize_command $wl$qarg" continue ;; xcclinker) linker_flags="$linker_flags $qarg" compiler_flags="$compiler_flags $qarg" prev= compile_command="$compile_command $qarg" finalize_command="$finalize_command $qarg" continue ;; shrext) shrext_cmds="$arg" prev= continue ;; darwin_framework|darwin_framework_skip) test "$prev" = "darwin_framework" && compiler_flags="$compiler_flags $arg" compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" prev= continue ;; *) eval "$prev=\"\$arg\"" prev= continue ;; esac fi # test -n "$prev" prevarg="$arg" case $arg in -all-static) if test -n "$link_static_flag"; then compile_command="$compile_command $link_static_flag" finalize_command="$finalize_command $link_static_flag" fi continue ;; -allow-undefined) # FIXME: remove this flag sometime in the future. $echo "$modename: \`-allow-undefined' is deprecated because it is the default" 1>&2 continue ;; -avoid-version) avoid_version=yes continue ;; -dlopen) prev=dlfiles continue ;; -dlpreopen) prev=dlprefiles continue ;; -export-dynamic) export_dynamic=yes continue ;; -export-symbols | -export-symbols-regex) if test -n "$export_symbols" || test -n "$export_symbols_regex"; then $echo "$modename: more than one -exported-symbols argument is not allowed" exit $EXIT_FAILURE fi if test "X$arg" = "X-export-symbols"; then prev=expsyms else prev=expsyms_regex fi continue ;; -framework|-arch|-isysroot) case " $CC " in *" ${arg} ${1} "* | *" ${arg} ${1} "*) prev=darwin_framework_skip ;; *) compiler_flags="$compiler_flags $arg" prev=darwin_framework ;; esac compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" continue ;; -inst-prefix-dir) prev=inst_prefix continue ;; # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:* # so, if we see these flags be careful not to treat them like -L -L[A-Z][A-Z]*:*) case $with_gcc/$host in no/*-*-irix* | /*-*-irix*) compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" ;; esac continue ;; -L*) dir=`$echo "X$arg" | $Xsed -e 's/^-L//'` # We need an absolute path. case $dir in [\\/]* | [A-Za-z]:[\\/]*) ;; *) absdir=`cd "$dir" && pwd` if test -z "$absdir"; then $echo "$modename: cannot determine absolute directory name of \`$dir'" 1>&2 absdir="$dir" notinst_path="$notinst_path $dir" fi dir="$absdir" ;; esac case "$deplibs " in *" -L$dir "*) ;; *) deplibs="$deplibs -L$dir" lib_search_path="$lib_search_path $dir" ;; esac case $host in *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) testbindir=`$echo "X$dir" | $Xsed -e 's*/lib$*/bin*'` case :$dllsearchpath: in *":$dir:"*) ;; *) dllsearchpath="$dllsearchpath:$dir";; esac case :$dllsearchpath: in *":$testbindir:"*) ;; *) dllsearchpath="$dllsearchpath:$testbindir";; esac ;; esac continue ;; -l*) if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then case $host in *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos*) # These systems don't actually have a C or math library (as such) continue ;; *-*-os2*) # These systems don't actually have a C library (as such) test "X$arg" = "X-lc" && continue ;; *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*) # Do not include libc due to us having libc/libc_r. test "X$arg" = "X-lc" && continue ;; *-*-rhapsody* | *-*-darwin1.[012]) # Rhapsody C and math libraries are in the System framework deplibs="$deplibs -framework System" continue ;; *-*-sco3.2v5* | *-*-sco5v6*) # Causes problems with __ctype test "X$arg" = "X-lc" && continue ;; *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*) # Compiler inserts libc in the correct place for threads to work test "X$arg" = "X-lc" && continue ;; esac elif test "X$arg" = "X-lc_r"; then case $host in *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*) # Do not include libc_r directly, use -pthread flag. continue ;; esac fi deplibs="$deplibs $arg" continue ;; # Tru64 UNIX uses -model [arg] to determine the layout of C++ # classes, name mangling, and exception handling. -model) compile_command="$compile_command $arg" compiler_flags="$compiler_flags $arg" finalize_command="$finalize_command $arg" prev=xcompiler continue ;; -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe) compiler_flags="$compiler_flags $arg" compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" continue ;; -module) module=yes continue ;; # -64, -mips[0-9] enable 64-bit mode on the SGI compiler # -r[0-9][0-9]* specifies the processor on the SGI compiler # -xarch=*, -xtarget=* enable 64-bit mode on the Sun compiler # +DA*, +DD* enable 64-bit mode on the HP compiler # -q* pass through compiler args for the IBM compiler # -m* pass through architecture-specific compiler args for GCC # -m*, -t[45]*, -txscale* pass through architecture-specific # compiler args for GCC # -pg pass through profiling flag for GCC # @file GCC response files -64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*|-pg| \ -t[45]*|-txscale*|@*) # Unknown arguments in both finalize_command and compile_command need # to be aesthetically quoted because they are evaled later. arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" compiler_flags="$compiler_flags $arg" continue ;; -shrext) prev=shrext continue ;; -no-fast-install) fast_install=no continue ;; -no-install) case $host in *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) # The PATH hackery in wrapper scripts is required on Windows # in order for the loader to find any dlls it needs. $echo "$modename: warning: \`-no-install' is ignored for $host" 1>&2 $echo "$modename: warning: assuming \`-no-fast-install' instead" 1>&2 fast_install=no ;; *) no_install=yes ;; esac continue ;; -no-undefined) allow_undefined=no continue ;; -objectlist) prev=objectlist continue ;; -o) prev=output ;; -precious-files-regex) prev=precious_regex continue ;; -release) prev=release continue ;; -rpath) prev=rpath continue ;; -R) prev=xrpath continue ;; -R*) dir=`$echo "X$arg" | $Xsed -e 's/^-R//'` # We need an absolute path. case $dir in [\\/]* | [A-Za-z]:[\\/]*) ;; *) $echo "$modename: only absolute run-paths are allowed" 1>&2 exit $EXIT_FAILURE ;; esac case "$xrpath " in *" $dir "*) ;; *) xrpath="$xrpath $dir" ;; esac continue ;; -static) # The effects of -static are defined in a previous loop. # We used to do the same as -all-static on platforms that # didn't have a PIC flag, but the assumption that the effects # would be equivalent was wrong. It would break on at least # Digital Unix and AIX. continue ;; -thread-safe) thread_safe=yes continue ;; -version-info) prev=vinfo continue ;; -version-number) prev=vinfo vinfo_number=yes continue ;; -Wc,*) args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wc,//'` arg= save_ifs="$IFS"; IFS=',' for flag in $args; do IFS="$save_ifs" case $flag in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") flag="\"$flag\"" ;; esac arg="$arg $wl$flag" compiler_flags="$compiler_flags $flag" done IFS="$save_ifs" arg=`$echo "X$arg" | $Xsed -e "s/^ //"` ;; -Wl,*) args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wl,//'` arg= save_ifs="$IFS"; IFS=',' for flag in $args; do IFS="$save_ifs" case $flag in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") flag="\"$flag\"" ;; esac arg="$arg $wl$flag" compiler_flags="$compiler_flags $wl$flag" linker_flags="$linker_flags $flag" done IFS="$save_ifs" arg=`$echo "X$arg" | $Xsed -e "s/^ //"` ;; -Xcompiler) prev=xcompiler continue ;; -Xlinker) prev=xlinker continue ;; -XCClinker) prev=xcclinker continue ;; # Some other compiler flag. -* | +*) # Unknown arguments in both finalize_command and compile_command need # to be aesthetically quoted because they are evaled later. arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac ;; *.$objext) # A standard object. objs="$objs $arg" ;; *.lo) # A libtool-controlled object. # Check to see that this really is a libtool object. if (${SED} -e '2q' $arg | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then pic_object= non_pic_object= # Read the .lo file # If there is no directory component, then add one. case $arg in */* | *\\*) . $arg ;; *) . ./$arg ;; esac if test -z "$pic_object" || \ test -z "$non_pic_object" || test "$pic_object" = none && \ test "$non_pic_object" = none; then $echo "$modename: cannot find name of object for \`$arg'" 1>&2 exit $EXIT_FAILURE fi # Extract subdirectory from the argument. xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` if test "X$xdir" = "X$arg"; then xdir= else xdir="$xdir/" fi if test "$pic_object" != none; then # Prepend the subdirectory the object is found in. pic_object="$xdir$pic_object" if test "$prev" = dlfiles; then if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then dlfiles="$dlfiles $pic_object" prev= continue else # If libtool objects are unsupported, then we need to preload. prev=dlprefiles fi fi # CHECK ME: I think I busted this. -Ossama if test "$prev" = dlprefiles; then # Preload the old-style object. dlprefiles="$dlprefiles $pic_object" prev= fi # A PIC object. libobjs="$libobjs $pic_object" arg="$pic_object" fi # Non-PIC object. if test "$non_pic_object" != none; then # Prepend the subdirectory the object is found in. non_pic_object="$xdir$non_pic_object" # A standard non-PIC object non_pic_objects="$non_pic_objects $non_pic_object" if test -z "$pic_object" || test "$pic_object" = none ; then arg="$non_pic_object" fi else # If the PIC object exists, use it instead. # $xdir was prepended to $pic_object above. non_pic_object="$pic_object" non_pic_objects="$non_pic_objects $non_pic_object" fi else # Only an error if not doing a dry-run. if test -z "$run"; then $echo "$modename: \`$arg' is not a valid libtool object" 1>&2 exit $EXIT_FAILURE else # Dry-run case. # Extract subdirectory from the argument. xdir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` if test "X$xdir" = "X$arg"; then xdir= else xdir="$xdir/" fi pic_object=`$echo "X${xdir}${objdir}/${arg}" | $Xsed -e "$lo2o"` non_pic_object=`$echo "X${xdir}${arg}" | $Xsed -e "$lo2o"` libobjs="$libobjs $pic_object" non_pic_objects="$non_pic_objects $non_pic_object" fi fi ;; *.$libext) # An archive. deplibs="$deplibs $arg" old_deplibs="$old_deplibs $arg" continue ;; *.la) # A libtool-controlled library. if test "$prev" = dlfiles; then # This library was specified with -dlopen. dlfiles="$dlfiles $arg" prev= elif test "$prev" = dlprefiles; then # The library was specified with -dlpreopen. dlprefiles="$dlprefiles $arg" prev= else deplibs="$deplibs $arg" fi continue ;; # Some other compiler argument. *) # Unknown arguments in both finalize_command and compile_command need # to be aesthetically quoted because they are evaled later. arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac ;; esac # arg # Now actually substitute the argument into the commands. if test -n "$arg"; then compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" fi done # argument parsing loop if test -n "$prev"; then $echo "$modename: the \`$prevarg' option requires an argument" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then eval arg=\"$export_dynamic_flag_spec\" compile_command="$compile_command $arg" finalize_command="$finalize_command $arg" fi oldlibs= # calculate the name of the file, without its directory outputname=`$echo "X$output" | $Xsed -e 's%^.*/%%'` libobjs_save="$libobjs" if test -n "$shlibpath_var"; then # get the directories listed in $shlibpath_var eval shlib_search_path=\`\$echo \"X\${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\` else shlib_search_path= fi eval sys_lib_search_path=\"$sys_lib_search_path_spec\" eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\" output_objdir=`$echo "X$output" | $Xsed -e 's%/[^/]*$%%'` if test "X$output_objdir" = "X$output"; then output_objdir="$objdir" else output_objdir="$output_objdir/$objdir" fi # Create the object directory. if test ! -d "$output_objdir"; then $show "$mkdir $output_objdir" $run $mkdir $output_objdir exit_status=$? if test "$exit_status" -ne 0 && test ! -d "$output_objdir"; then exit $exit_status fi fi # Determine the type of output case $output in "") $echo "$modename: you must specify an output file" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE ;; *.$libext) linkmode=oldlib ;; *.lo | *.$objext) linkmode=obj ;; *.la) linkmode=lib ;; *) linkmode=prog ;; # Anything else should be a program. esac case $host in *cygwin* | *mingw* | *pw32*) # don't eliminate duplications in $postdeps and $predeps duplicate_compiler_generated_deps=yes ;; *) duplicate_compiler_generated_deps=$duplicate_deps ;; esac specialdeplibs= libs= # Find all interdependent deplibs by searching for libraries # that are linked more than once (e.g. -la -lb -la) for deplib in $deplibs; do if test "X$duplicate_deps" = "Xyes" ; then case "$libs " in *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; esac fi libs="$libs $deplib" done if test "$linkmode" = lib; then libs="$predeps $libs $compiler_lib_search_path $postdeps" # Compute libraries that are listed more than once in $predeps # $postdeps and mark them as special (i.e., whose duplicates are # not to be eliminated). pre_post_deps= if test "X$duplicate_compiler_generated_deps" = "Xyes" ; then for pre_post_dep in $predeps $postdeps; do case "$pre_post_deps " in *" $pre_post_dep "*) specialdeplibs="$specialdeplibs $pre_post_deps" ;; esac pre_post_deps="$pre_post_deps $pre_post_dep" done fi pre_post_deps= fi deplibs= newdependency_libs= newlib_search_path= need_relink=no # whether we're linking any uninstalled libtool libraries notinst_deplibs= # not-installed libtool libraries case $linkmode in lib) passes="conv link" for file in $dlfiles $dlprefiles; do case $file in *.la) ;; *) $echo "$modename: libraries can \`-dlopen' only libtool libraries: $file" 1>&2 exit $EXIT_FAILURE ;; esac done ;; prog) compile_deplibs= finalize_deplibs= alldeplibs=no newdlfiles= newdlprefiles= passes="conv scan dlopen dlpreopen link" ;; *) passes="conv" ;; esac for pass in $passes; do if test "$linkmode,$pass" = "lib,link" || test "$linkmode,$pass" = "prog,scan"; then libs="$deplibs" deplibs= fi if test "$linkmode" = prog; then case $pass in dlopen) libs="$dlfiles" ;; dlpreopen) libs="$dlprefiles" ;; link) libs="$deplibs %DEPLIBS% $dependency_libs" ;; esac fi if test "$pass" = dlopen; then # Collect dlpreopened libraries save_deplibs="$deplibs" deplibs= fi for deplib in $libs; do lib= found=no case $deplib in -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe) if test "$linkmode,$pass" = "prog,link"; then compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" else compiler_flags="$compiler_flags $deplib" fi continue ;; -l*) if test "$linkmode" != lib && test "$linkmode" != prog; then $echo "$modename: warning: \`-l' is ignored for archives/objects" 1>&2 continue fi name=`$echo "X$deplib" | $Xsed -e 's/^-l//'` for searchdir in $newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path; do for search_ext in .la $std_shrext .so .a; do # Search the libtool library lib="$searchdir/lib${name}${search_ext}" if test -f "$lib"; then if test "$search_ext" = ".la"; then found=yes else found=no fi break 2 fi done done if test "$found" != yes; then # deplib doesn't seem to be a libtool library if test "$linkmode,$pass" = "prog,link"; then compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" else deplibs="$deplib $deplibs" test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs" fi continue else # deplib is a libtool library # If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib, # We need to do some special things here, and not later. if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then case " $predeps $postdeps " in *" $deplib "*) if (${SED} -e '2q' $lib | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then library_names= old_library= case $lib in */* | *\\*) . $lib ;; *) . ./$lib ;; esac for l in $old_library $library_names; do ll="$l" done if test "X$ll" = "X$old_library" ; then # only static version available found=no ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'` test "X$ladir" = "X$lib" && ladir="." lib=$ladir/$old_library if test "$linkmode,$pass" = "prog,link"; then compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" else deplibs="$deplib $deplibs" test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs" fi continue fi fi ;; *) ;; esac fi fi ;; # -l -L*) case $linkmode in lib) deplibs="$deplib $deplibs" test "$pass" = conv && continue newdependency_libs="$deplib $newdependency_libs" newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'` ;; prog) if test "$pass" = conv; then deplibs="$deplib $deplibs" continue fi if test "$pass" = scan; then deplibs="$deplib $deplibs" else compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" fi newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'` ;; *) $echo "$modename: warning: \`-L' is ignored for archives/objects" 1>&2 ;; esac # linkmode continue ;; # -L -R*) if test "$pass" = link; then dir=`$echo "X$deplib" | $Xsed -e 's/^-R//'` # Make sure the xrpath contains only unique directories. case "$xrpath " in *" $dir "*) ;; *) xrpath="$xrpath $dir" ;; esac fi deplibs="$deplib $deplibs" continue ;; *.la) lib="$deplib" ;; *.$libext) if test "$pass" = conv; then deplibs="$deplib $deplibs" continue fi case $linkmode in lib) valid_a_lib=no case $deplibs_check_method in match_pattern*) set dummy $deplibs_check_method match_pattern_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"` if eval $echo \"$deplib\" 2>/dev/null \ | $SED 10q \ | $EGREP "$match_pattern_regex" > /dev/null; then valid_a_lib=yes fi ;; pass_all) valid_a_lib=yes ;; esac if test "$valid_a_lib" != yes; then $echo $echo "*** Warning: Trying to link with static lib archive $deplib." $echo "*** I have the capability to make that library automatically link in when" $echo "*** you link to this library. But I can only do this if you have a" $echo "*** shared version of the library, which you do not appear to have" $echo "*** because the file extensions .$libext of this argument makes me believe" $echo "*** that it is just a static archive that I should not used here." else $echo $echo "*** Warning: Linking the shared library $output against the" $echo "*** static library $deplib is not portable!" deplibs="$deplib $deplibs" fi continue ;; prog) if test "$pass" != link; then deplibs="$deplib $deplibs" else compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" fi continue ;; esac # linkmode ;; # *.$libext *.lo | *.$objext) if test "$pass" = conv; then deplibs="$deplib $deplibs" elif test "$linkmode" = prog; then if test "$pass" = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then # If there is no dlopen support or we're linking statically, # we need to preload. newdlprefiles="$newdlprefiles $deplib" compile_deplibs="$deplib $compile_deplibs" finalize_deplibs="$deplib $finalize_deplibs" else newdlfiles="$newdlfiles $deplib" fi fi continue ;; %DEPLIBS%) alldeplibs=yes continue ;; esac # case $deplib if test "$found" = yes || test -f "$lib"; then : else $echo "$modename: cannot find the library \`$lib' or unhandled argument \`$deplib'" 1>&2 exit $EXIT_FAILURE fi # Check to see that this really is a libtool archive. if (${SED} -e '2q' $lib | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : else $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 exit $EXIT_FAILURE fi ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'` test "X$ladir" = "X$lib" && ladir="." dlname= dlopen= dlpreopen= libdir= library_names= old_library= # If the library was installed with an old release of libtool, # it will not redefine variables installed, or shouldnotlink installed=yes shouldnotlink=no avoidtemprpath= # Read the .la file case $lib in */* | *\\*) . $lib ;; *) . ./$lib ;; esac if test "$linkmode,$pass" = "lib,link" || test "$linkmode,$pass" = "prog,scan" || { test "$linkmode" != prog && test "$linkmode" != lib; }; then test -n "$dlopen" && dlfiles="$dlfiles $dlopen" test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen" fi if test "$pass" = conv; then # Only check for convenience libraries deplibs="$lib $deplibs" if test -z "$libdir"; then if test -z "$old_library"; then $echo "$modename: cannot find name of link library for \`$lib'" 1>&2 exit $EXIT_FAILURE fi # It is a libtool convenience library, so add in its objects. convenience="$convenience $ladir/$objdir/$old_library" old_convenience="$old_convenience $ladir/$objdir/$old_library" tmp_libs= for deplib in $dependency_libs; do deplibs="$deplib $deplibs" if test "X$duplicate_deps" = "Xyes" ; then case "$tmp_libs " in *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; esac fi tmp_libs="$tmp_libs $deplib" done elif test "$linkmode" != prog && test "$linkmode" != lib; then $echo "$modename: \`$lib' is not a convenience library" 1>&2 exit $EXIT_FAILURE fi continue fi # $pass = conv # Get the name of the library we link against. linklib= for l in $old_library $library_names; do linklib="$l" done if test -z "$linklib"; then $echo "$modename: cannot find name of link library for \`$lib'" 1>&2 exit $EXIT_FAILURE fi # This library was specified with -dlopen. if test "$pass" = dlopen; then if test -z "$libdir"; then $echo "$modename: cannot -dlopen a convenience library: \`$lib'" 1>&2 exit $EXIT_FAILURE fi if test -z "$dlname" || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then # If there is no dlname, no dlopen support or we're linking # statically, we need to preload. We also need to preload any # dependent libraries so libltdl's deplib preloader doesn't # bomb out in the load deplibs phase. dlprefiles="$dlprefiles $lib $dependency_libs" else newdlfiles="$newdlfiles $lib" fi continue fi # $pass = dlopen # We need an absolute path. case $ladir in [\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;; *) abs_ladir=`cd "$ladir" && pwd` if test -z "$abs_ladir"; then $echo "$modename: warning: cannot determine absolute directory name of \`$ladir'" 1>&2 $echo "$modename: passing it literally to the linker, although it might fail" 1>&2 abs_ladir="$ladir" fi ;; esac laname=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` # Find the relevant object directory and library name. if test "X$installed" = Xyes; then if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then $echo "$modename: warning: library \`$lib' was moved." 1>&2 dir="$ladir" absdir="$abs_ladir" libdir="$abs_ladir" else dir="$libdir" absdir="$libdir" fi test "X$hardcode_automatic" = Xyes && avoidtemprpath=yes else if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then dir="$ladir" absdir="$abs_ladir" # Remove this search path later notinst_path="$notinst_path $abs_ladir" else dir="$ladir/$objdir" absdir="$abs_ladir/$objdir" # Remove this search path later notinst_path="$notinst_path $abs_ladir" fi fi # $installed = yes name=`$echo "X$laname" | $Xsed -e 's/\.la$//' -e 's/^lib//'` # This library was specified with -dlpreopen. if test "$pass" = dlpreopen; then if test -z "$libdir"; then $echo "$modename: cannot -dlpreopen a convenience library: \`$lib'" 1>&2 exit $EXIT_FAILURE fi # Prefer using a static library (so that no silly _DYNAMIC symbols # are required to link). if test -n "$old_library"; then newdlprefiles="$newdlprefiles $dir/$old_library" # Otherwise, use the dlname, so that lt_dlopen finds it. elif test -n "$dlname"; then newdlprefiles="$newdlprefiles $dir/$dlname" else newdlprefiles="$newdlprefiles $dir/$linklib" fi fi # $pass = dlpreopen if test -z "$libdir"; then # Link the convenience library if test "$linkmode" = lib; then deplibs="$dir/$old_library $deplibs" elif test "$linkmode,$pass" = "prog,link"; then compile_deplibs="$dir/$old_library $compile_deplibs" finalize_deplibs="$dir/$old_library $finalize_deplibs" else deplibs="$lib $deplibs" # used for prog,scan pass fi continue fi if test "$linkmode" = prog && test "$pass" != link; then newlib_search_path="$newlib_search_path $ladir" deplibs="$lib $deplibs" linkalldeplibs=no if test "$link_all_deplibs" != no || test -z "$library_names" || test "$build_libtool_libs" = no; then linkalldeplibs=yes fi tmp_libs= for deplib in $dependency_libs; do case $deplib in -L*) newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`;; ### testsuite: skip nested quoting test esac # Need to link against all dependency_libs? if test "$linkalldeplibs" = yes; then deplibs="$deplib $deplibs" else # Need to hardcode shared library paths # or/and link against static libraries newdependency_libs="$deplib $newdependency_libs" fi if test "X$duplicate_deps" = "Xyes" ; then case "$tmp_libs " in *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; esac fi tmp_libs="$tmp_libs $deplib" done # for deplib continue fi # $linkmode = prog... if test "$linkmode,$pass" = "prog,link"; then if test -n "$library_names" && { test "$prefer_static_libs" = no || test -z "$old_library"; }; then # We need to hardcode the library path if test -n "$shlibpath_var" && test -z "$avoidtemprpath" ; then # Make sure the rpath contains only unique directories. case "$temp_rpath " in *" $dir "*) ;; *" $absdir "*) ;; *) temp_rpath="$temp_rpath $absdir" ;; esac fi # Hardcode the library path. # Skip directories that are in the system default run-time # search path. case " $sys_lib_dlsearch_path " in *" $absdir "*) ;; *) case "$compile_rpath " in *" $absdir "*) ;; *) compile_rpath="$compile_rpath $absdir" esac ;; esac case " $sys_lib_dlsearch_path " in *" $libdir "*) ;; *) case "$finalize_rpath " in *" $libdir "*) ;; *) finalize_rpath="$finalize_rpath $libdir" esac ;; esac fi # $linkmode,$pass = prog,link... if test "$alldeplibs" = yes && { test "$deplibs_check_method" = pass_all || { test "$build_libtool_libs" = yes && test -n "$library_names"; }; }; then # We only need to search for static libraries continue fi fi link_static=no # Whether the deplib will be linked statically use_static_libs=$prefer_static_libs if test "$use_static_libs" = built && test "$installed" = yes ; then use_static_libs=no fi if test -n "$library_names" && { test "$use_static_libs" = no || test -z "$old_library"; }; then if test "$installed" = no; then notinst_deplibs="$notinst_deplibs $lib" need_relink=yes fi # This is a shared library # Warn about portability, can't link against -module's on # some systems (darwin) if test "$shouldnotlink" = yes && test "$pass" = link ; then $echo if test "$linkmode" = prog; then $echo "*** Warning: Linking the executable $output against the loadable module" else $echo "*** Warning: Linking the shared library $output against the loadable module" fi $echo "*** $linklib is not portable!" fi if test "$linkmode" = lib && test "$hardcode_into_libs" = yes; then # Hardcode the library path. # Skip directories that are in the system default run-time # search path. case " $sys_lib_dlsearch_path " in *" $absdir "*) ;; *) case "$compile_rpath " in *" $absdir "*) ;; *) compile_rpath="$compile_rpath $absdir" esac ;; esac case " $sys_lib_dlsearch_path " in *" $libdir "*) ;; *) case "$finalize_rpath " in *" $libdir "*) ;; *) finalize_rpath="$finalize_rpath $libdir" esac ;; esac fi if test -n "$old_archive_from_expsyms_cmds"; then # figure out the soname set dummy $library_names realname="$2" shift; shift libname=`eval \\$echo \"$libname_spec\"` # use dlname if we got it. it's perfectly good, no? if test -n "$dlname"; then soname="$dlname" elif test -n "$soname_spec"; then # bleh windows case $host in *cygwin* | mingw*) major=`expr $current - $age` versuffix="-$major" ;; esac eval soname=\"$soname_spec\" else soname="$realname" fi # Make a new name for the extract_expsyms_cmds to use soroot="$soname" soname=`$echo $soroot | ${SED} -e 's/^.*\///'` newlib="libimp-`$echo $soname | ${SED} 's/^lib//;s/\.dll$//'`.a" # If the library has no export list, then create one now if test -f "$output_objdir/$soname-def"; then : else $show "extracting exported symbol list from \`$soname'" save_ifs="$IFS"; IFS='~' cmds=$extract_expsyms_cmds for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" fi # Create $newlib if test -f "$output_objdir/$newlib"; then :; else $show "generating import library for \`$soname'" save_ifs="$IFS"; IFS='~' cmds=$old_archive_from_expsyms_cmds for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" fi # make sure the library variables are pointing to the new library dir=$output_objdir linklib=$newlib fi # test -n "$old_archive_from_expsyms_cmds" if test "$linkmode" = prog || test "$mode" != relink; then add_shlibpath= add_dir= add= lib_linked=yes case $hardcode_action in immediate | unsupported) if test "$hardcode_direct" = no; then add="$dir/$linklib" case $host in *-*-sco3.2v5.0.[024]*) add_dir="-L$dir" ;; *-*-sysv4*uw2*) add_dir="-L$dir" ;; *-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \ *-*-unixware7*) add_dir="-L$dir" ;; *-*-darwin* ) # if the lib is a module then we can not link against # it, someone is ignoring the new warnings I added if /usr/bin/file -L $add 2> /dev/null | $EGREP ": [^:]* bundle" >/dev/null ; then $echo "** Warning, lib $linklib is a module, not a shared library" if test -z "$old_library" ; then $echo $echo "** And there doesn't seem to be a static archive available" $echo "** The link will probably fail, sorry" else add="$dir/$old_library" fi fi esac elif test "$hardcode_minus_L" = no; then case $host in *-*-sunos*) add_shlibpath="$dir" ;; esac add_dir="-L$dir" add="-l$name" elif test "$hardcode_shlibpath_var" = no; then add_shlibpath="$dir" add="-l$name" else lib_linked=no fi ;; relink) if test "$hardcode_direct" = yes; then add="$dir/$linklib" elif test "$hardcode_minus_L" = yes; then add_dir="-L$dir" # Try looking first in the location we're being installed to. if test -n "$inst_prefix_dir"; then case $libdir in [\\/]*) add_dir="$add_dir -L$inst_prefix_dir$libdir" ;; esac fi add="-l$name" elif test "$hardcode_shlibpath_var" = yes; then add_shlibpath="$dir" add="-l$name" else lib_linked=no fi ;; *) lib_linked=no ;; esac if test "$lib_linked" != yes; then $echo "$modename: configuration error: unsupported hardcode properties" exit $EXIT_FAILURE fi if test -n "$add_shlibpath"; then case :$compile_shlibpath: in *":$add_shlibpath:"*) ;; *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;; esac fi if test "$linkmode" = prog; then test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs" test -n "$add" && compile_deplibs="$add $compile_deplibs" else test -n "$add_dir" && deplibs="$add_dir $deplibs" test -n "$add" && deplibs="$add $deplibs" if test "$hardcode_direct" != yes && \ test "$hardcode_minus_L" != yes && \ test "$hardcode_shlibpath_var" = yes; then case :$finalize_shlibpath: in *":$libdir:"*) ;; *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;; esac fi fi fi if test "$linkmode" = prog || test "$mode" = relink; then add_shlibpath= add_dir= add= # Finalize command for both is simple: just hardcode it. if test "$hardcode_direct" = yes; then add="$libdir/$linklib" elif test "$hardcode_minus_L" = yes; then add_dir="-L$libdir" add="-l$name" elif test "$hardcode_shlibpath_var" = yes; then case :$finalize_shlibpath: in *":$libdir:"*) ;; *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;; esac add="-l$name" elif test "$hardcode_automatic" = yes; then if test -n "$inst_prefix_dir" && test -f "$inst_prefix_dir$libdir/$linklib" ; then add="$inst_prefix_dir$libdir/$linklib" else add="$libdir/$linklib" fi else # We cannot seem to hardcode it, guess we'll fake it. add_dir="-L$libdir" # Try looking first in the location we're being installed to. if test -n "$inst_prefix_dir"; then case $libdir in [\\/]*) add_dir="$add_dir -L$inst_prefix_dir$libdir" ;; esac fi add="-l$name" fi if test "$linkmode" = prog; then test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs" test -n "$add" && finalize_deplibs="$add $finalize_deplibs" else test -n "$add_dir" && deplibs="$add_dir $deplibs" test -n "$add" && deplibs="$add $deplibs" fi fi elif test "$linkmode" = prog; then # Here we assume that one of hardcode_direct or hardcode_minus_L # is not unsupported. This is valid on all known static and # shared platforms. if test "$hardcode_direct" != unsupported; then test -n "$old_library" && linklib="$old_library" compile_deplibs="$dir/$linklib $compile_deplibs" finalize_deplibs="$dir/$linklib $finalize_deplibs" else compile_deplibs="-l$name -L$dir $compile_deplibs" finalize_deplibs="-l$name -L$dir $finalize_deplibs" fi elif test "$build_libtool_libs" = yes; then # Not a shared library if test "$deplibs_check_method" != pass_all; then # We're trying link a shared library against a static one # but the system doesn't support it. # Just print a warning and add the library to dependency_libs so # that the program can be linked against the static library. $echo $echo "*** Warning: This system can not link to static lib archive $lib." $echo "*** I have the capability to make that library automatically link in when" $echo "*** you link to this library. But I can only do this if you have a" $echo "*** shared version of the library, which you do not appear to have." if test "$module" = yes; then $echo "*** But as you try to build a module library, libtool will still create " $echo "*** a static module, that should work as long as the dlopening application" $echo "*** is linked with the -dlopen flag to resolve symbols at runtime." if test -z "$global_symbol_pipe"; then $echo $echo "*** However, this would only work if libtool was able to extract symbol" $echo "*** lists from a program, using \`nm' or equivalent, but libtool could" $echo "*** not find such a program. So, this module is probably useless." $echo "*** \`nm' from GNU binutils and a full rebuild may help." fi if test "$build_old_libs" = no; then build_libtool_libs=module build_old_libs=yes else build_libtool_libs=no fi fi else deplibs="$dir/$old_library $deplibs" link_static=yes fi fi # link shared/static library? if test "$linkmode" = lib; then if test -n "$dependency_libs" && { test "$hardcode_into_libs" != yes || test "$build_old_libs" = yes || test "$link_static" = yes; }; then # Extract -R from dependency_libs temp_deplibs= for libdir in $dependency_libs; do case $libdir in -R*) temp_xrpath=`$echo "X$libdir" | $Xsed -e 's/^-R//'` case " $xrpath " in *" $temp_xrpath "*) ;; *) xrpath="$xrpath $temp_xrpath";; esac;; *) temp_deplibs="$temp_deplibs $libdir";; esac done dependency_libs="$temp_deplibs" fi newlib_search_path="$newlib_search_path $absdir" # Link against this library test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs" # ... and its dependency_libs tmp_libs= for deplib in $dependency_libs; do newdependency_libs="$deplib $newdependency_libs" if test "X$duplicate_deps" = "Xyes" ; then case "$tmp_libs " in *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;; esac fi tmp_libs="$tmp_libs $deplib" done if test "$link_all_deplibs" != no; then # Add the search paths of all dependency libraries for deplib in $dependency_libs; do case $deplib in -L*) path="$deplib" ;; *.la) dir=`$echo "X$deplib" | $Xsed -e 's%/[^/]*$%%'` test "X$dir" = "X$deplib" && dir="." # We need an absolute path. case $dir in [\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;; *) absdir=`cd "$dir" && pwd` if test -z "$absdir"; then $echo "$modename: warning: cannot determine absolute directory name of \`$dir'" 1>&2 absdir="$dir" fi ;; esac if grep "^installed=no" $deplib > /dev/null; then path="$absdir/$objdir" else eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib` if test -z "$libdir"; then $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2 exit $EXIT_FAILURE fi if test "$absdir" != "$libdir"; then $echo "$modename: warning: \`$deplib' seems to be moved" 1>&2 fi path="$absdir" fi depdepl= case $host in *-*-darwin*) # we do not want to link against static libs, # but need to link against shared eval deplibrary_names=`${SED} -n -e 's/^library_names=\(.*\)$/\1/p' $deplib` if test -n "$deplibrary_names" ; then for tmp in $deplibrary_names ; do depdepl=$tmp done if test -f "$path/$depdepl" ; then depdepl="$path/$depdepl" fi # do not add paths which are already there case " $newlib_search_path " in *" $path "*) ;; *) newlib_search_path="$newlib_search_path $path";; esac fi path="" ;; *) path="-L$path" ;; esac ;; -l*) case $host in *-*-darwin*) # Again, we only want to link against shared libraries eval tmp_libs=`$echo "X$deplib" | $Xsed -e "s,^\-l,,"` for tmp in $newlib_search_path ; do if test -f "$tmp/lib$tmp_libs.dylib" ; then eval depdepl="$tmp/lib$tmp_libs.dylib" break fi done path="" ;; *) continue ;; esac ;; *) continue ;; esac case " $deplibs " in *" $path "*) ;; *) deplibs="$path $deplibs" ;; esac case " $deplibs " in *" $depdepl "*) ;; *) deplibs="$depdepl $deplibs" ;; esac done fi # link_all_deplibs != no fi # linkmode = lib done # for deplib in $libs dependency_libs="$newdependency_libs" if test "$pass" = dlpreopen; then # Link the dlpreopened libraries before other libraries for deplib in $save_deplibs; do deplibs="$deplib $deplibs" done fi if test "$pass" != dlopen; then if test "$pass" != conv; then # Make sure lib_search_path contains only unique directories. lib_search_path= for dir in $newlib_search_path; do case "$lib_search_path " in *" $dir "*) ;; *) lib_search_path="$lib_search_path $dir" ;; esac done newlib_search_path= fi if test "$linkmode,$pass" != "prog,link"; then vars="deplibs" else vars="compile_deplibs finalize_deplibs" fi for var in $vars dependency_libs; do # Add libraries to $var in reverse order eval tmp_libs=\"\$$var\" new_libs= for deplib in $tmp_libs; do # FIXME: Pedantically, this is the right thing to do, so # that some nasty dependency loop isn't accidentally # broken: #new_libs="$deplib $new_libs" # Pragmatically, this seems to cause very few problems in # practice: case $deplib in -L*) new_libs="$deplib $new_libs" ;; -R*) ;; *) # And here is the reason: when a library appears more # than once as an explicit dependence of a library, or # is implicitly linked in more than once by the # compiler, it is considered special, and multiple # occurrences thereof are not removed. Compare this # with having the same library being listed as a # dependency of multiple other libraries: in this case, # we know (pedantically, we assume) the library does not # need to be listed more than once, so we keep only the # last copy. This is not always right, but it is rare # enough that we require users that really mean to play # such unportable linking tricks to link the library # using -Wl,-lname, so that libtool does not consider it # for duplicate removal. case " $specialdeplibs " in *" $deplib "*) new_libs="$deplib $new_libs" ;; *) case " $new_libs " in *" $deplib "*) ;; *) new_libs="$deplib $new_libs" ;; esac ;; esac ;; esac done tmp_libs= for deplib in $new_libs; do case $deplib in -L*) case " $tmp_libs " in *" $deplib "*) ;; *) tmp_libs="$tmp_libs $deplib" ;; esac ;; *) tmp_libs="$tmp_libs $deplib" ;; esac done eval $var=\"$tmp_libs\" done # for var fi # Last step: remove runtime libs from dependency_libs # (they stay in deplibs) tmp_libs= for i in $dependency_libs ; do case " $predeps $postdeps $compiler_lib_search_path " in *" $i "*) i="" ;; esac if test -n "$i" ; then tmp_libs="$tmp_libs $i" fi done dependency_libs=$tmp_libs done # for pass if test "$linkmode" = prog; then dlfiles="$newdlfiles" dlprefiles="$newdlprefiles" fi case $linkmode in oldlib) if test -n "$deplibs"; then $echo "$modename: warning: \`-l' and \`-L' are ignored for archives" 1>&2 fi if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then $echo "$modename: warning: \`-dlopen' is ignored for archives" 1>&2 fi if test -n "$rpath"; then $echo "$modename: warning: \`-rpath' is ignored for archives" 1>&2 fi if test -n "$xrpath"; then $echo "$modename: warning: \`-R' is ignored for archives" 1>&2 fi if test -n "$vinfo"; then $echo "$modename: warning: \`-version-info/-version-number' is ignored for archives" 1>&2 fi if test -n "$release"; then $echo "$modename: warning: \`-release' is ignored for archives" 1>&2 fi if test -n "$export_symbols" || test -n "$export_symbols_regex"; then $echo "$modename: warning: \`-export-symbols' is ignored for archives" 1>&2 fi # Now set the variables for building old libraries. build_libtool_libs=no oldlibs="$output" objs="$objs$old_deplibs" ;; lib) # Make sure we only generate libraries of the form `libNAME.la'. case $outputname in lib*) name=`$echo "X$outputname" | $Xsed -e 's/\.la$//' -e 's/^lib//'` eval shared_ext=\"$shrext_cmds\" eval libname=\"$libname_spec\" ;; *) if test "$module" = no; then $echo "$modename: libtool library \`$output' must begin with \`lib'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi if test "$need_lib_prefix" != no; then # Add the "lib" prefix for modules if required name=`$echo "X$outputname" | $Xsed -e 's/\.la$//'` eval shared_ext=\"$shrext_cmds\" eval libname=\"$libname_spec\" else libname=`$echo "X$outputname" | $Xsed -e 's/\.la$//'` fi ;; esac if test -n "$objs"; then if test "$deplibs_check_method" != pass_all; then $echo "$modename: cannot build libtool library \`$output' from non-libtool objects on this host:$objs" 2>&1 exit $EXIT_FAILURE else $echo $echo "*** Warning: Linking the shared library $output against the non-libtool" $echo "*** objects $objs is not portable!" libobjs="$libobjs $objs" fi fi if test "$dlself" != no; then $echo "$modename: warning: \`-dlopen self' is ignored for libtool libraries" 1>&2 fi set dummy $rpath if test "$#" -gt 2; then $echo "$modename: warning: ignoring multiple \`-rpath's for a libtool library" 1>&2 fi install_libdir="$2" oldlibs= if test -z "$rpath"; then if test "$build_libtool_libs" = yes; then # Building a libtool convenience library. # Some compilers have problems with a `.al' extension so # convenience libraries should have the same extension an # archive normally would. oldlibs="$output_objdir/$libname.$libext $oldlibs" build_libtool_libs=convenience build_old_libs=yes fi if test -n "$vinfo"; then $echo "$modename: warning: \`-version-info/-version-number' is ignored for convenience libraries" 1>&2 fi if test -n "$release"; then $echo "$modename: warning: \`-release' is ignored for convenience libraries" 1>&2 fi else # Parse the version information argument. save_ifs="$IFS"; IFS=':' set dummy $vinfo 0 0 0 IFS="$save_ifs" if test -n "$8"; then $echo "$modename: too many parameters to \`-version-info'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi # convert absolute version numbers to libtool ages # this retains compatibility with .la files and attempts # to make the code below a bit more comprehensible case $vinfo_number in yes) number_major="$2" number_minor="$3" number_revision="$4" # # There are really only two kinds -- those that # use the current revision as the major version # and those that subtract age and use age as # a minor version. But, then there is irix # which has an extra 1 added just for fun # case $version_type in darwin|linux|osf|windows) current=`expr $number_major + $number_minor` age="$number_minor" revision="$number_revision" ;; freebsd-aout|freebsd-elf|sunos) current="$number_major" revision="$number_minor" age="0" ;; irix|nonstopux) current=`expr $number_major + $number_minor - 1` age="$number_minor" revision="$number_minor" ;; esac ;; no) current="$2" revision="$3" age="$4" ;; esac # Check that each of the things are valid numbers. case $current in 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; *) $echo "$modename: CURRENT \`$current' must be a nonnegative integer" 1>&2 $echo "$modename: \`$vinfo' is not valid version information" 1>&2 exit $EXIT_FAILURE ;; esac case $revision in 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; *) $echo "$modename: REVISION \`$revision' must be a nonnegative integer" 1>&2 $echo "$modename: \`$vinfo' is not valid version information" 1>&2 exit $EXIT_FAILURE ;; esac case $age in 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; *) $echo "$modename: AGE \`$age' must be a nonnegative integer" 1>&2 $echo "$modename: \`$vinfo' is not valid version information" 1>&2 exit $EXIT_FAILURE ;; esac if test "$age" -gt "$current"; then $echo "$modename: AGE \`$age' is greater than the current interface number \`$current'" 1>&2 $echo "$modename: \`$vinfo' is not valid version information" 1>&2 exit $EXIT_FAILURE fi # Calculate the version variables. major= versuffix= verstring= case $version_type in none) ;; darwin) # Like Linux, but with the current version available in # verstring for coding it into the library header major=.`expr $current - $age` versuffix="$major.$age.$revision" # Darwin ld doesn't like 0 for these options... minor_current=`expr $current + 1` verstring="${wl}-compatibility_version ${wl}$minor_current ${wl}-current_version ${wl}$minor_current.$revision" ;; freebsd-aout) major=".$current" versuffix=".$current.$revision"; ;; freebsd-elf) major=".$current" versuffix=".$current"; ;; irix | nonstopux) major=`expr $current - $age + 1` case $version_type in nonstopux) verstring_prefix=nonstopux ;; *) verstring_prefix=sgi ;; esac verstring="$verstring_prefix$major.$revision" # Add in all the interfaces that we are compatible with. loop=$revision while test "$loop" -ne 0; do iface=`expr $revision - $loop` loop=`expr $loop - 1` verstring="$verstring_prefix$major.$iface:$verstring" done # Before this point, $major must not contain `.'. major=.$major versuffix="$major.$revision" ;; linux) major=.`expr $current - $age` versuffix="$major.$age.$revision" ;; osf) major=.`expr $current - $age` versuffix=".$current.$age.$revision" verstring="$current.$age.$revision" # Add in all the interfaces that we are compatible with. loop=$age while test "$loop" -ne 0; do iface=`expr $current - $loop` loop=`expr $loop - 1` verstring="$verstring:${iface}.0" done # Make executables depend on our current version. verstring="$verstring:${current}.0" ;; sunos) major=".$current" versuffix=".$current.$revision" ;; windows) # Use '-' rather than '.', since we only want one # extension on DOS 8.3 filesystems. major=`expr $current - $age` versuffix="-$major" ;; *) $echo "$modename: unknown library version type \`$version_type'" 1>&2 $echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 exit $EXIT_FAILURE ;; esac # Clear the version info if we defaulted, and they specified a release. if test -z "$vinfo" && test -n "$release"; then major= case $version_type in darwin) # we can't check for "0.0" in archive_cmds due to quoting # problems, so we reset it completely verstring= ;; *) verstring="0.0" ;; esac if test "$need_version" = no; then versuffix= else versuffix=".0.0" fi fi # Remove version info from name if versioning should be avoided if test "$avoid_version" = yes && test "$need_version" = no; then major= versuffix= verstring="" fi # Check to see if the archive will have undefined symbols. if test "$allow_undefined" = yes; then if test "$allow_undefined_flag" = unsupported; then $echo "$modename: warning: undefined symbols not allowed in $host shared libraries" 1>&2 build_libtool_libs=no build_old_libs=yes fi else # Don't allow undefined symbols. allow_undefined_flag="$no_undefined_flag" fi fi if test "$mode" != relink; then # Remove our outputs, but don't remove object files since they # may have been created when compiling PIC objects. removelist= tempremovelist=`$echo "$output_objdir/*"` for p in $tempremovelist; do case $p in *.$objext) ;; $output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/${libname}${release}.*) if test "X$precious_files_regex" != "X"; then if echo $p | $EGREP -e "$precious_files_regex" >/dev/null 2>&1 then continue fi fi removelist="$removelist $p" ;; *) ;; esac done if test -n "$removelist"; then $show "${rm}r $removelist" $run ${rm}r $removelist fi fi # Now set the variables for building old libraries. if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then oldlibs="$oldlibs $output_objdir/$libname.$libext" # Transform .lo files to .o files. oldobjs="$objs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP` fi # Eliminate all temporary directories. for path in $notinst_path; do lib_search_path=`$echo "$lib_search_path " | ${SED} -e "s% $path % %g"` deplibs=`$echo "$deplibs " | ${SED} -e "s% -L$path % %g"` dependency_libs=`$echo "$dependency_libs " | ${SED} -e "s% -L$path % %g"` done if test -n "$xrpath"; then # If the user specified any rpath flags, then add them. temp_xrpath= for libdir in $xrpath; do temp_xrpath="$temp_xrpath -R$libdir" case "$finalize_rpath " in *" $libdir "*) ;; *) finalize_rpath="$finalize_rpath $libdir" ;; esac done if test "$hardcode_into_libs" != yes || test "$build_old_libs" = yes; then dependency_libs="$temp_xrpath $dependency_libs" fi fi # Make sure dlfiles contains only unique files that won't be dlpreopened old_dlfiles="$dlfiles" dlfiles= for lib in $old_dlfiles; do case " $dlprefiles $dlfiles " in *" $lib "*) ;; *) dlfiles="$dlfiles $lib" ;; esac done # Make sure dlprefiles contains only unique files old_dlprefiles="$dlprefiles" dlprefiles= for lib in $old_dlprefiles; do case "$dlprefiles " in *" $lib "*) ;; *) dlprefiles="$dlprefiles $lib" ;; esac done if test "$build_libtool_libs" = yes; then if test -n "$rpath"; then case $host in *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos*) # these systems don't actually have a c library (as such)! ;; *-*-rhapsody* | *-*-darwin1.[012]) # Rhapsody C library is in the System framework deplibs="$deplibs -framework System" ;; *-*-netbsd*) # Don't link with libc until the a.out ld.so is fixed. ;; *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*) # Do not include libc due to us having libc/libc_r. ;; *-*-sco3.2v5* | *-*-sco5v6*) # Causes problems with __ctype ;; *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*) # Compiler inserts libc in the correct place for threads to work ;; *) # Add libc to deplibs on all other systems if necessary. if test "$build_libtool_need_lc" = "yes"; then deplibs="$deplibs -lc" fi ;; esac fi # Transform deplibs into only deplibs that can be linked in shared. name_save=$name libname_save=$libname release_save=$release versuffix_save=$versuffix major_save=$major # I'm not sure if I'm treating the release correctly. I think # release should show up in the -l (ie -lgmp5) so we don't want to # add it in twice. Is that correct? release="" versuffix="" major="" newdeplibs= droppeddeps=no case $deplibs_check_method in pass_all) # Don't check for shared/static. Everything works. # This might be a little naive. We might want to check # whether the library exists or not. But this is on # osf3 & osf4 and I'm not really sure... Just # implementing what was already the behavior. newdeplibs=$deplibs ;; test_compile) # This code stresses the "libraries are programs" paradigm to its # limits. Maybe even breaks it. We compile a program, linking it # against the deplibs as a proxy for the library. Then we can check # whether they linked in statically or dynamically with ldd. $rm conftest.c cat > conftest.c </dev/null` for potent_lib in $potential_libs; do # Follow soft links. if ls -lLd "$potent_lib" 2>/dev/null \ | grep " -> " >/dev/null; then continue fi # The statement above tries to avoid entering an # endless loop below, in case of cyclic links. # We might still enter an endless loop, since a link # loop can be closed while we follow links, # but so what? potlib="$potent_lib" while test -h "$potlib" 2>/dev/null; do potliblink=`ls -ld $potlib | ${SED} 's/.* -> //'` case $potliblink in [\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";; *) potlib=`$echo "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";; esac done if eval $file_magic_cmd \"\$potlib\" 2>/dev/null \ | ${SED} 10q \ | $EGREP "$file_magic_regex" > /dev/null; then newdeplibs="$newdeplibs $a_deplib" a_deplib="" break 2 fi done done fi if test -n "$a_deplib" ; then droppeddeps=yes $echo $echo "*** Warning: linker path does not have real file for library $a_deplib." $echo "*** I have the capability to make that library automatically link in when" $echo "*** you link to this library. But I can only do this if you have a" $echo "*** shared version of the library, which you do not appear to have" $echo "*** because I did check the linker path looking for a file starting" if test -z "$potlib" ; then $echo "*** with $libname but no candidates were found. (...for file magic test)" else $echo "*** with $libname and none of the candidates passed a file format test" $echo "*** using a file magic. Last file checked: $potlib" fi fi else # Add a -L argument. newdeplibs="$newdeplibs $a_deplib" fi done # Gone through all deplibs. ;; match_pattern*) set dummy $deplibs_check_method match_pattern_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"` for a_deplib in $deplibs; do name=`expr $a_deplib : '-l\(.*\)'` # If $name is empty we are operating on a -L argument. if test -n "$name" && test "$name" != "0"; then if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then case " $predeps $postdeps " in *" $a_deplib "*) newdeplibs="$newdeplibs $a_deplib" a_deplib="" ;; esac fi if test -n "$a_deplib" ; then libname=`eval \\$echo \"$libname_spec\"` for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do potential_libs=`ls $i/$libname[.-]* 2>/dev/null` for potent_lib in $potential_libs; do potlib="$potent_lib" # see symlink-check above in file_magic test if eval $echo \"$potent_lib\" 2>/dev/null \ | ${SED} 10q \ | $EGREP "$match_pattern_regex" > /dev/null; then newdeplibs="$newdeplibs $a_deplib" a_deplib="" break 2 fi done done fi if test -n "$a_deplib" ; then droppeddeps=yes $echo $echo "*** Warning: linker path does not have real file for library $a_deplib." $echo "*** I have the capability to make that library automatically link in when" $echo "*** you link to this library. But I can only do this if you have a" $echo "*** shared version of the library, which you do not appear to have" $echo "*** because I did check the linker path looking for a file starting" if test -z "$potlib" ; then $echo "*** with $libname but no candidates were found. (...for regex pattern test)" else $echo "*** with $libname and none of the candidates passed a file format test" $echo "*** using a regex pattern. Last file checked: $potlib" fi fi else # Add a -L argument. newdeplibs="$newdeplibs $a_deplib" fi done # Gone through all deplibs. ;; none | unknown | *) newdeplibs="" tmp_deplibs=`$echo "X $deplibs" | $Xsed -e 's/ -lc$//' \ -e 's/ -[LR][^ ]*//g'` if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then for i in $predeps $postdeps ; do # can't use Xsed below, because $i might contain '/' tmp_deplibs=`$echo "X $tmp_deplibs" | ${SED} -e "1s,^X,," -e "s,$i,,"` done fi if $echo "X $tmp_deplibs" | $Xsed -e 's/[ ]//g' \ | grep . >/dev/null; then $echo if test "X$deplibs_check_method" = "Xnone"; then $echo "*** Warning: inter-library dependencies are not supported in this platform." else $echo "*** Warning: inter-library dependencies are not known to be supported." fi $echo "*** All declared inter-library dependencies are being dropped." droppeddeps=yes fi ;; esac versuffix=$versuffix_save major=$major_save release=$release_save libname=$libname_save name=$name_save case $host in *-*-rhapsody* | *-*-darwin1.[012]) # On Rhapsody replace the C library is the System framework newdeplibs=`$echo "X $newdeplibs" | $Xsed -e 's/ -lc / -framework System /'` ;; esac if test "$droppeddeps" = yes; then if test "$module" = yes; then $echo $echo "*** Warning: libtool could not satisfy all declared inter-library" $echo "*** dependencies of module $libname. Therefore, libtool will create" $echo "*** a static module, that should work as long as the dlopening" $echo "*** application is linked with the -dlopen flag." if test -z "$global_symbol_pipe"; then $echo $echo "*** However, this would only work if libtool was able to extract symbol" $echo "*** lists from a program, using \`nm' or equivalent, but libtool could" $echo "*** not find such a program. So, this module is probably useless." $echo "*** \`nm' from GNU binutils and a full rebuild may help." fi if test "$build_old_libs" = no; then oldlibs="$output_objdir/$libname.$libext" build_libtool_libs=module build_old_libs=yes else build_libtool_libs=no fi else $echo "*** The inter-library dependencies that have been dropped here will be" $echo "*** automatically added whenever a program is linked with this library" $echo "*** or is declared to -dlopen it." if test "$allow_undefined" = no; then $echo $echo "*** Since this library must not contain undefined symbols," $echo "*** because either the platform does not support them or" $echo "*** it was explicitly requested with -no-undefined," $echo "*** libtool will only create a static version of it." if test "$build_old_libs" = no; then oldlibs="$output_objdir/$libname.$libext" build_libtool_libs=module build_old_libs=yes else build_libtool_libs=no fi fi fi fi # Done checking deplibs! deplibs=$newdeplibs fi # move library search paths that coincide with paths to not yet # installed libraries to the beginning of the library search list new_libs= for path in $notinst_path; do case " $new_libs " in *" -L$path/$objdir "*) ;; *) case " $deplibs " in *" -L$path/$objdir "*) new_libs="$new_libs -L$path/$objdir" ;; esac ;; esac done for deplib in $deplibs; do case $deplib in -L*) case " $new_libs " in *" $deplib "*) ;; *) new_libs="$new_libs $deplib" ;; esac ;; *) new_libs="$new_libs $deplib" ;; esac done deplibs="$new_libs" # All the library-specific variables (install_libdir is set above). library_names= old_library= dlname= # Test again, we may have decided not to build it any more if test "$build_libtool_libs" = yes; then if test "$hardcode_into_libs" = yes; then # Hardcode the library paths hardcode_libdirs= dep_rpath= rpath="$finalize_rpath" test "$mode" != relink && rpath="$compile_rpath$rpath" for libdir in $rpath; do if test -n "$hardcode_libdir_flag_spec"; then if test -n "$hardcode_libdir_separator"; then if test -z "$hardcode_libdirs"; then hardcode_libdirs="$libdir" else # Just accumulate the unique libdirs. case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) ;; *) hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" ;; esac fi else eval flag=\"$hardcode_libdir_flag_spec\" dep_rpath="$dep_rpath $flag" fi elif test -n "$runpath_var"; then case "$perm_rpath " in *" $libdir "*) ;; *) perm_rpath="$perm_rpath $libdir" ;; esac fi done # Substitute the hardcoded libdirs into the rpath. if test -n "$hardcode_libdir_separator" && test -n "$hardcode_libdirs"; then libdir="$hardcode_libdirs" if test -n "$hardcode_libdir_flag_spec_ld"; then eval dep_rpath=\"$hardcode_libdir_flag_spec_ld\" else eval dep_rpath=\"$hardcode_libdir_flag_spec\" fi fi if test -n "$runpath_var" && test -n "$perm_rpath"; then # We should set the runpath_var. rpath= for dir in $perm_rpath; do rpath="$rpath$dir:" done eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var" fi test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs" fi shlibpath="$finalize_shlibpath" test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath" if test -n "$shlibpath"; then eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var" fi # Get the real and link names of the library. eval shared_ext=\"$shrext_cmds\" eval library_names=\"$library_names_spec\" set dummy $library_names realname="$2" shift; shift if test -n "$soname_spec"; then eval soname=\"$soname_spec\" else soname="$realname" fi if test -z "$dlname"; then dlname=$soname fi lib="$output_objdir/$realname" linknames= for link do linknames="$linknames $link" done # Use standard objects if they are pic test -z "$pic_flag" && libobjs=`$echo "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP` # Prepare the list of exported symbols if test -z "$export_symbols"; then if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then $show "generating symbol list for \`$libname.la'" export_symbols="$output_objdir/$libname.exp" $run $rm $export_symbols cmds=$export_symbols_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" if len=`expr "X$cmd" : ".*"` && test "$len" -le "$max_cmd_len" || test "$max_cmd_len" -le -1; then $show "$cmd" $run eval "$cmd" || exit $? skipped_export=false else # The command line is too long to execute in one step. $show "using reloadable object file for export list..." skipped_export=: # Break out early, otherwise skipped_export may be # set to false by a later but shorter cmd. break fi done IFS="$save_ifs" if test -n "$export_symbols_regex"; then $show "$EGREP -e \"$export_symbols_regex\" \"$export_symbols\" > \"${export_symbols}T\"" $run eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"' $show "$mv \"${export_symbols}T\" \"$export_symbols\"" $run eval '$mv "${export_symbols}T" "$export_symbols"' fi fi fi if test -n "$export_symbols" && test -n "$include_expsyms"; then $run eval '$echo "X$include_expsyms" | $SP2NL >> "$export_symbols"' fi tmp_deplibs= for test_deplib in $deplibs; do case " $convenience " in *" $test_deplib "*) ;; *) tmp_deplibs="$tmp_deplibs $test_deplib" ;; esac done deplibs="$tmp_deplibs" if test -n "$convenience"; then if test -n "$whole_archive_flag_spec"; then save_libobjs=$libobjs eval libobjs=\"\$libobjs $whole_archive_flag_spec\" else gentop="$output_objdir/${outputname}x" generated="$generated $gentop" func_extract_archives $gentop $convenience libobjs="$libobjs $func_extract_archives_result" fi fi if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then eval flag=\"$thread_safe_flag_spec\" linker_flags="$linker_flags $flag" fi # Make a backup of the uninstalled library when relinking if test "$mode" = relink; then $run eval '(cd $output_objdir && $rm ${realname}U && $mv $realname ${realname}U)' || exit $? fi # Do each of the archive commands. if test "$module" = yes && test -n "$module_cmds" ; then if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then eval test_cmds=\"$module_expsym_cmds\" cmds=$module_expsym_cmds else eval test_cmds=\"$module_cmds\" cmds=$module_cmds fi else if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then eval test_cmds=\"$archive_expsym_cmds\" cmds=$archive_expsym_cmds else eval test_cmds=\"$archive_cmds\" cmds=$archive_cmds fi fi if test "X$skipped_export" != "X:" && len=`expr "X$test_cmds" : ".*" 2>/dev/null` && test "$len" -le "$max_cmd_len" || test "$max_cmd_len" -le -1; then : else # The command line is too long to link in one step, link piecewise. $echo "creating reloadable object files..." # Save the value of $output and $libobjs because we want to # use them later. If we have whole_archive_flag_spec, we # want to use save_libobjs as it was before # whole_archive_flag_spec was expanded, because we can't # assume the linker understands whole_archive_flag_spec. # This may have to be revisited, in case too many # convenience libraries get linked in and end up exceeding # the spec. if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then save_libobjs=$libobjs fi save_output=$output output_la=`$echo "X$output" | $Xsed -e "$basename"` # Clear the reloadable object creation command queue and # initialize k to one. test_cmds= concat_cmds= objlist= delfiles= last_robj= k=1 output=$output_objdir/$output_la-${k}.$objext # Loop over the list of objects to be linked. for obj in $save_libobjs do eval test_cmds=\"$reload_cmds $objlist $last_robj\" if test "X$objlist" = X || { len=`expr "X$test_cmds" : ".*" 2>/dev/null` && test "$len" -le "$max_cmd_len"; }; then objlist="$objlist $obj" else # The command $test_cmds is almost too long, add a # command to the queue. if test "$k" -eq 1 ; then # The first file doesn't have a previous command to add. eval concat_cmds=\"$reload_cmds $objlist $last_robj\" else # All subsequent reloadable object files will link in # the last one created. eval concat_cmds=\"\$concat_cmds~$reload_cmds $objlist $last_robj\" fi last_robj=$output_objdir/$output_la-${k}.$objext k=`expr $k + 1` output=$output_objdir/$output_la-${k}.$objext objlist=$obj len=1 fi done # Handle the remaining objects by creating one last # reloadable object file. All subsequent reloadable object # files will link in the last one created. test -z "$concat_cmds" || concat_cmds=$concat_cmds~ eval concat_cmds=\"\${concat_cmds}$reload_cmds $objlist $last_robj\" if ${skipped_export-false}; then $show "generating symbol list for \`$libname.la'" export_symbols="$output_objdir/$libname.exp" $run $rm $export_symbols libobjs=$output # Append the command to create the export file. eval concat_cmds=\"\$concat_cmds~$export_symbols_cmds\" fi # Set up a command to remove the reloadable object files # after they are used. i=0 while test "$i" -lt "$k" do i=`expr $i + 1` delfiles="$delfiles $output_objdir/$output_la-${i}.$objext" done $echo "creating a temporary reloadable object file: $output" # Loop through the commands generated above and execute them. save_ifs="$IFS"; IFS='~' for cmd in $concat_cmds; do IFS="$save_ifs" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" libobjs=$output # Restore the value of output. output=$save_output if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then eval libobjs=\"\$libobjs $whole_archive_flag_spec\" fi # Expand the library linking commands again to reset the # value of $libobjs for piecewise linking. # Do each of the archive commands. if test "$module" = yes && test -n "$module_cmds" ; then if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then cmds=$module_expsym_cmds else cmds=$module_cmds fi else if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then cmds=$archive_expsym_cmds else cmds=$archive_cmds fi fi # Append the command to remove the reloadable object files # to the just-reset $cmds. eval cmds=\"\$cmds~\$rm $delfiles\" fi save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || { lt_exit=$? # Restore the uninstalled library and exit if test "$mode" = relink; then $run eval '(cd $output_objdir && $rm ${realname}T && $mv ${realname}U $realname)' fi exit $lt_exit } done IFS="$save_ifs" # Restore the uninstalled library and exit if test "$mode" = relink; then $run eval '(cd $output_objdir && $rm ${realname}T && $mv $realname ${realname}T && $mv "$realname"U $realname)' || exit $? if test -n "$convenience"; then if test -z "$whole_archive_flag_spec"; then $show "${rm}r $gentop" $run ${rm}r "$gentop" fi fi exit $EXIT_SUCCESS fi # Create links to the real library. for linkname in $linknames; do if test "$realname" != "$linkname"; then $show "(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)" $run eval '(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)' || exit $? fi done # If -module or -export-dynamic was specified, set the dlname. if test "$module" = yes || test "$export_dynamic" = yes; then # On all known operating systems, these are identical. dlname="$soname" fi fi ;; obj) if test -n "$deplibs"; then $echo "$modename: warning: \`-l' and \`-L' are ignored for objects" 1>&2 fi if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then $echo "$modename: warning: \`-dlopen' is ignored for objects" 1>&2 fi if test -n "$rpath"; then $echo "$modename: warning: \`-rpath' is ignored for objects" 1>&2 fi if test -n "$xrpath"; then $echo "$modename: warning: \`-R' is ignored for objects" 1>&2 fi if test -n "$vinfo"; then $echo "$modename: warning: \`-version-info' is ignored for objects" 1>&2 fi if test -n "$release"; then $echo "$modename: warning: \`-release' is ignored for objects" 1>&2 fi case $output in *.lo) if test -n "$objs$old_deplibs"; then $echo "$modename: cannot build library object \`$output' from non-libtool objects" 1>&2 exit $EXIT_FAILURE fi libobj="$output" obj=`$echo "X$output" | $Xsed -e "$lo2o"` ;; *) libobj= obj="$output" ;; esac # Delete the old objects. $run $rm $obj $libobj # Objects from convenience libraries. This assumes # single-version convenience libraries. Whenever we create # different ones for PIC/non-PIC, this we'll have to duplicate # the extraction. reload_conv_objs= gentop= # reload_cmds runs $LD directly, so let us get rid of # -Wl from whole_archive_flag_spec wl= if test -n "$convenience"; then if test -n "$whole_archive_flag_spec"; then eval reload_conv_objs=\"\$reload_objs $whole_archive_flag_spec\" else gentop="$output_objdir/${obj}x" generated="$generated $gentop" func_extract_archives $gentop $convenience reload_conv_objs="$reload_objs $func_extract_archives_result" fi fi # Create the old-style object. reload_objs="$objs$old_deplibs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test output="$obj" cmds=$reload_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" # Exit if we aren't doing a library object file. if test -z "$libobj"; then if test -n "$gentop"; then $show "${rm}r $gentop" $run ${rm}r $gentop fi exit $EXIT_SUCCESS fi if test "$build_libtool_libs" != yes; then if test -n "$gentop"; then $show "${rm}r $gentop" $run ${rm}r $gentop fi # Create an invalid libtool object if no PIC, so that we don't # accidentally link it into a program. # $show "echo timestamp > $libobj" # $run eval "echo timestamp > $libobj" || exit $? exit $EXIT_SUCCESS fi if test -n "$pic_flag" || test "$pic_mode" != default; then # Only do commands if we really have different PIC objects. reload_objs="$libobjs $reload_conv_objs" output="$libobj" cmds=$reload_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" fi if test -n "$gentop"; then $show "${rm}r $gentop" $run ${rm}r $gentop fi exit $EXIT_SUCCESS ;; prog) case $host in *cygwin*) output=`$echo $output | ${SED} -e 's,.exe$,,;s,$,.exe,'` ;; esac if test -n "$vinfo"; then $echo "$modename: warning: \`-version-info' is ignored for programs" 1>&2 fi if test -n "$release"; then $echo "$modename: warning: \`-release' is ignored for programs" 1>&2 fi if test "$preload" = yes; then if test "$dlopen_support" = unknown && test "$dlopen_self" = unknown && test "$dlopen_self_static" = unknown; then $echo "$modename: warning: \`AC_LIBTOOL_DLOPEN' not used. Assuming no dlopen support." fi fi case $host in *-*-rhapsody* | *-*-darwin1.[012]) # On Rhapsody replace the C library is the System framework compile_deplibs=`$echo "X $compile_deplibs" | $Xsed -e 's/ -lc / -framework System /'` finalize_deplibs=`$echo "X $finalize_deplibs" | $Xsed -e 's/ -lc / -framework System /'` ;; esac case $host in *darwin*) # Don't allow lazy linking, it breaks C++ global constructors if test "$tagname" = CXX ; then compile_command="$compile_command ${wl}-bind_at_load" finalize_command="$finalize_command ${wl}-bind_at_load" fi ;; esac # move library search paths that coincide with paths to not yet # installed libraries to the beginning of the library search list new_libs= for path in $notinst_path; do case " $new_libs " in *" -L$path/$objdir "*) ;; *) case " $compile_deplibs " in *" -L$path/$objdir "*) new_libs="$new_libs -L$path/$objdir" ;; esac ;; esac done for deplib in $compile_deplibs; do case $deplib in -L*) case " $new_libs " in *" $deplib "*) ;; *) new_libs="$new_libs $deplib" ;; esac ;; *) new_libs="$new_libs $deplib" ;; esac done compile_deplibs="$new_libs" compile_command="$compile_command $compile_deplibs" finalize_command="$finalize_command $finalize_deplibs" if test -n "$rpath$xrpath"; then # If the user specified any rpath flags, then add them. for libdir in $rpath $xrpath; do # This is the magic to use -rpath. case "$finalize_rpath " in *" $libdir "*) ;; *) finalize_rpath="$finalize_rpath $libdir" ;; esac done fi # Now hardcode the library paths rpath= hardcode_libdirs= for libdir in $compile_rpath $finalize_rpath; do if test -n "$hardcode_libdir_flag_spec"; then if test -n "$hardcode_libdir_separator"; then if test -z "$hardcode_libdirs"; then hardcode_libdirs="$libdir" else # Just accumulate the unique libdirs. case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) ;; *) hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" ;; esac fi else eval flag=\"$hardcode_libdir_flag_spec\" rpath="$rpath $flag" fi elif test -n "$runpath_var"; then case "$perm_rpath " in *" $libdir "*) ;; *) perm_rpath="$perm_rpath $libdir" ;; esac fi case $host in *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*) testbindir=`$echo "X$libdir" | $Xsed -e 's*/lib$*/bin*'` case :$dllsearchpath: in *":$libdir:"*) ;; *) dllsearchpath="$dllsearchpath:$libdir";; esac case :$dllsearchpath: in *":$testbindir:"*) ;; *) dllsearchpath="$dllsearchpath:$testbindir";; esac ;; esac done # Substitute the hardcoded libdirs into the rpath. if test -n "$hardcode_libdir_separator" && test -n "$hardcode_libdirs"; then libdir="$hardcode_libdirs" eval rpath=\" $hardcode_libdir_flag_spec\" fi compile_rpath="$rpath" rpath= hardcode_libdirs= for libdir in $finalize_rpath; do if test -n "$hardcode_libdir_flag_spec"; then if test -n "$hardcode_libdir_separator"; then if test -z "$hardcode_libdirs"; then hardcode_libdirs="$libdir" else # Just accumulate the unique libdirs. case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) ;; *) hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" ;; esac fi else eval flag=\"$hardcode_libdir_flag_spec\" rpath="$rpath $flag" fi elif test -n "$runpath_var"; then case "$finalize_perm_rpath " in *" $libdir "*) ;; *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;; esac fi done # Substitute the hardcoded libdirs into the rpath. if test -n "$hardcode_libdir_separator" && test -n "$hardcode_libdirs"; then libdir="$hardcode_libdirs" eval rpath=\" $hardcode_libdir_flag_spec\" fi finalize_rpath="$rpath" if test -n "$libobjs" && test "$build_old_libs" = yes; then # Transform all the library objects into standard objects. compile_command=`$echo "X$compile_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP` finalize_command=`$echo "X$finalize_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP` fi dlsyms= if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then if test -n "$NM" && test -n "$global_symbol_pipe"; then dlsyms="${outputname}S.c" else $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2 fi fi if test -n "$dlsyms"; then case $dlsyms in "") ;; *.c) # Discover the nlist of each of the dlfiles. nlist="$output_objdir/${outputname}.nm" $show "$rm $nlist ${nlist}S ${nlist}T" $run $rm "$nlist" "${nlist}S" "${nlist}T" # Parse the name list into a source file. $show "creating $output_objdir/$dlsyms" test -z "$run" && $echo > "$output_objdir/$dlsyms" "\ /* $dlsyms - symbol resolution table for \`$outputname' dlsym emulation. */ /* Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP */ #ifdef __cplusplus extern \"C\" { #endif /* Prevent the only kind of declaration conflicts we can make. */ #define lt_preloaded_symbols some_other_symbol /* External symbol declarations for the compiler. */\ " if test "$dlself" = yes; then $show "generating symbol list for \`$output'" test -z "$run" && $echo ': @PROGRAM@ ' > "$nlist" # Add our own program objects to the symbol list. progfiles=`$echo "X$objs$old_deplibs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP` for arg in $progfiles; do $show "extracting global C symbols from \`$arg'" $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'" done if test -n "$exclude_expsyms"; then $run eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T' $run eval '$mv "$nlist"T "$nlist"' fi if test -n "$export_symbols_regex"; then $run eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T' $run eval '$mv "$nlist"T "$nlist"' fi # Prepare the list of exported symbols if test -z "$export_symbols"; then export_symbols="$output_objdir/$outputname.exp" $run $rm $export_symbols $run eval "${SED} -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"' case $host in *cygwin* | *mingw* ) $run eval "echo EXPORTS "'> "$output_objdir/$outputname.def"' $run eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"' ;; esac else $run eval "${SED} -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"' $run eval 'grep -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T' $run eval 'mv "$nlist"T "$nlist"' case $host in *cygwin* | *mingw* ) $run eval "echo EXPORTS "'> "$output_objdir/$outputname.def"' $run eval 'cat "$nlist" >> "$output_objdir/$outputname.def"' ;; esac fi fi for arg in $dlprefiles; do $show "extracting global C symbols from \`$arg'" name=`$echo "$arg" | ${SED} -e 's%^.*/%%'` $run eval '$echo ": $name " >> "$nlist"' $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'" done if test -z "$run"; then # Make sure we have at least an empty file. test -f "$nlist" || : > "$nlist" if test -n "$exclude_expsyms"; then $EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T $mv "$nlist"T "$nlist" fi # Try sorting and uniquifying the output. if grep -v "^: " < "$nlist" | if sort -k 3 /dev/null 2>&1; then sort -k 3 else sort +2 fi | uniq > "$nlist"S; then : else grep -v "^: " < "$nlist" > "$nlist"S fi if test -f "$nlist"S; then eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$dlsyms"' else $echo '/* NONE */' >> "$output_objdir/$dlsyms" fi $echo >> "$output_objdir/$dlsyms" "\ #undef lt_preloaded_symbols #if defined (__STDC__) && __STDC__ # define lt_ptr void * #else # define lt_ptr char * # define const #endif /* The mapping between symbol names and symbols. */ " case $host in *cygwin* | *mingw* ) $echo >> "$output_objdir/$dlsyms" "\ /* DATA imports from DLLs on WIN32 can't be const, because runtime relocations are performed -- see ld's documentation on pseudo-relocs */ struct { " ;; * ) $echo >> "$output_objdir/$dlsyms" "\ const struct { " ;; esac $echo >> "$output_objdir/$dlsyms" "\ const char *name; lt_ptr address; } lt_preloaded_symbols[] = {\ " eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$dlsyms" $echo >> "$output_objdir/$dlsyms" "\ {0, (lt_ptr) 0} }; /* This works around a problem in FreeBSD linker */ #ifdef FREEBSD_WORKAROUND static const void *lt_preloaded_setup() { return lt_preloaded_symbols; } #endif #ifdef __cplusplus } #endif\ " fi pic_flag_for_symtable= case $host in # compiling the symbol table file with pic_flag works around # a FreeBSD bug that causes programs to crash when -lm is # linked before any other PIC object. But we must not use # pic_flag when linking with -static. The problem exists in # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1. *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*) case "$compile_command " in *" -static "*) ;; *) pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND";; esac;; *-*-hpux*) case "$compile_command " in *" -static "*) ;; *) pic_flag_for_symtable=" $pic_flag";; esac esac # Now compile the dynamic symbol file. $show "(cd $output_objdir && $LTCC $LTCFLAGS -c$no_builtin_flag$pic_flag_for_symtable \"$dlsyms\")" $run eval '(cd $output_objdir && $LTCC $LTCFLAGS -c$no_builtin_flag$pic_flag_for_symtable "$dlsyms")' || exit $? # Clean up the generated files. $show "$rm $output_objdir/$dlsyms $nlist ${nlist}S ${nlist}T" $run $rm "$output_objdir/$dlsyms" "$nlist" "${nlist}S" "${nlist}T" # Transform the symbol file into the correct name. case $host in *cygwin* | *mingw* ) if test -f "$output_objdir/${outputname}.def" ; then compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}.def $output_objdir/${outputname}S.${objext}%"` finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}.def $output_objdir/${outputname}S.${objext}%"` else compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` fi ;; * ) compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"` ;; esac ;; *) $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2 exit $EXIT_FAILURE ;; esac else # We keep going just in case the user didn't refer to # lt_preloaded_symbols. The linker will fail if global_symbol_pipe # really was required. # Nullify the symbol file. compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"` finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"` fi if test "$need_relink" = no || test "$build_libtool_libs" != yes; then # Replace the output file specification. compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` link_command="$compile_command$compile_rpath" # We have no uninstalled library dependencies, so finalize right now. $show "$link_command" $run eval "$link_command" exit_status=$? # Delete the generated files. if test -n "$dlsyms"; then $show "$rm $output_objdir/${outputname}S.${objext}" $run $rm "$output_objdir/${outputname}S.${objext}" fi exit $exit_status fi if test -n "$shlibpath_var"; then # We should set the shlibpath_var rpath= for dir in $temp_rpath; do case $dir in [\\/]* | [A-Za-z]:[\\/]*) # Absolute path. rpath="$rpath$dir:" ;; *) # Relative path: add a thisdir entry. rpath="$rpath\$thisdir/$dir:" ;; esac done temp_rpath="$rpath" fi if test -n "$compile_shlibpath$finalize_shlibpath"; then compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command" fi if test -n "$finalize_shlibpath"; then finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command" fi compile_var= finalize_var= if test -n "$runpath_var"; then if test -n "$perm_rpath"; then # We should set the runpath_var. rpath= for dir in $perm_rpath; do rpath="$rpath$dir:" done compile_var="$runpath_var=\"$rpath\$$runpath_var\" " fi if test -n "$finalize_perm_rpath"; then # We should set the runpath_var. rpath= for dir in $finalize_perm_rpath; do rpath="$rpath$dir:" done finalize_var="$runpath_var=\"$rpath\$$runpath_var\" " fi fi if test "$no_install" = yes; then # We don't need to create a wrapper script. link_command="$compile_var$compile_command$compile_rpath" # Replace the output file specification. link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` # Delete the old output file. $run $rm $output # Link the executable and exit $show "$link_command" $run eval "$link_command" || exit $? exit $EXIT_SUCCESS fi if test "$hardcode_action" = relink; then # Fast installation is not supported link_command="$compile_var$compile_command$compile_rpath" relink_command="$finalize_var$finalize_command$finalize_rpath" $echo "$modename: warning: this platform does not like uninstalled shared libraries" 1>&2 $echo "$modename: \`$output' will be relinked during installation" 1>&2 else if test "$fast_install" != no; then link_command="$finalize_var$compile_command$finalize_rpath" if test "$fast_install" = yes; then relink_command=`$echo "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'` else # fast_install is set to needless relink_command= fi else link_command="$compile_var$compile_command$compile_rpath" relink_command="$finalize_var$finalize_command$finalize_rpath" fi fi # Replace the output file specification. link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'` # Delete the old output files. $run $rm $output $output_objdir/$outputname $output_objdir/lt-$outputname $show "$link_command" $run eval "$link_command" || exit $? # Now create the wrapper script. $show "creating $output" # Quote the relink command for shipping. if test -n "$relink_command"; then # Preserve any variables that may affect compiler behavior for var in $variables_saved_for_relink; do if eval test -z \"\${$var+set}\"; then relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command" elif eval var_value=\$$var; test -z "$var_value"; then relink_command="$var=; export $var; $relink_command" else var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"` relink_command="$var=\"$var_value\"; export $var; $relink_command" fi done relink_command="(cd `pwd`; $relink_command)" relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"` fi # Quote $echo for shipping. if test "X$echo" = "X$SHELL $progpath --fallback-echo"; then case $progpath in [\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $progpath --fallback-echo";; *) qecho="$SHELL `pwd`/$progpath --fallback-echo";; esac qecho=`$echo "X$qecho" | $Xsed -e "$sed_quote_subst"` else qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"` fi # Only actually do things if our run command is non-null. if test -z "$run"; then # win32 will think the script is a binary if it has # a .exe suffix, so we strip it off here. case $output in *.exe) output=`$echo $output|${SED} 's,.exe$,,'` ;; esac # test for cygwin because mv fails w/o .exe extensions case $host in *cygwin*) exeext=.exe outputname=`$echo $outputname|${SED} 's,.exe$,,'` ;; *) exeext= ;; esac case $host in *cygwin* | *mingw* ) output_name=`basename $output` output_path=`dirname $output` cwrappersource="$output_path/$objdir/lt-$output_name.c" cwrapper="$output_path/$output_name.exe" $rm $cwrappersource $cwrapper trap "$rm $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15 cat > $cwrappersource <> $cwrappersource<<"EOF" #include #include #include #include #include #include #include #include #include #if defined(PATH_MAX) # define LT_PATHMAX PATH_MAX #elif defined(MAXPATHLEN) # define LT_PATHMAX MAXPATHLEN #else # define LT_PATHMAX 1024 #endif #ifndef DIR_SEPARATOR # define DIR_SEPARATOR '/' # define PATH_SEPARATOR ':' #endif #if defined (_WIN32) || defined (__MSDOS__) || defined (__DJGPP__) || \ defined (__OS2__) # define HAVE_DOS_BASED_FILE_SYSTEM # ifndef DIR_SEPARATOR_2 # define DIR_SEPARATOR_2 '\\' # endif # ifndef PATH_SEPARATOR_2 # define PATH_SEPARATOR_2 ';' # endif #endif #ifndef DIR_SEPARATOR_2 # define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR) #else /* DIR_SEPARATOR_2 */ # define IS_DIR_SEPARATOR(ch) \ (((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2)) #endif /* DIR_SEPARATOR_2 */ #ifndef PATH_SEPARATOR_2 # define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR) #else /* PATH_SEPARATOR_2 */ # define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2) #endif /* PATH_SEPARATOR_2 */ #define XMALLOC(type, num) ((type *) xmalloc ((num) * sizeof(type))) #define XFREE(stale) do { \ if (stale) { free ((void *) stale); stale = 0; } \ } while (0) /* -DDEBUG is fairly common in CFLAGS. */ #undef DEBUG #if defined DEBUGWRAPPER # define DEBUG(format, ...) fprintf(stderr, format, __VA_ARGS__) #else # define DEBUG(format, ...) #endif const char *program_name = NULL; void * xmalloc (size_t num); char * xstrdup (const char *string); const char * base_name (const char *name); char * find_executable(const char *wrapper); int check_executable(const char *path); char * strendzap(char *str, const char *pat); void lt_fatal (const char *message, ...); int main (int argc, char *argv[]) { char **newargz; int i; program_name = (char *) xstrdup (base_name (argv[0])); DEBUG("(main) argv[0] : %s\n",argv[0]); DEBUG("(main) program_name : %s\n",program_name); newargz = XMALLOC(char *, argc+2); EOF cat >> $cwrappersource <> $cwrappersource <<"EOF" newargz[1] = find_executable(argv[0]); if (newargz[1] == NULL) lt_fatal("Couldn't find %s", argv[0]); DEBUG("(main) found exe at : %s\n",newargz[1]); /* we know the script has the same name, without the .exe */ /* so make sure newargz[1] doesn't end in .exe */ strendzap(newargz[1],".exe"); for (i = 1; i < argc; i++) newargz[i+1] = xstrdup(argv[i]); newargz[argc+1] = NULL; for (i=0; i> $cwrappersource <> $cwrappersource <> $cwrappersource <<"EOF" return 127; } void * xmalloc (size_t num) { void * p = (void *) malloc (num); if (!p) lt_fatal ("Memory exhausted"); return p; } char * xstrdup (const char *string) { return string ? strcpy ((char *) xmalloc (strlen (string) + 1), string) : NULL ; } const char * base_name (const char *name) { const char *base; #if defined (HAVE_DOS_BASED_FILE_SYSTEM) /* Skip over the disk name in MSDOS pathnames. */ if (isalpha ((unsigned char)name[0]) && name[1] == ':') name += 2; #endif for (base = name; *name; name++) if (IS_DIR_SEPARATOR (*name)) base = name + 1; return base; } int check_executable(const char * path) { struct stat st; DEBUG("(check_executable) : %s\n", path ? (*path ? path : "EMPTY!") : "NULL!"); if ((!path) || (!*path)) return 0; if ((stat (path, &st) >= 0) && ( /* MinGW & native WIN32 do not support S_IXOTH or S_IXGRP */ #if defined (S_IXOTH) ((st.st_mode & S_IXOTH) == S_IXOTH) || #endif #if defined (S_IXGRP) ((st.st_mode & S_IXGRP) == S_IXGRP) || #endif ((st.st_mode & S_IXUSR) == S_IXUSR)) ) return 1; else return 0; } /* Searches for the full path of the wrapper. Returns newly allocated full path name if found, NULL otherwise */ char * find_executable (const char* wrapper) { int has_slash = 0; const char* p; const char* p_next; /* static buffer for getcwd */ char tmp[LT_PATHMAX + 1]; int tmp_len; char* concat_name; DEBUG("(find_executable) : %s\n", wrapper ? (*wrapper ? wrapper : "EMPTY!") : "NULL!"); if ((wrapper == NULL) || (*wrapper == '\0')) return NULL; /* Absolute path? */ #if defined (HAVE_DOS_BASED_FILE_SYSTEM) if (isalpha ((unsigned char)wrapper[0]) && wrapper[1] == ':') { concat_name = xstrdup (wrapper); if (check_executable(concat_name)) return concat_name; XFREE(concat_name); } else { #endif if (IS_DIR_SEPARATOR (wrapper[0])) { concat_name = xstrdup (wrapper); if (check_executable(concat_name)) return concat_name; XFREE(concat_name); } #if defined (HAVE_DOS_BASED_FILE_SYSTEM) } #endif for (p = wrapper; *p; p++) if (*p == '/') { has_slash = 1; break; } if (!has_slash) { /* no slashes; search PATH */ const char* path = getenv ("PATH"); if (path != NULL) { for (p = path; *p; p = p_next) { const char* q; size_t p_len; for (q = p; *q; q++) if (IS_PATH_SEPARATOR(*q)) break; p_len = q - p; p_next = (*q == '\0' ? q : q + 1); if (p_len == 0) { /* empty path: current directory */ if (getcwd (tmp, LT_PATHMAX) == NULL) lt_fatal ("getcwd failed"); tmp_len = strlen(tmp); concat_name = XMALLOC(char, tmp_len + 1 + strlen(wrapper) + 1); memcpy (concat_name, tmp, tmp_len); concat_name[tmp_len] = '/'; strcpy (concat_name + tmp_len + 1, wrapper); } else { concat_name = XMALLOC(char, p_len + 1 + strlen(wrapper) + 1); memcpy (concat_name, p, p_len); concat_name[p_len] = '/'; strcpy (concat_name + p_len + 1, wrapper); } if (check_executable(concat_name)) return concat_name; XFREE(concat_name); } } /* not found in PATH; assume curdir */ } /* Relative path | not found in path: prepend cwd */ if (getcwd (tmp, LT_PATHMAX) == NULL) lt_fatal ("getcwd failed"); tmp_len = strlen(tmp); concat_name = XMALLOC(char, tmp_len + 1 + strlen(wrapper) + 1); memcpy (concat_name, tmp, tmp_len); concat_name[tmp_len] = '/'; strcpy (concat_name + tmp_len + 1, wrapper); if (check_executable(concat_name)) return concat_name; XFREE(concat_name); return NULL; } char * strendzap(char *str, const char *pat) { size_t len, patlen; assert(str != NULL); assert(pat != NULL); len = strlen(str); patlen = strlen(pat); if (patlen <= len) { str += len - patlen; if (strcmp(str, pat) == 0) *str = '\0'; } return str; } static void lt_error_core (int exit_status, const char * mode, const char * message, va_list ap) { fprintf (stderr, "%s: %s: ", program_name, mode); vfprintf (stderr, message, ap); fprintf (stderr, ".\n"); if (exit_status >= 0) exit (exit_status); } void lt_fatal (const char *message, ...) { va_list ap; va_start (ap, message); lt_error_core (EXIT_FAILURE, "FATAL", message, ap); va_end (ap); } EOF # we should really use a build-platform specific compiler # here, but OTOH, the wrappers (shell script and this C one) # are only useful if you want to execute the "real" binary. # Since the "real" binary is built for $host, then this # wrapper might as well be built for $host, too. $run $LTCC $LTCFLAGS -s -o $cwrapper $cwrappersource ;; esac $rm $output trap "$rm $output; exit $EXIT_FAILURE" 1 2 15 $echo > $output "\ #! $SHELL # $output - temporary wrapper script for $objdir/$outputname # Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP # # The $output program cannot be directly executed until all the libtool # libraries that it depends on are installed. # # This wrapper script should never be moved out of the build directory. # If it is, it will not operate correctly. # Sed substitution that helps us do robust quoting. It backslashifies # metacharacters that are still active within double-quoted strings. Xsed='${SED} -e 1s/^X//' sed_quote_subst='$sed_quote_subst' # The HP-UX ksh and POSIX shell print the target directory to stdout # if CDPATH is set. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH relink_command=\"$relink_command\" # This environment variable determines our operation mode. if test \"\$libtool_install_magic\" = \"$magic\"; then # install mode needs the following variable: notinst_deplibs='$notinst_deplibs' else # When we are sourced in execute mode, \$file and \$echo are already set. if test \"\$libtool_execute_magic\" != \"$magic\"; then echo=\"$qecho\" file=\"\$0\" # Make sure echo works. if test \"X\$1\" = X--no-reexec; then # Discard the --no-reexec flag, and continue. shift elif test \"X\`(\$echo '\t') 2>/dev/null\`\" = 'X\t'; then # Yippee, \$echo works! : else # Restart under the correct shell, and then maybe \$echo will work. exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"} fi fi\ " $echo >> $output "\ # Find the directory that this script lives in. thisdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\` test \"x\$thisdir\" = \"x\$file\" && thisdir=. # Follow symbolic links until we get to the real thisdir. file=\`ls -ld \"\$file\" | ${SED} -n 's/.*-> //p'\` while test -n \"\$file\"; do destdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\` # If there was a directory component, then change thisdir. if test \"x\$destdir\" != \"x\$file\"; then case \"\$destdir\" in [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;; *) thisdir=\"\$thisdir/\$destdir\" ;; esac fi file=\`\$echo \"X\$file\" | \$Xsed -e 's%^.*/%%'\` file=\`ls -ld \"\$thisdir/\$file\" | ${SED} -n 's/.*-> //p'\` done # Try to get the absolute directory name. absdir=\`cd \"\$thisdir\" && pwd\` test -n \"\$absdir\" && thisdir=\"\$absdir\" " if test "$fast_install" = yes; then $echo >> $output "\ program=lt-'$outputname'$exeext progdir=\"\$thisdir/$objdir\" if test ! -f \"\$progdir/\$program\" || \\ { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | ${SED} 1q\`; \\ test \"X\$file\" != \"X\$progdir/\$program\"; }; then file=\"\$\$-\$program\" if test ! -d \"\$progdir\"; then $mkdir \"\$progdir\" else $rm \"\$progdir/\$file\" fi" $echo >> $output "\ # relink executable if necessary if test -n \"\$relink_command\"; then if relink_command_output=\`eval \$relink_command 2>&1\`; then : else $echo \"\$relink_command_output\" >&2 $rm \"\$progdir/\$file\" exit $EXIT_FAILURE fi fi $mv \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null || { $rm \"\$progdir/\$program\"; $mv \"\$progdir/\$file\" \"\$progdir/\$program\"; } $rm \"\$progdir/\$file\" fi" else $echo >> $output "\ program='$outputname' progdir=\"\$thisdir/$objdir\" " fi $echo >> $output "\ if test -f \"\$progdir/\$program\"; then" # Export our shlibpath_var if we have one. if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then $echo >> $output "\ # Add our own library path to $shlibpath_var $shlibpath_var=\"$temp_rpath\$$shlibpath_var\" # Some systems cannot cope with colon-terminated $shlibpath_var # The second colon is a workaround for a bug in BeOS R4 sed $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\` export $shlibpath_var " fi # fixup the dll searchpath if we need to. if test -n "$dllsearchpath"; then $echo >> $output "\ # Add the dll search path components to the executable PATH PATH=$dllsearchpath:\$PATH " fi $echo >> $output "\ if test \"\$libtool_execute_magic\" != \"$magic\"; then # Run the actual program with our arguments. " case $host in # Backslashes separate directories on plain windows *-*-mingw | *-*-os2*) $echo >> $output "\ exec \"\$progdir\\\\\$program\" \${1+\"\$@\"} " ;; *) $echo >> $output "\ exec \"\$progdir/\$program\" \${1+\"\$@\"} " ;; esac $echo >> $output "\ \$echo \"\$0: cannot exec \$program \${1+\"\$@\"}\" exit $EXIT_FAILURE fi else # The program doesn't exist. \$echo \"\$0: error: \\\`\$progdir/\$program' does not exist\" 1>&2 \$echo \"This script is just a wrapper for \$program.\" 1>&2 $echo \"See the $PACKAGE documentation for more information.\" 1>&2 exit $EXIT_FAILURE fi fi\ " chmod +x $output fi exit $EXIT_SUCCESS ;; esac # See if we need to build an old-fashioned archive. for oldlib in $oldlibs; do if test "$build_libtool_libs" = convenience; then oldobjs="$libobjs_save" addlibs="$convenience" build_libtool_libs=no else if test "$build_libtool_libs" = module; then oldobjs="$libobjs_save" build_libtool_libs=no else oldobjs="$old_deplibs $non_pic_objects" fi addlibs="$old_convenience" fi if test -n "$addlibs"; then gentop="$output_objdir/${outputname}x" generated="$generated $gentop" func_extract_archives $gentop $addlibs oldobjs="$oldobjs $func_extract_archives_result" fi # Do each command in the archive commands. if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then cmds=$old_archive_from_new_cmds else # POSIX demands no paths to be encoded in archives. We have # to avoid creating archives with duplicate basenames if we # might have to extract them afterwards, e.g., when creating a # static archive out of a convenience library, or when linking # the entirety of a libtool archive into another (currently # not supported by libtool). if (for obj in $oldobjs do $echo "X$obj" | $Xsed -e 's%^.*/%%' done | sort | sort -uc >/dev/null 2>&1); then : else $echo "copying selected object files to avoid basename conflicts..." if test -z "$gentop"; then gentop="$output_objdir/${outputname}x" generated="$generated $gentop" $show "${rm}r $gentop" $run ${rm}r "$gentop" $show "$mkdir $gentop" $run $mkdir "$gentop" exit_status=$? if test "$exit_status" -ne 0 && test ! -d "$gentop"; then exit $exit_status fi fi save_oldobjs=$oldobjs oldobjs= counter=1 for obj in $save_oldobjs do objbase=`$echo "X$obj" | $Xsed -e 's%^.*/%%'` case " $oldobjs " in " ") oldobjs=$obj ;; *[\ /]"$objbase "*) while :; do # Make sure we don't pick an alternate name that also # overlaps. newobj=lt$counter-$objbase counter=`expr $counter + 1` case " $oldobjs " in *[\ /]"$newobj "*) ;; *) if test ! -f "$gentop/$newobj"; then break; fi ;; esac done $show "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj" $run ln "$obj" "$gentop/$newobj" || $run cp "$obj" "$gentop/$newobj" oldobjs="$oldobjs $gentop/$newobj" ;; *) oldobjs="$oldobjs $obj" ;; esac done fi eval cmds=\"$old_archive_cmds\" if len=`expr "X$cmds" : ".*"` && test "$len" -le "$max_cmd_len" || test "$max_cmd_len" -le -1; then cmds=$old_archive_cmds else # the command line is too long to link in one step, link in parts $echo "using piecewise archive linking..." save_RANLIB=$RANLIB RANLIB=: objlist= concat_cmds= save_oldobjs=$oldobjs # Is there a better way of finding the last object in the list? for obj in $save_oldobjs do last_oldobj=$obj done for obj in $save_oldobjs do oldobjs="$objlist $obj" objlist="$objlist $obj" eval test_cmds=\"$old_archive_cmds\" if len=`expr "X$test_cmds" : ".*" 2>/dev/null` && test "$len" -le "$max_cmd_len"; then : else # the above command should be used before it gets too long oldobjs=$objlist if test "$obj" = "$last_oldobj" ; then RANLIB=$save_RANLIB fi test -z "$concat_cmds" || concat_cmds=$concat_cmds~ eval concat_cmds=\"\${concat_cmds}$old_archive_cmds\" objlist= fi done RANLIB=$save_RANLIB oldobjs=$objlist if test "X$oldobjs" = "X" ; then eval cmds=\"\$concat_cmds\" else eval cmds=\"\$concat_cmds~\$old_archive_cmds\" fi fi fi save_ifs="$IFS"; IFS='~' for cmd in $cmds; do eval cmd=\"$cmd\" IFS="$save_ifs" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" done if test -n "$generated"; then $show "${rm}r$generated" $run ${rm}r$generated fi # Now create the libtool archive. case $output in *.la) old_library= test "$build_old_libs" = yes && old_library="$libname.$libext" $show "creating $output" # Preserve any variables that may affect compiler behavior for var in $variables_saved_for_relink; do if eval test -z \"\${$var+set}\"; then relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command" elif eval var_value=\$$var; test -z "$var_value"; then relink_command="$var=; export $var; $relink_command" else var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"` relink_command="$var=\"$var_value\"; export $var; $relink_command" fi done # Quote the link command for shipping. relink_command="(cd `pwd`; $SHELL $progpath $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)" relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"` if test "$hardcode_automatic" = yes ; then relink_command= fi # Only create the output if not a dry run. if test -z "$run"; then for installed in no yes; do if test "$installed" = yes; then if test -z "$install_libdir"; then break fi output="$output_objdir/$outputname"i # Replace all uninstalled libtool libraries with the installed ones newdependency_libs= for deplib in $dependency_libs; do case $deplib in *.la) name=`$echo "X$deplib" | $Xsed -e 's%^.*/%%'` eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib` if test -z "$libdir"; then $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2 exit $EXIT_FAILURE fi newdependency_libs="$newdependency_libs $libdir/$name" ;; *) newdependency_libs="$newdependency_libs $deplib" ;; esac done dependency_libs="$newdependency_libs" newdlfiles= for lib in $dlfiles; do name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib` if test -z "$libdir"; then $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 exit $EXIT_FAILURE fi newdlfiles="$newdlfiles $libdir/$name" done dlfiles="$newdlfiles" newdlprefiles= for lib in $dlprefiles; do name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'` eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib` if test -z "$libdir"; then $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 exit $EXIT_FAILURE fi newdlprefiles="$newdlprefiles $libdir/$name" done dlprefiles="$newdlprefiles" else newdlfiles= for lib in $dlfiles; do case $lib in [\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;; *) abs=`pwd`"/$lib" ;; esac newdlfiles="$newdlfiles $abs" done dlfiles="$newdlfiles" newdlprefiles= for lib in $dlprefiles; do case $lib in [\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;; *) abs=`pwd`"/$lib" ;; esac newdlprefiles="$newdlprefiles $abs" done dlprefiles="$newdlprefiles" fi $rm $output # place dlname in correct position for cygwin tdlname=$dlname case $host,$output,$installed,$module,$dlname in *cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll) tdlname=../bin/$dlname ;; esac $echo > $output "\ # $outputname - a libtool library file # Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP # # Please DO NOT delete this file! # It is necessary for linking the library. # The name that we can dlopen(3). dlname='$tdlname' # Names of this library. library_names='$library_names' # The name of the static archive. old_library='$old_library' # Libraries that this one depends upon. dependency_libs='$dependency_libs' # Version information for $libname. current=$current age=$age revision=$revision # Is this an already installed library? installed=$installed # Should we warn about portability when linking against -modules? shouldnotlink=$module # Files to dlopen/dlpreopen dlopen='$dlfiles' dlpreopen='$dlprefiles' # Directory that this library needs to be installed in: libdir='$install_libdir'" if test "$installed" = no && test "$need_relink" = yes; then $echo >> $output "\ relink_command=\"$relink_command\"" fi done fi # Do a symbolic link so that the libtool archive can be found in # LD_LIBRARY_PATH before the program is installed. $show "(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)" $run eval '(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)' || exit $? ;; esac exit $EXIT_SUCCESS ;; # libtool install mode install) modename="$modename: install" # There may be an optional sh(1) argument at the beginning of # install_prog (especially on Windows NT). if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh || # Allow the use of GNU shtool's install command. $echo "X$nonopt" | grep shtool > /dev/null; then # Aesthetically quote it. arg=`$echo "X$nonopt" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac install_prog="$arg " arg="$1" shift else install_prog= arg=$nonopt fi # The real first argument should be the name of the installation program. # Aesthetically quote it. arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac install_prog="$install_prog$arg" # We need to accept at least all the BSD install flags. dest= files= opts= prev= install_type= isdir=no stripme= for arg do if test -n "$dest"; then files="$files $dest" dest=$arg continue fi case $arg in -d) isdir=yes ;; -f) case " $install_prog " in *[\\\ /]cp\ *) ;; *) prev=$arg ;; esac ;; -g | -m | -o) prev=$arg ;; -s) stripme=" -s" continue ;; -*) ;; *) # If the previous option needed an argument, then skip it. if test -n "$prev"; then prev= else dest=$arg continue fi ;; esac # Aesthetically quote the argument. arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` case $arg in *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") arg="\"$arg\"" ;; esac install_prog="$install_prog $arg" done if test -z "$install_prog"; then $echo "$modename: you must specify an install program" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi if test -n "$prev"; then $echo "$modename: the \`$prev' option requires an argument" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi if test -z "$files"; then if test -z "$dest"; then $echo "$modename: no file or destination specified" 1>&2 else $echo "$modename: you must specify a destination" 1>&2 fi $echo "$help" 1>&2 exit $EXIT_FAILURE fi # Strip any trailing slash from the destination. dest=`$echo "X$dest" | $Xsed -e 's%/$%%'` # Check to see that the destination is a directory. test -d "$dest" && isdir=yes if test "$isdir" = yes; then destdir="$dest" destname= else destdir=`$echo "X$dest" | $Xsed -e 's%/[^/]*$%%'` test "X$destdir" = "X$dest" && destdir=. destname=`$echo "X$dest" | $Xsed -e 's%^.*/%%'` # Not a directory, so check to see that there is only one file specified. set dummy $files if test "$#" -gt 2; then $echo "$modename: \`$dest' is not a directory" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi fi case $destdir in [\\/]* | [A-Za-z]:[\\/]*) ;; *) for file in $files; do case $file in *.lo) ;; *) $echo "$modename: \`$destdir' must be an absolute directory name" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE ;; esac done ;; esac # This variable tells wrapper scripts just to set variables rather # than running their programs. libtool_install_magic="$magic" staticlibs= future_libdirs= current_libdirs= for file in $files; do # Do each installation. case $file in *.$libext) # Do the static libraries later. staticlibs="$staticlibs $file" ;; *.la) # Check to see that this really is a libtool archive. if (${SED} -e '2q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : else $echo "$modename: \`$file' is not a valid libtool archive" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi library_names= old_library= relink_command= # If there is no directory component, then add one. case $file in */* | *\\*) . $file ;; *) . ./$file ;; esac # Add the libdir to current_libdirs if it is the destination. if test "X$destdir" = "X$libdir"; then case "$current_libdirs " in *" $libdir "*) ;; *) current_libdirs="$current_libdirs $libdir" ;; esac else # Note the libdir as a future libdir. case "$future_libdirs " in *" $libdir "*) ;; *) future_libdirs="$future_libdirs $libdir" ;; esac fi dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`/ test "X$dir" = "X$file/" && dir= dir="$dir$objdir" if test -n "$relink_command"; then # Determine the prefix the user has applied to our future dir. inst_prefix_dir=`$echo "$destdir" | $SED "s%$libdir\$%%"` # Don't allow the user to place us outside of our expected # location b/c this prevents finding dependent libraries that # are installed to the same prefix. # At present, this check doesn't affect windows .dll's that # are installed into $libdir/../bin (currently, that works fine) # but it's something to keep an eye on. if test "$inst_prefix_dir" = "$destdir"; then $echo "$modename: error: cannot install \`$file' to a directory not ending in $libdir" 1>&2 exit $EXIT_FAILURE fi if test -n "$inst_prefix_dir"; then # Stick the inst_prefix_dir data into the link command. relink_command=`$echo "$relink_command" | $SED "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"` else relink_command=`$echo "$relink_command" | $SED "s%@inst_prefix_dir@%%"` fi $echo "$modename: warning: relinking \`$file'" 1>&2 $show "$relink_command" if $run eval "$relink_command"; then : else $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2 exit $EXIT_FAILURE fi fi # See the names of the shared library. set dummy $library_names if test -n "$2"; then realname="$2" shift shift srcname="$realname" test -n "$relink_command" && srcname="$realname"T # Install the shared library and build the symlinks. $show "$install_prog $dir/$srcname $destdir/$realname" $run eval "$install_prog $dir/$srcname $destdir/$realname" || exit $? if test -n "$stripme" && test -n "$striplib"; then $show "$striplib $destdir/$realname" $run eval "$striplib $destdir/$realname" || exit $? fi if test "$#" -gt 0; then # Delete the old symlinks, and create new ones. # Try `ln -sf' first, because the `ln' binary might depend on # the symlink we replace! Solaris /bin/ln does not understand -f, # so we also need to try rm && ln -s. for linkname do if test "$linkname" != "$realname"; then $show "(cd $destdir && { $LN_S -f $realname $linkname || { $rm $linkname && $LN_S $realname $linkname; }; })" $run eval "(cd $destdir && { $LN_S -f $realname $linkname || { $rm $linkname && $LN_S $realname $linkname; }; })" fi done fi # Do each command in the postinstall commands. lib="$destdir/$realname" cmds=$postinstall_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || { lt_exit=$? # Restore the uninstalled library and exit if test "$mode" = relink; then $run eval '(cd $output_objdir && $rm ${realname}T && $mv ${realname}U $realname)' fi exit $lt_exit } done IFS="$save_ifs" fi # Install the pseudo-library for information purposes. name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` instname="$dir/$name"i $show "$install_prog $instname $destdir/$name" $run eval "$install_prog $instname $destdir/$name" || exit $? # Maybe install the static library, too. test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library" ;; *.lo) # Install (i.e. copy) a libtool object. # Figure out destination file name, if it wasn't already specified. if test -n "$destname"; then destfile="$destdir/$destname" else destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'` destfile="$destdir/$destfile" fi # Deduce the name of the destination old-style object file. case $destfile in *.lo) staticdest=`$echo "X$destfile" | $Xsed -e "$lo2o"` ;; *.$objext) staticdest="$destfile" destfile= ;; *) $echo "$modename: cannot copy a libtool object to \`$destfile'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE ;; esac # Install the libtool object if requested. if test -n "$destfile"; then $show "$install_prog $file $destfile" $run eval "$install_prog $file $destfile" || exit $? fi # Install the old object if enabled. if test "$build_old_libs" = yes; then # Deduce the name of the old-style object file. staticobj=`$echo "X$file" | $Xsed -e "$lo2o"` $show "$install_prog $staticobj $staticdest" $run eval "$install_prog \$staticobj \$staticdest" || exit $? fi exit $EXIT_SUCCESS ;; *) # Figure out destination file name, if it wasn't already specified. if test -n "$destname"; then destfile="$destdir/$destname" else destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'` destfile="$destdir/$destfile" fi # If the file is missing, and there is a .exe on the end, strip it # because it is most likely a libtool script we actually want to # install stripped_ext="" case $file in *.exe) if test ! -f "$file"; then file=`$echo $file|${SED} 's,.exe$,,'` stripped_ext=".exe" fi ;; esac # Do a test to see if this is really a libtool program. case $host in *cygwin*|*mingw*) wrapper=`$echo $file | ${SED} -e 's,.exe$,,'` ;; *) wrapper=$file ;; esac if (${SED} -e '4q' $wrapper | grep "^# Generated by .*$PACKAGE")>/dev/null 2>&1; then notinst_deplibs= relink_command= # Note that it is not necessary on cygwin/mingw to append a dot to # foo even if both foo and FILE.exe exist: automatic-append-.exe # behavior happens only for exec(3), not for open(2)! Also, sourcing # `FILE.' does not work on cygwin managed mounts. # # If there is no directory component, then add one. case $wrapper in */* | *\\*) . ${wrapper} ;; *) . ./${wrapper} ;; esac # Check the variables that should have been set. if test -z "$notinst_deplibs"; then $echo "$modename: invalid libtool wrapper script \`$wrapper'" 1>&2 exit $EXIT_FAILURE fi finalize=yes for lib in $notinst_deplibs; do # Check to see that each library is installed. libdir= if test -f "$lib"; then # If there is no directory component, then add one. case $lib in */* | *\\*) . $lib ;; *) . ./$lib ;; esac fi libfile="$libdir/"`$echo "X$lib" | $Xsed -e 's%^.*/%%g'` ### testsuite: skip nested quoting test if test -n "$libdir" && test ! -f "$libfile"; then $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2 finalize=no fi done relink_command= # Note that it is not necessary on cygwin/mingw to append a dot to # foo even if both foo and FILE.exe exist: automatic-append-.exe # behavior happens only for exec(3), not for open(2)! Also, sourcing # `FILE.' does not work on cygwin managed mounts. # # If there is no directory component, then add one. case $wrapper in */* | *\\*) . ${wrapper} ;; *) . ./${wrapper} ;; esac outputname= if test "$fast_install" = no && test -n "$relink_command"; then if test "$finalize" = yes && test -z "$run"; then tmpdir=`func_mktempdir` file=`$echo "X$file$stripped_ext" | $Xsed -e 's%^.*/%%'` outputname="$tmpdir/$file" # Replace the output file specification. relink_command=`$echo "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'` $show "$relink_command" if $run eval "$relink_command"; then : else $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2 ${rm}r "$tmpdir" continue fi file="$outputname" else $echo "$modename: warning: cannot relink \`$file'" 1>&2 fi else # Install the binary that we compiled earlier. file=`$echo "X$file$stripped_ext" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"` fi fi # remove .exe since cygwin /usr/bin/install will append another # one anyway case $install_prog,$host in */usr/bin/install*,*cygwin*) case $file:$destfile in *.exe:*.exe) # this is ok ;; *.exe:*) destfile=$destfile.exe ;; *:*.exe) destfile=`$echo $destfile | ${SED} -e 's,.exe$,,'` ;; esac ;; esac $show "$install_prog$stripme $file $destfile" $run eval "$install_prog\$stripme \$file \$destfile" || exit $? test -n "$outputname" && ${rm}r "$tmpdir" ;; esac done for file in $staticlibs; do name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` # Set up the ranlib parameters. oldlib="$destdir/$name" $show "$install_prog $file $oldlib" $run eval "$install_prog \$file \$oldlib" || exit $? if test -n "$stripme" && test -n "$old_striplib"; then $show "$old_striplib $oldlib" $run eval "$old_striplib $oldlib" || exit $? fi # Do each command in the postinstall commands. cmds=$old_postinstall_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || exit $? done IFS="$save_ifs" done if test -n "$future_libdirs"; then $echo "$modename: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2 fi if test -n "$current_libdirs"; then # Maybe just do a dry run. test -n "$run" && current_libdirs=" -n$current_libdirs" exec_cmd='$SHELL $progpath $preserve_args --finish$current_libdirs' else exit $EXIT_SUCCESS fi ;; # libtool finish mode finish) modename="$modename: finish" libdirs="$nonopt" admincmds= if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then for dir do libdirs="$libdirs $dir" done for libdir in $libdirs; do if test -n "$finish_cmds"; then # Do each command in the finish commands. cmds=$finish_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" || admincmds="$admincmds $cmd" done IFS="$save_ifs" fi if test -n "$finish_eval"; then # Do the single finish_eval. eval cmds=\"$finish_eval\" $run eval "$cmds" || admincmds="$admincmds $cmds" fi done fi # Exit here if they wanted silent mode. test "$show" = : && exit $EXIT_SUCCESS $echo "X----------------------------------------------------------------------" | $Xsed $echo "Libraries have been installed in:" for libdir in $libdirs; do $echo " $libdir" done $echo $echo "If you ever happen to want to link against installed libraries" $echo "in a given directory, LIBDIR, you must either use libtool, and" $echo "specify the full pathname of the library, or use the \`-LLIBDIR'" $echo "flag during linking and do at least one of the following:" if test -n "$shlibpath_var"; then $echo " - add LIBDIR to the \`$shlibpath_var' environment variable" $echo " during execution" fi if test -n "$runpath_var"; then $echo " - add LIBDIR to the \`$runpath_var' environment variable" $echo " during linking" fi if test -n "$hardcode_libdir_flag_spec"; then libdir=LIBDIR eval flag=\"$hardcode_libdir_flag_spec\" $echo " - use the \`$flag' linker flag" fi if test -n "$admincmds"; then $echo " - have your system administrator run these commands:$admincmds" fi if test -f /etc/ld.so.conf; then $echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'" fi $echo $echo "See any operating system documentation about shared libraries for" $echo "more information, such as the ld(1) and ld.so(8) manual pages." $echo "X----------------------------------------------------------------------" | $Xsed exit $EXIT_SUCCESS ;; # libtool execute mode execute) modename="$modename: execute" # The first argument is the command name. cmd="$nonopt" if test -z "$cmd"; then $echo "$modename: you must specify a COMMAND" 1>&2 $echo "$help" exit $EXIT_FAILURE fi # Handle -dlopen flags immediately. for file in $execute_dlfiles; do if test ! -f "$file"; then $echo "$modename: \`$file' is not a file" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi dir= case $file in *.la) # Check to see that this really is a libtool archive. if (${SED} -e '2q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then : else $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi # Read the libtool library. dlname= library_names= # If there is no directory component, then add one. case $file in */* | *\\*) . $file ;; *) . ./$file ;; esac # Skip this library if it cannot be dlopened. if test -z "$dlname"; then # Warn if it was a shared library. test -n "$library_names" && $echo "$modename: warning: \`$file' was not linked with \`-export-dynamic'" continue fi dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` test "X$dir" = "X$file" && dir=. if test -f "$dir/$objdir/$dlname"; then dir="$dir/$objdir" else $echo "$modename: cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'" 1>&2 exit $EXIT_FAILURE fi ;; *.lo) # Just add the directory containing the .lo file. dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` test "X$dir" = "X$file" && dir=. ;; *) $echo "$modename: warning \`-dlopen' is ignored for non-libtool libraries and objects" 1>&2 continue ;; esac # Get the absolute pathname. absdir=`cd "$dir" && pwd` test -n "$absdir" && dir="$absdir" # Now add the directory to shlibpath_var. if eval "test -z \"\$$shlibpath_var\""; then eval "$shlibpath_var=\"\$dir\"" else eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\"" fi done # This variable tells wrapper scripts just to set shlibpath_var # rather than running their programs. libtool_execute_magic="$magic" # Check if any of the arguments is a wrapper script. args= for file do case $file in -*) ;; *) # Do a test to see if this is really a libtool program. if (${SED} -e '4q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then # If there is no directory component, then add one. case $file in */* | *\\*) . $file ;; *) . ./$file ;; esac # Transform arg to wrapped name. file="$progdir/$program" fi ;; esac # Quote arguments (to preserve shell metacharacters). file=`$echo "X$file" | $Xsed -e "$sed_quote_subst"` args="$args \"$file\"" done if test -z "$run"; then if test -n "$shlibpath_var"; then # Export the shlibpath_var. eval "export $shlibpath_var" fi # Restore saved environment variables if test "${save_LC_ALL+set}" = set; then LC_ALL="$save_LC_ALL"; export LC_ALL fi if test "${save_LANG+set}" = set; then LANG="$save_LANG"; export LANG fi # Now prepare to actually exec the command. exec_cmd="\$cmd$args" else # Display what would be done. if test -n "$shlibpath_var"; then eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\"" $echo "export $shlibpath_var" fi $echo "$cmd$args" exit $EXIT_SUCCESS fi ;; # libtool clean and uninstall mode clean | uninstall) modename="$modename: $mode" rm="$nonopt" files= rmforce= exit_status=0 # This variable tells wrapper scripts just to set variables rather # than running their programs. libtool_install_magic="$magic" for arg do case $arg in -f) rm="$rm $arg"; rmforce=yes ;; -*) rm="$rm $arg" ;; *) files="$files $arg" ;; esac done if test -z "$rm"; then $echo "$modename: you must specify an RM program" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE fi rmdirs= origobjdir="$objdir" for file in $files; do dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` if test "X$dir" = "X$file"; then dir=. objdir="$origobjdir" else objdir="$dir/$origobjdir" fi name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` test "$mode" = uninstall && objdir="$dir" # Remember objdir for removal later, being careful to avoid duplicates if test "$mode" = clean; then case " $rmdirs " in *" $objdir "*) ;; *) rmdirs="$rmdirs $objdir" ;; esac fi # Don't error if the file doesn't exist and rm -f was used. if (test -L "$file") >/dev/null 2>&1 \ || (test -h "$file") >/dev/null 2>&1 \ || test -f "$file"; then : elif test -d "$file"; then exit_status=1 continue elif test "$rmforce" = yes; then continue fi rmfiles="$file" case $name in *.la) # Possibly a libtool archive, so verify it. if (${SED} -e '2q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then . $dir/$name # Delete the libtool libraries and symlinks. for n in $library_names; do rmfiles="$rmfiles $objdir/$n" done test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library" case "$mode" in clean) case " $library_names " in # " " in the beginning catches empty $dlname *" $dlname "*) ;; *) rmfiles="$rmfiles $objdir/$dlname" ;; esac test -n "$libdir" && rmfiles="$rmfiles $objdir/$name $objdir/${name}i" ;; uninstall) if test -n "$library_names"; then # Do each command in the postuninstall commands. cmds=$postuninstall_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" if test "$?" -ne 0 && test "$rmforce" != yes; then exit_status=1 fi done IFS="$save_ifs" fi if test -n "$old_library"; then # Do each command in the old_postuninstall commands. cmds=$old_postuninstall_cmds save_ifs="$IFS"; IFS='~' for cmd in $cmds; do IFS="$save_ifs" eval cmd=\"$cmd\" $show "$cmd" $run eval "$cmd" if test "$?" -ne 0 && test "$rmforce" != yes; then exit_status=1 fi done IFS="$save_ifs" fi # FIXME: should reinstall the best remaining shared library. ;; esac fi ;; *.lo) # Possibly a libtool object, so verify it. if (${SED} -e '2q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then # Read the .lo file . $dir/$name # Add PIC object to the list of files to remove. if test -n "$pic_object" \ && test "$pic_object" != none; then rmfiles="$rmfiles $dir/$pic_object" fi # Add non-PIC object to the list of files to remove. if test -n "$non_pic_object" \ && test "$non_pic_object" != none; then rmfiles="$rmfiles $dir/$non_pic_object" fi fi ;; *) if test "$mode" = clean ; then noexename=$name case $file in *.exe) file=`$echo $file|${SED} 's,.exe$,,'` noexename=`$echo $name|${SED} 's,.exe$,,'` # $file with .exe has already been added to rmfiles, # add $file without .exe rmfiles="$rmfiles $file" ;; esac # Do a test to see if this is a libtool program. if (${SED} -e '4q' $file | grep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then relink_command= . $dir/$noexename # note $name still contains .exe if it was in $file originally # as does the version of $file that was added into $rmfiles rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}" if test "$fast_install" = yes && test -n "$relink_command"; then rmfiles="$rmfiles $objdir/lt-$name" fi if test "X$noexename" != "X$name" ; then rmfiles="$rmfiles $objdir/lt-${noexename}.c" fi fi fi ;; esac $show "$rm $rmfiles" $run $rm $rmfiles || exit_status=1 done objdir="$origobjdir" # Try to remove the ${objdir}s in the directories where we deleted files for dir in $rmdirs; do if test -d "$dir"; then $show "rmdir $dir" $run rmdir $dir >/dev/null 2>&1 fi done exit $exit_status ;; "") $echo "$modename: you must specify a MODE" 1>&2 $echo "$generic_help" 1>&2 exit $EXIT_FAILURE ;; esac if test -z "$exec_cmd"; then $echo "$modename: invalid operation mode \`$mode'" 1>&2 $echo "$generic_help" 1>&2 exit $EXIT_FAILURE fi fi # test -z "$show_help" if test -n "$exec_cmd"; then eval exec $exec_cmd exit $EXIT_FAILURE fi # We need to display help for each of the modes. case $mode in "") $echo \ "Usage: $modename [OPTION]... [MODE-ARG]... Provide generalized library-building support services. --config show all configuration variables --debug enable verbose shell tracing -n, --dry-run display commands without modifying any files --features display basic configuration information and exit --finish same as \`--mode=finish' --help display this help message and exit --mode=MODE use operation mode MODE [default=inferred from MODE-ARGS] --quiet same as \`--silent' --silent don't print informational messages --tag=TAG use configuration variables from tag TAG --version print version information MODE must be one of the following: clean remove files from the build directory compile compile a source file into a libtool object execute automatically set library path, then run a program finish complete the installation of libtool libraries install install libraries or executables link create a library or an executable uninstall remove libraries from an installed directory MODE-ARGS vary depending on the MODE. Try \`$modename --help --mode=MODE' for a more detailed description of MODE. Report bugs to ." exit $EXIT_SUCCESS ;; clean) $echo \ "Usage: $modename [OPTION]... --mode=clean RM [RM-OPTION]... FILE... Remove files from the build directory. RM is the name of the program to use to delete files associated with each FILE (typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed to RM. If FILE is a libtool library, object or program, all the files associated with it are deleted. Otherwise, only FILE itself is deleted using RM." ;; compile) $echo \ "Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE Compile a source file into a libtool library object. This mode accepts the following additional options: -o OUTPUT-FILE set the output file name to OUTPUT-FILE -prefer-pic try to building PIC objects only -prefer-non-pic try to building non-PIC objects only -static always build a \`.o' file suitable for static linking COMPILE-COMMAND is a command to be used in creating a \`standard' object file from the given SOURCEFILE. The output file name is determined by removing the directory component from SOURCEFILE, then substituting the C source code suffix \`.c' with the library object suffix, \`.lo'." ;; execute) $echo \ "Usage: $modename [OPTION]... --mode=execute COMMAND [ARGS]... Automatically set library path, then run a program. This mode accepts the following additional options: -dlopen FILE add the directory containing FILE to the library path This mode sets the library path environment variable according to \`-dlopen' flags. If any of the ARGS are libtool executable wrappers, then they are translated into their corresponding uninstalled binary, and any of their required library directories are added to the library path. Then, COMMAND is executed, with ARGS as arguments." ;; finish) $echo \ "Usage: $modename [OPTION]... --mode=finish [LIBDIR]... Complete the installation of libtool libraries. Each LIBDIR is a directory that contains libtool libraries. The commands that this mode executes may require superuser privileges. Use the \`--dry-run' option if you just want to see what would be executed." ;; install) $echo \ "Usage: $modename [OPTION]... --mode=install INSTALL-COMMAND... Install executables or libraries. INSTALL-COMMAND is the installation command. The first component should be either the \`install' or \`cp' program. The rest of the components are interpreted as arguments to that command (only BSD-compatible install options are recognized)." ;; link) $echo \ "Usage: $modename [OPTION]... --mode=link LINK-COMMAND... Link object files or libraries together to form another library, or to create an executable program. LINK-COMMAND is a command using the C compiler that you would use to create a program from several object files. The following components of LINK-COMMAND are treated specially: -all-static do not do any dynamic linking at all -avoid-version do not add a version suffix if possible -dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime -dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3) -export-symbols SYMFILE try to export only the symbols listed in SYMFILE -export-symbols-regex REGEX try to export only the symbols matching REGEX -LLIBDIR search LIBDIR for required installed libraries -lNAME OUTPUT-FILE requires the installed library libNAME -module build a library that can dlopened -no-fast-install disable the fast-install mode -no-install link a not-installable executable -no-undefined declare that a library does not refer to external symbols -o OUTPUT-FILE create OUTPUT-FILE from the specified objects -objectlist FILE Use a list of object files found in FILE to specify objects -precious-files-regex REGEX don't remove output files matching REGEX -release RELEASE specify package release information -rpath LIBDIR the created library will eventually be installed in LIBDIR -R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries -static do not do any dynamic linking of libtool libraries -version-info CURRENT[:REVISION[:AGE]] specify library version info [each variable defaults to 0] All other options (arguments beginning with \`-') are ignored. Every other argument is treated as a filename. Files ending in \`.la' are treated as uninstalled libtool libraries, other files are standard or library object files. If the OUTPUT-FILE ends in \`.la', then a libtool library is created, only library objects (\`.lo' files) may be specified, and \`-rpath' is required, except when creating a convenience library. If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created using \`ar' and \`ranlib', or on Windows using \`lib'. If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file is created, otherwise an executable program is created." ;; uninstall) $echo \ "Usage: $modename [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE... Remove libraries from an installation directory. RM is the name of the program to use to delete files associated with each FILE (typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed to RM. If FILE is a libtool library, all the files associated with it are deleted. Otherwise, only FILE itself is deleted using RM." ;; *) $echo "$modename: invalid operation mode \`$mode'" 1>&2 $echo "$help" 1>&2 exit $EXIT_FAILURE ;; esac $echo $echo "Try \`$modename --help' for more information about other modes." exit $? # The TAGs below are defined such that we never get into a situation # in which we disable both kinds of libraries. Given conflicting # choices, we go for a static library, that is the most portable, # since we can't tell whether shared libraries were disabled because # the user asked for that or because the platform doesn't support # them. This is particularly important on AIX, because we don't # support having both static and shared libraries enabled at the same # time on that platform, so we default to a shared-only configuration. # If a disable-shared tag is given, we'll fallback to a static-only # configuration. But we'll never go from static-only to shared-only. # ### BEGIN LIBTOOL TAG CONFIG: disable-shared disable_libs=shared # ### END LIBTOOL TAG CONFIG: disable-shared # ### BEGIN LIBTOOL TAG CONFIG: disable-static disable_libs=static # ### END LIBTOOL TAG CONFIG: disable-static # Local Variables: # mode:shell-script # sh-indentation:2 # End: sundials-2.5.0/config/config.guess0000700000175000017500000012522411741421110017773 0ustar sylvestresylvestre#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. timestamp='2005-12-13' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA # 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Originally written by Per Bothner . # Please send patches to . Submit a context # diff and a properly formatted ChangeLog entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # The plan is that this can be called by configure scripts if you # don't specify an explicit build system type. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] Output the configuration name of the system \`$me' is run on. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to ." version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" >&2 exit 1 ;; * ) break ;; esac done if test $# != 0; then echo "$me: too many arguments$help" >&2 exit 1 fi trap 'exit 1' 1 2 15 # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. # Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still # use `HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. set_cc_for_build=' trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; case $CC_FOR_BUILD,$HOST_CC,$CC in ,,) echo "int x;" > $dummy.c ; for c in cc gcc c89 c99 ; do if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then CC_FOR_BUILD="$c"; break ; fi ; done ; if test x"$CC_FOR_BUILD" = x ; then CC_FOR_BUILD=no_compiler_found ; fi ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward # compatibility and a consistent mechanism for selecting the # object file format. # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ /usr/sbin/$sysctl 2>/dev/null || echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep __ELF__ >/dev/null then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? os=netbsd else os=netbsdelf fi ;; *) os=netbsd ;; esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. case "${UNAME_VERSION}" in Debian*) release='-gnu' ;; *) release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ;; esac # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) echo powerppc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` case "$ALPHA_CPU_TYPE" in "EV4 (21064)") UNAME_MACHINE="alpha" ;; "EV4.5 (21064)") UNAME_MACHINE="alpha" ;; "LCA4 (21066/21068)") UNAME_MACHINE="alpha" ;; "EV5 (21164)") UNAME_MACHINE="alphaev5" ;; "EV5.6 (21164A)") UNAME_MACHINE="alphaev56" ;; "EV5.6 (21164PC)") UNAME_MACHINE="alphapca56" ;; "EV5.7 (21164PC)") UNAME_MACHINE="alphapca57" ;; "EV6 (21264)") UNAME_MACHINE="alphaev6" ;; "EV6.7 (21264A)") UNAME_MACHINE="alphaev67" ;; "EV6.8CB (21264C)") UNAME_MACHINE="alphaev68" ;; "EV6.8AL (21264B)") UNAME_MACHINE="alphaev68" ;; "EV6.8CX (21264D)") UNAME_MACHINE="alphaev68" ;; "EV6.9A (21264/EV69A)") UNAME_MACHINE="alphaev69" ;; "EV7 (21364)") UNAME_MACHINE="alphaev7" ;; "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` exit ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos exit ;; *:OS/390:*:*) echo i370-ibm-openedition exit ;; *:z/VM:*:*) echo s390-ibm-zvmoe exit ;; *:OS400:*:*) echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; arm:riscos:*:*|arm:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 exit ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; i86pc:SunOS:5.*:*) echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor # > m68000). The system name ranges from "MiNT" over "FreeMiNT" # to the lowercase version "mint" (or "freemint"). Finally # the system name "TOS" denotes a system which is actually not # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) echo m68k-milan-mint${UNAME_RELEASE} exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) echo m68k-hades-mint${UNAME_RELEASE} exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) echo m68k-unknown-mint${UNAME_RELEASE} exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __cplusplus #include /* for printf() prototype */ int main (int argc, char *argv[]) { #else int main (argc, argv) int argc; char *argv[]; { #endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ [ ${TARGET_BINARY_INTERFACE}x = x ] then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` then echo "$SYSTEM_NAME" else echo rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit ;; *:AIX:*:[45]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit ;; *:AIX:*:*) echo rs6000-ibm-aix exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "${sc_cpu_version}" in 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 case "${sc_kernel_bits}" in 32) HP_ARCH="hppa2.0n" ;; 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 esac ;; esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #define _HPUX_SOURCE #include #include int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac if [ ${HP_ARCH} = "hppa2.0w" ] then eval $set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler # generating 64-bit code. GNU and HP use different nomenclature: # # $ CC_FOR_BUILD=cc ./config.guess # => hppa2.0w-hp-hpux11.23 # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | grep __LP64__ >/dev/null then HP_ARCH="hppa2.0w" else HP_ARCH="hppa64" fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; *:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; i*:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:windows32*:*) # uname -m includes "-pc" on this system. echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; x86:Interix*:[345]*) echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' exit ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; arm*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) echo cris-axis-linux-gnu exit ;; crisv32:Linux:*:*) echo crisv32-axis-linux-gnu exit ;; frv:Linux:*:*) echo frv-unknown-linux-gnu exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m32r*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; mips:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips #undef mipsel #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mipsel #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips #else CPU= #endif #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^CPU/{s: ::g;p;}'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef mips64 #undef mips64el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=mips64el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=mips64 #else CPU= #endif #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^CPU/{s: ::g;p;}'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; or32:Linux:*:*) echo or32-unknown-linux-gnu exit ;; ppc:Linux:*:*) echo powerpc-unknown-linux-gnu exit ;; ppc64:Linux:*:*) echo powerpc64-unknown-linux-gnu exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; PCA57) UNAME_MACHINE=alphapca56 ;; EV6) UNAME_MACHINE=alphaev6 ;; EV67) UNAME_MACHINE=alphaev67 ;; EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in PA7*) echo hppa1.1-unknown-linux-gnu ;; PA8*) echo hppa2.0-unknown-linux-gnu ;; *) echo hppa-unknown-linux-gnu ;; esac exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-gnu exit ;; i*86:Linux:*:*) # The BFD linker knows what the default object file format is, so # first see if it will tell us. cd to the root directory to prevent # problems with other programs or directories called `ld' in the path. # Set LC_ALL=C to ensure ld outputs messages in English. ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ | sed -ne '/supported targets:/!d s/[ ][ ]*/ /g s/.*supported targets: *// s/ .*// p'` case "$ld_supported_targets" in elf32-i386) TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" ;; a.out-i386-linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" exit ;; coff-i386) echo "${UNAME_MACHINE}-pc-linux-gnucoff" exit ;; "") # Either a pre-BFD a.out linker (linux-gnuoldld) or # one that does not give us useful --help. echo "${UNAME_MACHINE}-pc-linux-gnuoldld" exit ;; esac # Determine whether the default compiler is a.out or elf eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include #ifdef __ELF__ # ifdef __GLIBC__ # if __GLIBC__ >= 2 LIBC=gnu # else LIBC=gnulibc1 # endif # else LIBC=gnulibc1 # endif #else #if defined(__INTEL_COMPILER) || defined(__PGI) LIBC=gnu #else LIBC=gnuaout #endif #endif #ifdef __dietlibc__ LIBC=dietlibc #endif EOF eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^LIBC/{s: ::g;p;}'`" test x"${LIBC}" != x && { echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit } test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos exit ;; i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi exit ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. echo i386-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; paragon:*:*:*) echo i860-intel-osf1 exit ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix exit ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says echo i586-unisys-sysv4 exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. echo ${UNAME_MACHINE}-stratus-vos exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} exit ;; *:QNX:*:4*) echo i386-pc-qnx exit ;; NSE-?:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. if test "$cputype" = "386"; then UNAME_MACHINE=i386 else UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 exit ;; *:ITS:*:*) echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; V*) echo vax-dec-vms ; exit ;; esac ;; *:XENIX:*:SysV) echo i386-pc-xenix exit ;; i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 eval $set_cc_for_build cat >$dummy.c < # include #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; if (version < 4) printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); else printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) # if !defined (ultrix) # include # if defined (BSD) # if BSD == 43 printf ("vax-dec-bsd4.3\n"); exit (0); # else # if BSD == 199006 printf ("vax-dec-bsd4.3reno\n"); exit (0); # else printf ("vax-dec-bsd\n"); exit (0); # endif # endif # else printf ("vax-dec-bsd\n"); exit (0); # endif # else printf ("vax-dec-ultrix\n"); exit (0); # endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; c34*) echo c34-convex-bsd exit ;; c38*) echo c38-convex-bsd exit ;; c4*) echo c4-convex-bsd exit ;; esac fi cat >&2 < in order to provide the needed information to handle your system. config.guess timestamp = $timestamp uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` /bin/uname -X = `(/bin/uname -X) 2>/dev/null` hostinfo = `(hostinfo) 2>/dev/null` /bin/universe = `(/bin/universe) 2>/dev/null` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` /bin/arch = `(/bin/arch) 2>/dev/null` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` UNAME_MACHINE = ${UNAME_MACHINE} UNAME_RELEASE = ${UNAME_RELEASE} UNAME_SYSTEM = ${UNAME_SYSTEM} UNAME_VERSION = ${UNAME_VERSION} EOF exit 1 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: sundials-2.5.0/config/CheckFortranFunctionExists.cmake0000600000175000017500000000373011741421110023733 0ustar sylvestresylvestre# - Check if the Fortran function exists. # CHECK_FORTRAN_FUNCTION_EXISTS(FUNCTION VARIABLE) # - macro which checks if the Fortran function exists # FUNCTION - the name of the Fortran function # VARIABLE - variable to store the result # # The following variables may be set before calling this macro to # modify the way the check is run: # # CMAKE_REQUIRED_LIBRARIES = list of libraries to link macro(CHECK_FORTRAN_FUNCTION_EXISTS FUNCTION VARIABLE) if(NOT DEFINED ${VARIABLE}) message(STATUS "Looking for Fortran ${FUNCTION}") if(CMAKE_REQUIRED_LIBRARIES) set(CHECK_FUNCTION_EXISTS_ADD_LIBRARIES "-DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}") else(CMAKE_REQUIRED_LIBRARIES) set(CHECK_FUNCTION_EXISTS_ADD_LIBRARIES) endif(CMAKE_REQUIRED_LIBRARIES) FILE(WRITE ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortranCompiler.f " program TESTFortran external ${FUNCTION} end " ) try_compile(${VARIABLE} ${CMAKE_BINARY_DIR} ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortranCompiler.f CMAKE_FLAGS "${CHECK_FUNCTION_EXISTS_ADD_LIBRARIES}" OUTPUT_VARIABLE OUTPUT ) if(${VARIABLE}) set(${VARIABLE} 1 CACHE INTERNAL "Have Fortran function ${FUNCTION}") message(STATUS "Looking for Fortran ${FUNCTION} - found") file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log "Determining if the Fortran ${FUNCTION} exists passed with the following output:\n" "${OUTPUT}\n\n") else(${VARIABLE}) message(STATUS "Looking for Fortran ${FUNCTION} - not found") set(${VARIABLE} "" CACHE INTERNAL "Have Fortran function ${FUNCTION}") file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log "Determining if the Fortran ${FUNCTION} exists failed with the following output:\n" "${OUTPUT}\n\n") endif(${VARIABLE}) endif(NOT DEFINED ${VARIABLE}) endmacro(CHECK_FORTRAN_FUNCTION_EXISTS) sundials-2.5.0/config/SundialsMPIC.cmake0000600000175000017500000001625111741421110020711 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.1 $ # $Date: 2009/02/17 02:58:46 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2008, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # MPI-C tests for SUNDIALS CMake-based configuration. # # set(MPIC_FOUND FALSE) set(MPIC_MPI2 FALSE) # Local variable indicating whether to test MPI set(MPIC_PERFORM_TEST FALSE) # By default, we try to use the MPI compiler script # Search for the MPICC compiler script find_program(MPI_MPICC NAMES mpicc DOC "mpicc program") if(MPI_MPICC) message(STATUS "Looking for MPI C compiler script... ${MPI_MPICC}") # Test the MPI compiler script set(MPIC_PERFORM_TEST TRUE) else(MPI_MPICC) message(STATUS "Looking for MPI C compiler script... FAILED") # If not already available, search for MPI headers and libraries. # Define the following values # MPI_INCLUDE_PATH = cached location of mpi.h # MPI_LIBRARIES = cached list of libraries to link in (mpi mpich etc) if(NOT MPI_LIBRARIES) find_path(MPI_INCLUDE_PATH mpi.h PATHS /usr/local/include /usr/include /usr/include/mpi /usr/local/mpi/include "$ENV{ProgramFiles}/MPICH/SDK/Include" "$ENV{ProgramFiles}/MPICH2/include" "C:/Program Files/MPICH/SDK/Include" ) find_library(MPI_LIBRARIES NAMES mpich2 mpi mpich PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "$ENV{ProgramFiles}/MPICH2/Lib" "C:/Program Files/MPICH/SDK/Lib" ) find_library(MPI_EXTRA_LIBRARIES NAMES mpi++ PATHS /usr/lib /usr/local/lib /usr/local/mpi/lib "$ENV{ProgramFiles}/MPICH/SDK/Lib" "C:/Program Files/MPICH/SDK/Lib" DOC "If a second mpi library is necessary, specify it here.") if(MPI_EXTRA_LIBRARIES) set(MPI_LIBRARIES ${MPI_LIBRARIES} ${MPI_EXTRA_LIBRARIES}) endif(MPI_EXTRA_LIBRARIES) endif(NOT MPI_LIBRARIES) if(MPI_LIBRARIES) message(STATUS "Looking for MPI libraries... ${MPI_LIBRARIES}") # Test the MPI libraries set(MPIC_PERFORM_TEST TRUE) else(MPI_LIBRARIES) message(STATUS "Looking for MPI libraries... FAILED") endif(MPI_LIBRARIES) endif(MPI_MPICC) # If we have what to test, do it now if(MPIC_PERFORM_TEST) # Create the MPITest directory set(MPITest_DIR ${PROJECT_BINARY_DIR}/MPITest) file(MAKE_DIRECTORY ${MPITest_DIR}) # Create a CMakeLists.txt file which will generate the "mpictest" executable if(MPI_MPICC) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpictest C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_C_COMPILER ${MPI_MPICC})\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "ADD_EXECUTABLE(mpictest mpictest.c)\n") else(MPI_MPICC) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpictest C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH})\n" "ADD_EXECUTABLE(mpictest mpictest.c)\n" "TARGET_LINK_LIBRARIES(mpictest ${MPI_LIBRARIES})\n") endif(MPI_MPICC) # Create a simple C source which only calls the MPI_Init and MPI_Finalize functions file(WRITE ${MPITest_DIR}/mpictest.c "#include \n" "int main(){\n" "int c;\n" "char **v;\n" "MPI_Init(&c, &v);\n" "MPI_Finalize();\n" "return(0);\n" "}\n") # Use TRY_COMPILE to make the target "mpictest" try_compile(MPITEST_OK ${MPITest_DIR} ${MPITest_DIR} mpitest OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. file(REMOVE_RECURSE ${MPITest_DIR}/CMakeFiles) # Process test result if(MPITEST_OK) message(STATUS "Trying to compile and link a simple MPI C program... OK") set(MPIC_FOUND TRUE) else(MPITEST_OK) message(STATUS "Trying to compile and link a simple MPI C program... FAILED") endif(MPITEST_OK) endif(MPIC_PERFORM_TEST) # Finally, if MPI-C was found and is working, # also check if it provides MPI-2 support if(MPIC_FOUND) # Create a CMakeLists.txt file which will generate the "mpi2test" executable if(MPI_MPICC) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpi2test C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_C_COMPILER ${MPI_MPICC})\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "ADD_EXECUTABLE(mpi2test mpi2test.c)\n") else(MPI_MPICC) file(WRITE ${MPITest_DIR}/CMakeLists.txt "PROJECT(mpi2test C)\n" "SET(CMAKE_VERBOSE_MAKEFILE ON)\n" "SET(CMAKE_BUILD_TYPE \"${CMAKE_BUILD_TYPE}\")\n" "SET(CMAKE_C_FLAGS \"${CMAKE_C_FLAGS}\")\n" "SET(CMAKE_C_FLAGS_RELEASE \"${CMAKE_C_FLAGS_RELEASE}\")\n" "SET(CMAKE_C_FLAGS_DEBUG \"${CMAKE_C_FLAGS_DEBUG}\")\n" "SET(CMAKE_C_FLAGS_RELWITHDEBUGINFO \"${CMAKE_C_FLAGS_RELWITHDEBUGINFO}\")\n" "SET(CMAKE_C_FLAGS_MINSIZE \"${CMAKE_C_FLAGS_MINSIZE}\")\n" "INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH})\n" "ADD_EXECUTABLE(mpi2test mpi2test.c)\n" "TARGET_LINK_LIBRARIES(mpi2test ${MPI_LIBRARIES})\n") endif(MPI_MPICC) # Create a simple C source which calls the MPI_Comm_f2c function file(WRITE ${MPITest_DIR}/mpi2test.c "#include \n" "int main(){\n" "int c;\n" "char **v;\n" "MPI_Comm C_comm;\n" "MPI_Init(&c, &v);\n" "C_comm = MPI_Comm_f2c((MPI_Fint) 1);\n" "MPI_Finalize();\n" "return(0);\n" "}\n") # Use TRY_COMPILE to make the target "mpi2test" try_compile(MPITEST_OK ${MPITest_DIR} ${MPITest_DIR} mpi2test OUTPUT_VARIABLE MY_OUTPUT) # To ensure we do not use stuff from the previous attempts, # we must remove the CMakeFiles directory. FILE(REMOVE_RECURSE ${MPITest_DIR}/CMakeFiles) # Interpret test results if(MPITEST_OK) message(STATUS "Checking for MPI-2 support... OK") set(MPIC_MPI2 TRUE) else(MPITEST_OK) message(STATUS "Checking for MPI-2 support... FAILED") endif(MPITEST_OK) endif(MPIC_FOUND) sundials-2.5.0/config/mod_c.m40000600000175000017500000000613511741421110016777 0ustar sylvestresylvestre# This file is part of Autoconf. -*- Autoconf -*- # Programming languages support. # Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # AC_LANG(C) # ---------- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. m4_define([AC_LANG(C)], [ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&AS_MESSAGE_LOG_FD' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&AS_MESSAGE_LOG_FD' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&AS_MESSAGE_LOG_FD' ac_compiler_gnu=$ac_cv_c_compiler_gnu ]) sundials-2.5.0/include/0000755000175000017500000000000011767174700015657 5ustar sylvestresylvestresundials-2.5.0/include/cvode/0000755000175000017500000000000011767174700016757 5ustar sylvestresylvestresundials-2.5.0/include/cvode/cvode_band.h0000600000175000017500000000374611741421121021176 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE band linear solver, CVBAND. * ----------------------------------------------------------------- */ #ifndef _CVBAND_H #define _CVBAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : CVBand * ----------------------------------------------------------------- * A call to the CVBand function links the main CVODE integrator * with the CVBAND linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian * approximation. * * mlower is the lower bandwidth of the band Jacobian * approximation. * * The return value of CVBand is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the cvode memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing or * if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBand(void *cvode_mem, long int N, long int mupper, long int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_dense.h0000600000175000017500000000334111741421121021357 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE dense linear solver, CVDENSE. * ----------------------------------------------------------------- */ #ifndef _CVDENSE_H #define _CVDENSE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function: CVDense * ----------------------------------------------------------------- * A call to the CVDense function links the main integrator with * the CVDENSE linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * The return value of CVDense is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the cvode memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDense(void *cvode_mem, long int N); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode.h0000600000175000017500000010350611741421121020205 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban * and Dan Shumaker @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the interface file for the main CVODE integrator. * ----------------------------------------------------------------- * * CVODE is used to solve numerically the ordinary initial value * problem: * * y' = f(t,y), * y(t0) = y0, * * where t0, y0 in R^N, and f: R x R^N -> R^N are given. * * ----------------------------------------------------------------- */ #ifndef _CVODE_H #define _CVODE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * C V O D E C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * Enumerations for inputs to CVodeCreate and CVode. * ----------------------------------------------------------------- * Symbolic constants for the lmm and iter parameters to CVodeCreate * and the input parameter itask to CVode, are given below. * * lmm: The user of the CVODE package specifies whether to use the * CV_ADAMS (Adams-Moulton) or CV_BDF (Backward Differentiation * Formula) linear multistep method. The BDF method is * recommended for stiff problems, and the CV_ADAMS method is * recommended for nonstiff problems. * * iter: At each internal time step, a nonlinear equation must * be solved. The user can specify either CV_FUNCTIONAL * iteration, which does not require linear algebra, or a * CV_NEWTON iteration, which requires the solution of linear * systems. In the CV_NEWTON case, the user also specifies a * CVODE linear solver. CV_NEWTON is recommended in case of * stiff problems. * * itask: The itask input parameter to CVode indicates the job * of the solver for the next user step. The CV_NORMAL * itask is to have the solver take internal steps until * it has reached or just passed the user specified tout * parameter. The solver then interpolates in order to * return an approximate value of y(tout). The CV_ONE_STEP * option tells the solver to just take one internal step * and return the solution at the point reached by that step. * ----------------------------------------------------------------- */ /* lmm */ #define CV_ADAMS 1 #define CV_BDF 2 /* iter */ #define CV_FUNCTIONAL 1 #define CV_NEWTON 2 /* itask */ #define CV_NORMAL 1 #define CV_ONE_STEP 2 /* * ---------------------------------------- * CVODE return flags * ---------------------------------------- */ #define CV_SUCCESS 0 #define CV_TSTOP_RETURN 1 #define CV_ROOT_RETURN 2 #define CV_WARNING 99 #define CV_TOO_MUCH_WORK -1 #define CV_TOO_MUCH_ACC -2 #define CV_ERR_FAILURE -3 #define CV_CONV_FAILURE -4 #define CV_LINIT_FAIL -5 #define CV_LSETUP_FAIL -6 #define CV_LSOLVE_FAIL -7 #define CV_RHSFUNC_FAIL -8 #define CV_FIRST_RHSFUNC_ERR -9 #define CV_REPTD_RHSFUNC_ERR -10 #define CV_UNREC_RHSFUNC_ERR -11 #define CV_RTFUNC_FAIL -12 #define CV_MEM_FAIL -20 #define CV_MEM_NULL -21 #define CV_ILL_INPUT -22 #define CV_NO_MALLOC -23 #define CV_BAD_K -24 #define CV_BAD_T -25 #define CV_BAD_DKY -26 #define CV_TOO_CLOSE -27 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ----------------------------------------------------------------- * Type : CVRhsFn * ----------------------------------------------------------------- * The f function which defines the right hand side of the ODE * system y' = f(t,y) must have type CVRhsFn. * f takes as input the independent variable value t, and the * dependent variable vector y. It stores the result of f(t,y) * in the vector ydot. The y and ydot arguments are of type * N_Vector. * (Allocation of memory for ydot is handled within CVODE) * The user_data parameter is the same as the user_data * parameter set by the user through the CVodeSetUserData routine. * This user-supplied pointer is passed to the user's f function * every time it is called. * * A CVRhsFn should return 0 if successful, a negative value if * an unrecoverable error occured, and a positive value if a * recoverable error (e.g. invalid y values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODE * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVRhsFn)(realtype t, N_Vector y, N_Vector ydot, void *user_data); /* * ----------------------------------------------------------------- * Type : CVRootFn * ----------------------------------------------------------------- * A function g, which defines a set of functions g_i(t,y) whose * roots are sought during the integration, must have type CVRootFn. * The function g takes as input the independent variable value * t, and the dependent variable vector y. It stores the nrtfn * values g_i(t,y) in the realtype array gout. * (Allocation of memory for gout is handled within CVODE.) * The user_data parameter is the same as that passed by the user * to the CVodeSetUserData routine. This user-supplied pointer is * passed to the user's g function every time it is called. * * A CVRootFn should return 0 if successful or a non-zero value * if an error occured (in which case the integration will be halted). * ----------------------------------------------------------------- */ typedef int (*CVRootFn)(realtype t, N_Vector y, realtype *gout, void *user_data); /* * ----------------------------------------------------------------- * Type : CVEwtFn * ----------------------------------------------------------------- * A function e, which sets the error weight vector ewt, must have * type CVEwtFn. * The function e takes as input the current dependent variable y. * It must set the vector of error weights used in the WRMS norm: * * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] * * Typically, the vector ewt has components: * * ewt_i = 1 / (reltol * |y_i| + abstol_i) * * The user_data parameter is the same as that passed by the user * to the CVodeSetUserData routine. This user-supplied pointer is * passed to the user's e function every time it is called. * A CVEwtFn e must return 0 if the error weight vector has been * successfuly set and a non-zero value otherwise. * ----------------------------------------------------------------- */ typedef int (*CVEwtFn)(N_Vector y, N_Vector ewt, void *user_data); /* * ----------------------------------------------------------------- * Type : CVErrHandlerFn * ----------------------------------------------------------------- * A function eh, which handles error messages, must have type * CVErrHandlerFn. * The function eh takes as input the error code, the name of the * module reporting the error, the error message, and a pointer to * user data, the same as that passed to CVodeSetUserData. * * All error codes are negative, except CV_WARNING which indicates * a warning (the solver continues). * * A CVErrHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*CVErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); /* * ================================================================= * U S E R - C A L L A B L E R O U T I N E S * ================================================================= */ /* * ----------------------------------------------------------------- * Function : CVodeCreate * ----------------------------------------------------------------- * CVodeCreate creates an internal memory block for a problem to * be solved by CVODE. * * lmm is the type of linear multistep method to be used. * The legal values are CV_ADAMS and CV_BDF (see previous * description). * * iter is the type of iteration used to solve the nonlinear * system that arises during each internal time step. * The legal values are CV_FUNCTIONAL and CV_NEWTON. * * If successful, CVodeCreate returns a pointer to initialized * problem memory. This pointer should be passed to CVodeInit. * If an initialization error occurs, CVodeCreate prints an error * message to standard err and returns NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void *CVodeCreate(int lmm, int iter); /* * ----------------------------------------------------------------- * Integrator optional input specification functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * Function | Optional input / [ default value ] * ----------------------------------------------------------------- * | * CVodeSetErrHandlerFn | user-provided ErrHandler function. * | [internal] * | * CVodeSetErrFile | the file pointer for an error file * | where all CVODE warning and error * | messages will be written if the default * | internal error handling function is used. * | This parameter can be stdout (standard * | output), stderr (standard error), or a * | file pointer (corresponding to a user * | error file opened for writing) returned * | by fopen. * | If not called, then all messages will * | be written to the standard error stream. * | [stderr] * | * CVodeSetUserData | a pointer to user data that will be * | passed to the user's f function every * | time f is called. * | [NULL] * | * CVodeSetMaxOrd | maximum lmm order to be used by the * | solver. * | [12 for Adams , 5 for BDF] * | * CVodeSetMaxNumSteps | maximum number of internal steps to be * | taken by the solver in its attempt to * | reach tout. * | [500] * | * CVodeSetMaxHnilWarns | maximum number of warning messages * | issued by the solver that t+h==t on the * | next internal step. A value of -1 means * | no such messages are issued. * | [10] * | * CVodeSetStabLimDet | flag to turn on/off stability limit * | detection (TRUE = on, FALSE = off). * | When BDF is used and order is 3 or * | greater, CVsldet is called to detect * | stability limit. If limit is detected, * | the order is reduced. * | [FALSE] * | * CVodeSetInitStep | initial step size. * | [estimated by CVODE] * | * CVodeSetMinStep | minimum absolute value of step size * | allowed. * | [0.0] * | * CVodeSetMaxStep | maximum absolute value of step size * | allowed. * | [infinity] * | * CVodeSetStopTime | the independent variable value past * | which the solution is not to proceed. * | [infinity] * | * CVodeSetMaxErrTestFails | Maximum number of error test failures * | in attempting one step. * | [7] * | * CVodeSetMaxNonlinIters | Maximum number of nonlinear solver * | iterations at one solution. * | [3] * | * CVodeSetMaxConvFails | Maximum number of convergence failures * | allowed in attempting one step. * | [10] * | * CVodeSetNonlinConvCoef | Coefficient in the nonlinear * | convergence test. * | [0.1] * | * ----------------------------------------------------------------- * | * CVodeSetIterType | Changes the current nonlinear iteration * | type. * | [set by CVodecreate] * | * ----------------------------------------------------------------- * | * CVodeSetRootDirection | Specifies the direction of zero * | crossings to be monitored * | [both directions] * | * CVodeSetNoInactiveRootWarn | disable warning about possible * | g==0 at beginning of integration * | * ----------------------------------------------------------------- * ----------------------------------------------------------------- * Return flag: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory is NULL * CV_ILL_INPUT if an argument has an illegal value * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int CVodeSetErrFile(void *cvode_mem, FILE *errfp); SUNDIALS_EXPORT int CVodeSetUserData(void *cvode_mem, void *user_data); SUNDIALS_EXPORT int CVodeSetMaxOrd(void *cvode_mem, int maxord); SUNDIALS_EXPORT int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); SUNDIALS_EXPORT int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); SUNDIALS_EXPORT int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); SUNDIALS_EXPORT int CVodeSetInitStep(void *cvode_mem, realtype hin); SUNDIALS_EXPORT int CVodeSetMinStep(void *cvode_mem, realtype hmin); SUNDIALS_EXPORT int CVodeSetMaxStep(void *cvode_mem, realtype hmax); SUNDIALS_EXPORT int CVodeSetStopTime(void *cvode_mem, realtype tstop); SUNDIALS_EXPORT int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); SUNDIALS_EXPORT int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); SUNDIALS_EXPORT int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); SUNDIALS_EXPORT int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); SUNDIALS_EXPORT int CVodeSetIterType(void *cvode_mem, int iter); SUNDIALS_EXPORT int CVodeSetRootDirection(void *cvode_mem, int *rootdir); SUNDIALS_EXPORT int CVodeSetNoInactiveRootWarn(void *cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeInit * ----------------------------------------------------------------- * CVodeInit allocates and initializes memory for a problem to * to be solved by CVODE. * * cvode_mem is pointer to CVODE memory returned by CVodeCreate. * * f is the name of the C function defining the right-hand * side function in y' = f(t,y). * * t0 is the initial value of t. * * y0 is the initial condition vector y(t0). * * Return flag: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory was NULL * CV_MEM_FAIL if a memory allocation failed * CV_ILL_INPUT f an argument has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0); /* * ----------------------------------------------------------------- * Function : CVodeReInit * ----------------------------------------------------------------- * CVodeReInit re-initializes CVode for the solution of a problem, * where a prior call to CVodeInit has been made with the same * problem size N. CVodeReInit performs the same input checking * and initializations that CVodeInit does. * But it does no memory allocation, assuming that the existing * internal memory is sufficient for the new problem. * * The use of CVodeReInit requires that the maximum method order, * maxord, is no larger for the new problem than for the problem * specified in the last call to CVodeInit. This condition is * automatically fulfilled if the multistep method parameter lmm * is unchanged (or changed from CV_ADAMS to CV_BDF) and the default * value for maxord is specified. * * All of the arguments to CVodeReInit have names and meanings * identical to those of CVodeInit. * * The return value of CVodeReInit is equal to CV_SUCCESS = 0 if * there were no errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL (i.e., * CVodeCreate has not been called). * CV_NO_MALLOC indicating that cvode_mem has not been * allocated (i.e., CVodeInit has not been * called). * CV_ILL_INPUT indicating an input argument was illegal * (including an attempt to increase maxord). * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0); /* * ----------------------------------------------------------------- * Functions : CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances. One of them * MUST be called before the first call to CVode. * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) * which will be called to set the error weight vector. * * The tolerances reltol and abstol define a vector of error weights, * ewt, with components * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). * This vector is used in all error and convergence tests, which * use a weighted RMS norm on all error-like vectors v: * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), * where N is the problem dimension. * * The return value of these functions is equal to CV_SUCCESS = 0 if * there were no errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL (i.e., * CVodeCreate has not been called). * CV_NO_MALLOC indicating that cvode_mem has not been * allocated (i.e., CVodeInit has not been * called). * CV_ILL_INPUT indicating an input argument was illegal * (e.g. a negative tolerance) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun); /* * ----------------------------------------------------------------- * Function : CVodeRootInit * ----------------------------------------------------------------- * CVodeRootInit initializes a rootfinding problem to be solved * during the integration of the ODE system. It must be called * after CVodeCreate, and before CVode. The arguments are: * * cvode_mem = pointer to CVODE memory returned by CVodeCreate. * * nrtfn = number of functions g_i, an int >= 0. * * g = name of user-supplied function, of type CVRootFn, * defining the functions g_i whose roots are sought. * * If a new problem is to be solved with a call to CVodeReInit, * where the new problem has no root functions but the prior one * did, then call CVodeRootInit with nrtfn = 0. * * The return value of CVodeRootInit is CV_SUCCESS = 0 if there were * no errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL, or * CV_MEM_FAIL indicating a memory allocation failed. * (including an attempt to increase maxord). * CV_ILL_INPUT indicating nrtfn > 0 but g = NULL. * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g); /* * ----------------------------------------------------------------- * Function : CVode * ----------------------------------------------------------------- * CVode integrates the ODE over an interval in t. * If itask is CV_NORMAL, then the solver integrates from its * current internal t value to a point at or beyond tout, then * interpolates to t = tout and returns y(tout) in the user- * allocated vector yout. If itask is CV_ONE_STEP, then the solver * takes one internal time step and returns in yout the value of * y at the new internal time. In this case, tout is used only * during the first call to CVode to determine the direction of * integration and the rough scale of the t variable. If tstop is * enabled (through a call to CVodeSetStopTime), then CVode returns * the solution at tstop. Once the integrator returns at a tstop * time, any future testing for tstop is disabled (and can be * reenabled only though a new call to CVodeSetStopTime). * The time reached by the solver is placed in (*tret). The * user is responsible for allocating the memory for this value. * * cvode_mem is the pointer to CVODE memory returned by * CVodeCreate. * * tout is the next time at which a computed solution is desired. * * yout is the computed solution vector. In CV_NORMAL mode with no * errors and no roots found, yout=y(tout). * * tret is a pointer to a real location. CVode sets (*tret) to * the time reached by the solver and returns * yout=y(*tret). * * itask is CV_NORMAL or CV_ONE_STEP. These two modes are described above. * * Here is a brief description of each return value: * * CV_SUCCESS: CVode succeeded and no roots were found. * * CV_ROOT_RETURN: CVode succeeded, and found one or more roots. * If nrtfn > 1, call CVodeGetRootInfo to see * which g_i were found to have a root at (*tret). * * CV_TSTOP_RETURN: CVode succeeded and returned at tstop. * * CV_MEM_NULL: The cvode_mem argument was NULL. * * CV_NO_MALLOC: cvode_mem was not allocated. * * CV_ILL_INPUT: One of the inputs to CVode is illegal. This * includes the situation when a component of the * error weight vectors becomes < 0 during * internal time-stepping. It also includes the * situation where a root of one of the root * functions was found both at t0 and very near t0. * The ILL_INPUT flag will also be returned if the * linear solver routine CV--- (called by the user * after calling CVodeCreate) failed to set one of * the linear solver-related fields in cvode_mem or * if the linear solver's init routine failed. In * any case, the user should see the printed * error message for more details. * * CV_TOO_MUCH_WORK: The solver took mxstep internal steps but * could not reach tout. The default value for * mxstep is MXSTEP_DEFAULT = 500. * * CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy * demanded by the user for some internal step. * * CV_ERR_FAILURE: Error test failures occurred too many times * (= MXNEF = 7) during one internal time step or * occurred with |h| = hmin. * * CV_CONV_FAILURE: Convergence test failures occurred too many * times (= MXNCF = 10) during one internal time * step or occurred with |h| = hmin. * * CV_LINIT_FAIL: The linear solver's initialization function * failed. * * CV_LSETUP_FAIL: The linear solver's setup routine failed in an * unrecoverable manner. * * CV_LSOLVE_FAIL: The linear solver's solve routine failed in an * unrecoverable manner. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask); /* * ----------------------------------------------------------------- * Function : CVodeGetDky * ----------------------------------------------------------------- * CVodeGetDky computes the kth derivative of the y function at * time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * k=0, 1, ..., qu, where qu is the order last used. The * derivative vector is returned in dky. This vector must be * allocated by the caller. It is only legal to call this * function after a successful return from CVode. * * cvode_mem is the pointer to CVODE memory returned by * CVodeCreate. * * t is the time at which the kth derivative of y is evaluated. * The legal range for t is [tn-hu,tn] as described above. * * k is the order of the derivative of y to be computed. The * legal range for k is [0,qu] as described above. * * dky is the output derivative vector [((d/dy)^k)y](t). * * The return value for CVodeGetDky is one of: * * CV_SUCCESS: CVodeGetDky succeeded. * * CV_BAD_K: k is not in the range 0, 1, ..., qu. * * CV_BAD_T: t is not in the interval [tn-hu,tn]. * * CV_BAD_DKY: The dky argument was NULL. * * CV_MEM_NULL: The cvode_mem argument was NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); /* * ----------------------------------------------------------------- * Integrator optional output extraction functions * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the main integrator. * ----------------------------------------------------------------- * CVodeGetWorkSpace returns the CVODE real and integer workspaces * CVodeGetNumSteps returns the cumulative number of internal * steps taken by the solver * CVodeGetNumRhsEvals returns the number of calls to the user's * f function * CVodeGetNumLinSolvSetups returns the number of calls made to * the linear solver's setup routine * CVodeGetNumErrTestFails returns the number of local error test * failures that have occured * CVodeGetLastOrder returns the order used during the last * internal step * CVodeGetCurrentOrder returns the order to be used on the next * internal step * CVodeGetNumStabLimOrderReds returns the number of order * reductions due to stability limit * detection * CVodeGetActualInitStep returns the actual initial step size * used by CVODE * CVodeGetLastStep returns the step size for the last internal * step * CVodeGetCurrentStep returns the step size to be attempted on * the next internal step * CVodeGetCurrentTime returns the current internal time reached * by the solver * CVodeGetTolScaleFactor returns a suggested factor by which the * user's tolerances should be scaled when * too much accuracy has been requested for * some internal step * CVodeGetErrWeights returns the current error weight vector. * The user must allocate space for eweight. * CVodeGetEstLocalErrors returns the vector of estimated local * errors. The user must allocate space * for ele. * CVodeGetNumGEvals returns the number of calls to the user's * g function (for rootfinding) * CVodeGetRootInfo returns the indices for which g_i was found to * have a root. The user must allocate space for * rootsfound. For i = 0 ... nrtfn-1, * rootsfound[i] = 1 if g_i has a root, and = 0 if not. * * CVodeGet* return values: * CV_SUCCESS if succesful * CV_MEM_NULL if the cvode memory was NULL * CV_NO_SLDET if stability limit was not turned on * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); SUNDIALS_EXPORT int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); SUNDIALS_EXPORT int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); SUNDIALS_EXPORT int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); SUNDIALS_EXPORT int CVodeGetLastOrder(void *cvode_mem, int *qlast); SUNDIALS_EXPORT int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); SUNDIALS_EXPORT int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); SUNDIALS_EXPORT int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); SUNDIALS_EXPORT int CVodeGetLastStep(void *cvode_mem, realtype *hlast); SUNDIALS_EXPORT int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); SUNDIALS_EXPORT int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); SUNDIALS_EXPORT int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); SUNDIALS_EXPORT int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight); SUNDIALS_EXPORT int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele); SUNDIALS_EXPORT int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); SUNDIALS_EXPORT int CVodeGetRootInfo(void *cvode_mem, int *rootsfound); /* * ----------------------------------------------------------------- * As a convenience, the following functions provides the * optional outputs in one group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); /* * ----------------------------------------------------------------- * Nonlinear solver optional output extraction functions * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the nonlinear solver. * ----------------------------------------------------------------- * CVodeGetNumNonlinSolvIters returns the number of nonlinear * solver iterations performed. * CVodeGetNumNonlinSolvConvFails returns the number of nonlinear * convergence failures. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); SUNDIALS_EXPORT int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * nonlinear solver optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, long int *nncfails); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVODE return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVodeGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * Function : CVodeFree * ----------------------------------------------------------------- * CVodeFree frees the problem memory cvode_mem allocated by * CVodeCreate and CVodeInit. Its only argument is the pointer * cvode_mem returned by CVodeCreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeFree(void **cvode_mem); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_spgmr.h0000600000175000017500000000460611741421121021416 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE scaled preconditioned GMRES * linear solver, CVSPGMR. * ----------------------------------------------------------------- */ #ifndef _CVSPGMR_H #define _CVSPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : CVSpgmr * ----------------------------------------------------------------- * A call to the CVSpgmr function links the main CVODE integrator * with the CVSPGMR linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined * in sundials_iterative.h. * These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPGMR solver. Pass 0 to * use the default value CVSPGMR_MAXL=5. * * The return value of CVSpgmr is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvode_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpgmr(void *cvode_mem, int pretype, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_bandpre.h0000600000175000017500000001214511741421121021676 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVBANDPRE module, which * provides a banded difference quotient Jacobian-based * preconditioner and solver routines for use with CVSPGMR, * CVSPBCG, or CVSPTFQMR. * * Summary: * These routines provide a band matrix preconditioner based on * difference quotients of the ODE right-hand side function f. * The user supplies parameters * mu = upper half-bandwidth (number of super-diagonals) * ml = lower half-bandwidth (number of sub-diagonals) * The routines generate a band matrix of bandwidth ml + mu + 1 * and use this to form a preconditioner for use with the Krylov * linear solver in CVSP*. Although this matrix is intended to * approximate the Jacobian df/dy, it may be a very crude * approximation. The true Jacobian need not be banded, or its * true bandwith may be larger than ml + mu + 1, as long as the * banded approximation generated here is sufficiently accurate * to speed convergence as a preconditioner. * * Usage: * The following is a summary of the usage of this module. * Details of the calls to CVodeCreate, CVodeMalloc, CVSp*, * and CVode are available in the User Guide. * To use these routines, the sequence of calls in the user * main program should be as follows: * * #include * #include * ... * Set y0 * ... * cvode_mem = CVodeCreate(...); * ier = CVodeMalloc(...); * ... * flag = CVSptfqmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpgmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpbcg(cvode_mem, pretype, maxl); * ... * flag = CVBandPrecInit(cvode_mem, N, mu, ml); * ... * flag = CVode(...); * ... * Free y0 * ... * CVodeFree(&cvode_mem); * * Notes: * (1) Include this file for the CVBandPrecData type definition. * (2) In the CVBandPrecAlloc call, the arguments N is the * problem dimension. * (3) In the CVBPSp* call, the user is free to specify * the input pretype and the optional input maxl. * ----------------------------------------------------------------- */ #ifndef _CVBANDPRE_H #define _CVBANDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Function : CVBandPrecInit * ----------------------------------------------------------------- * CVBandPrecInit allocates and initializes the BANDPRE preconditioner * module. This functino must be called AFTER one of the SPILS linear * solver modules has been attached to the CVODE integrator. * * The parameters of CVBandPrecInit are as follows: * * cvode_mem is the pointer to CVODE memory returned by CVodeCreate. * * N is the problem size. * * mu is the upper half bandwidth. * * ml is the lower half bandwidth. * * The return value of CVBandPrecInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_ILL_INPUT if an input has an illegal value * CVSPILS_MEM_FAIL if a memory allocation request failed * * NOTE: The band preconditioner assumes a serial implementation * of the NVECTOR package. Therefore, CVBandPrecInit will * first test for a compatible N_Vector internal * representation by checking for required functions. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandPrecInit(void *cvode_mem, long int N, long int mu, long int ml); /* * ----------------------------------------------------------------- * Optional output functions : CVBandPrecGet* * ----------------------------------------------------------------- * CVBandPrecGetWorkSpace returns the real and integer work space used * by CVBANDPRE. * CVBandPrecGetNumRhsEvals returns the number of calls made from * CVBANDPRE to the user's right-hand side * routine f. * * The return value of CVBandPrecGet* is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_bbdpre.h0000600000175000017500000002536611741421121021532 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Michael Wittman, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVBBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with CVSPGMR/CVSPBCG/CVSPTFQMR, * and the parallel implementation of the NVECTOR module. * * Summary: * * These routines provide a preconditioner matrix that is * block-diagonal with banded blocks. The blocking corresponds * to the distribution of the dependent variable vector y among * the processors. Each preconditioner block is generated from * the Jacobian of the local part (on the current processor) of a * given function g(t,y) approximating f(t,y). The blocks are * generated by a difference quotient scheme on each processor * independently. This scheme utilizes an assumed banded * structure with given half-bandwidths, mudq and mldq. * However, the banded Jacobian block kept by the scheme has * half-bandwiths mukeep and mlkeep, which may be smaller. * * The user's calling program should have the following form: * * #include * #include * ... * void *cvode_mem; * ... * Set y0 * ... * cvode_mem = CVodeCreate(...); * ier = CVodeMalloc(...); * ... * flag = CVSpgmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpbcg(cvode_mem, pretype, maxl); * -or- * flag = CVSptfqmr(cvode_mem, pretype, maxl); * ... * flag = CVBBDPrecInit(cvode_mem, Nlocal, mudq ,mldq, * mukeep, mlkeep, dqrely, gloc, cfn); * ... * ier = CVode(...); * ... * CVodeFree(&cvode_mem); * * Free y0 * * The user-supplied routines required are: * * f = function defining the ODE right-hand side f(t,y). * * gloc = function defining the approximation g(t,y). * * cfn = function to perform communication need for gloc. * * Notes: * * 1) This header file is included by the user for the definition * of the CVBBDData type and for needed function prototypes. * * 2) The CVBBDPrecInit call includes half-bandwiths mudq and mldq * to be used in the difference quotient calculation of the * approximate Jacobian. They need not be the true * half-bandwidths of the Jacobian of the local block of g, * when smaller values may provide a greater efficiency. * Also, the half-bandwidths mukeep and mlkeep of the retained * banded approximate Jacobian block may be even smaller, * to reduce storage and computation costs further. * For all four half-bandwidths, the values need not be the * same on every processor. * * 3) The actual name of the user's f function is passed to * CVodeInit, and the names of the user's gloc and cfn * functions are passed to CVBBDPrecInit. * * 4) The pointer to the user-defined data block user_data, which is * set through CVodeSetUserData is also available to the user in * gloc and cfn. * * 5) Optional outputs specific to this module are available by * way of routines listed below. These include work space sizes * and the cumulative number of gloc calls. The costs * associated with this module also include nsetups banded LU * factorizations, nlinsetups cfn calls, and npsolves banded * backsolve calls, where nlinsetups and npsolves are * integrator/CVSPGMR/CVSPBCG/CVSPTFQMR optional outputs. * ----------------------------------------------------------------- */ #ifndef _CVBBDPRE_H #define _CVBBDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Type : CVLocalFn * ----------------------------------------------------------------- * The user must supply a function g(t,y) which approximates the * right-hand side function f for the system y'=f(t,y), and which * is computed locally (without interprocess communication). * (The case where g is mathematically identical to f is allowed.) * The implementation of this function must have type CVLocalFn. * * This function takes as input the local vector size Nlocal, the * independent variable value t, the local real dependent * variable vector y, and a pointer to the user-defined data * block user_data. It is to compute the local part of g(t,y) and * store this in the vector g. * (Allocation of memory for y and g is handled within the * preconditioner module.) * The user_data parameter is the same as that specified by the user * through the CVodeSetFdata routine. * * A CVLocalFn should return 0 if successful, a positive value if * a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVLocalFn)(long int Nlocal, realtype t, N_Vector y, N_Vector g, void *user_data); /* * ----------------------------------------------------------------- * Type : CVCommFn * ----------------------------------------------------------------- * The user may supply a function of type CVCommFn which performs * all interprocess communication necessary to evaluate the * approximate right-hand side function described above. * * This function takes as input the local vector size Nlocal, * the independent variable value t, the dependent variable * vector y, and a pointer to the user-defined data block user_data. * The user_data parameter is the same as that specified by the user * through the CVodeSetUserData routine. The CVCommFn cfn is * expected to save communicated data in space defined within the * structure user_data. Note: A CVCommFn cfn does not have a return value. * * Each call to the CVCommFn cfn is preceded by a call to the * CVRhsFn f with the same (t,y) arguments. Thus cfn can omit any * communications done by f if relevant to the evaluation of g. * If all necessary communication was done by f, the user can * pass NULL for cfn in CVBBDPrecInit (see below). * * A CVCommFn should return 0 if successful, a positive value if * a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVCommFn)(long int Nlocal, realtype t, N_Vector y, void *user_data); /* * ----------------------------------------------------------------- * Function : CVBBDPrecInit * ----------------------------------------------------------------- * CVBBDPrecInit allocates and initializes the BBD preconditioner. * * The parameters of CVBBDPrecInit are as follows: * * cvode_mem is the pointer to the integrator memory. * * Nlocal is the length of the local block of the vectors y etc. * on the current processor. * * mudq, mldq are the upper and lower half-bandwidths to be used * in the difference quotient computation of the local * Jacobian block. * * mukeep, mlkeep are the upper and lower half-bandwidths of the * retained banded approximation to the local Jacobian * block. * * dqrely is an optional input. It is the relative increment * in components of y used in the difference quotient * approximations. To specify the default, pass 0. * The default is dqrely = sqrt(unit roundoff). * * gloc is the name of the user-supplied function g(t,y) that * approximates f and whose local Jacobian blocks are * to form the preconditioner. * * cfn is the name of the user-defined function that performs * necessary interprocess communication for the * execution of gloc. * * The return value of CVBBDPrecInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_ILL_INPUT if an input has an illegal value * CVSPILS_MEM_FAIL if a memory allocation request failed * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecInit(void *cvode_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn); /* * ----------------------------------------------------------------- * Function : CVBBDPrecReInit * ----------------------------------------------------------------- * CVBBDPrecReInit re-initializes the BBDPRE module when solving a * sequence of problems of the same size with CVSPGMR/CVBBDPRE or * CVSPBCG/CVBBDPRE or CVSPTFQMR/CVBBDPRE provided there is no change * in Nlocal, mukeep, or mlkeep. After solving one problem, and after * calling CVodeReInit to re-initialize the integrator for a subsequent * problem, call CVBBDPrecReInit. * * All arguments have the same names and meanings as those * of CVBBDPrecInit. * * The return value of CVBBDPrecReInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecReInit(void *cvode_mem, long int mudq, long int mldq, realtype dqrely); /* * ----------------------------------------------------------------- * BBDPRE optional output extraction routines * ----------------------------------------------------------------- * CVBBDPrecGetWorkSpace returns the BBDPRE real and integer work space * sizes. * CVBBDPrecGetNumGfnEvals returns the number of calls to gfn. * * The return value of CVBBDPrecGet* is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_direct.h0000600000175000017500000002552411741421121021542 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common header file for the direct linear solvers in CVODE. * ----------------------------------------------------------------- */ #ifndef _CVDLS_H #define _CVDLS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * C V D I R E C T C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * CVDLS return values * ----------------------------------------------------------------- */ #define CVDLS_SUCCESS 0 #define CVDLS_MEM_NULL -1 #define CVDLS_LMEM_NULL -2 #define CVDLS_ILL_INPUT -3 #define CVDLS_MEM_FAIL -4 /* Additional last_flag values */ #define CVDLS_JACFUNC_UNRECVR -5 #define CVDLS_JACFUNC_RECVR -6 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ----------------------------------------------------------------- * Type: CVDlsDenseJacFn * ----------------------------------------------------------------- * * A dense Jacobian approximation function Jac must be of type * CVDlsDenseJacFn. Its parameters are: * * N is the problem size. * * Jac is the dense matrix (of type DlsMat) that will be loaded * by a CVDlsDenseJacFn with an approximation to the Jacobian * matrix J = (df_i/dy_j) at the point (t,y). * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * user_data is a pointer to user data - the same as the user_data * parameter passed to CVodeSetFdata. * * tmp1, tmp2, and tmp3 are pointers to memory allocated for * vectors of length N which can be used by a CVDlsDenseJacFn * as temporary storage or work space. * * A CVDlsDenseJacFn should return 0 if successful, a positive * value if a recoverable error occurred, and a negative value if * an unrecoverable error occurred. * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load a dense Jac: * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = DENSE_COL(Jac,j); * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * (2) (without macros - explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = (Jac->data)[j]; * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * A third way, using the DENSE_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively * (see cvode.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h. * * ----------------------------------------------------------------- */ typedef int (*CVDlsDenseJacFn)(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type: CVDlsBandJacFn * ----------------------------------------------------------------- * * A band Jacobian approximation function Jac must have the * prototype given below. Its parameters are: * * N is the length of all vector arguments. * * mupper is the upper half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mupper parameter * passed by the user to the linear solver initialization function. * * mlower is the lower half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mlower parameter * passed by the user to the linear solver initialization function. * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * Jac is the band matrix (of type DlsMat) that will be loaded * by a CVDlsBandJacFn with an approximation to the Jacobian matrix * Jac = (df_i/dy_j) at the point (t,y). * Three efficient ways to load J are: * * (1) (with macros - no explicit data structure references) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (i=j-mupper; i <= j+mlower; i++) { * generate J_ij = the (i,j)th Jacobian element * BAND_COL_ELEM(col_j,i,j) = J_ij; * } * } * * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * * (3) (without macros - explicit data structure references) * offset = Jac->smu; * for (j=0; j < n; j++) { * col_j = ((Jac->data)[j])+offset; * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * Caution: Jac->smu is generally NOT the same as mupper. * * The BAND_ELEM(A,i,j) macro is appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * user_data is a pointer to user data - the same as the user_data * parameter passed to CVodeSetFdata. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively * (see cvode.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * tmp1, tmp2, and tmp3 are pointers to memory allocated for * vectors of length N which can be used by a CVDlsBandJacFn * as temporary storage or work space. * * A CVDlsBandJacFn should return 0 if successful, a positive value * if a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVDlsBandJacFn)(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Optional inputs to the CVDLS linear solver * ----------------------------------------------------------------- * * CVDlsSetDenseJacFn specifies the dense Jacobian approximation * routine to be used for a direct dense linear solver. * * CVDlsSetBandJacFn specifies the band Jacobian approximation * routine to be used for a direct band linear solver. * * By default, a difference quotient approximation, supplied with * the solver is used. * * The return value is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODE memory was NULL * CVDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac); SUNDIALS_EXPORT int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac); /* * ----------------------------------------------------------------- * Optional outputs from the CVDLS linear solver * ----------------------------------------------------------------- * * CVDlsGetWorkSpace returns the real and integer workspace used * by the direct linear solver. * CVDlsGetNumJacEvals returns the number of calls made to the * Jacobian evaluation routine jac. * CVDlsGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * CVDlsGetLastFlag returns the last error flag set by any of * the CVDLS interface functions. * * The return value of CVDlsGet* is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODE memory was NULL * CVDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals); SUNDIALS_EXPORT int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVDlsGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVDLS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVDlsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_sptfqmr.h0000600000175000017500000000451511741421121021761 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE scaled preconditioned TFQMR * linear solver, CVSPTFQMR. * ----------------------------------------------------------------- */ #ifndef _CVSPTFQMR_H #define _CVSPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : CVSptfqmr * ----------------------------------------------------------------- * A call to the CVSptfqmr function links the main CVODE integrator * with the CVSPTFQMR linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined * in iterative.h. These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPTFQMR solver. Pass 0 to * use the default value CVSPILS_MAXL=5. * * The return value of CVSptfqmr is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvode_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSptfqmr(void *cvode_mem, int pretype, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_spbcgs.h0000600000175000017500000000447611741421121021554 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE scaled preconditioned * Bi-CGSTAB linear solver, CVSPBCG. * ----------------------------------------------------------------- */ #ifndef _CVSPBCG_H #define _CVSPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : CVSpbcg * ----------------------------------------------------------------- * A call to the CVSpbcg function links the main CVODE integrator * with the CVSPBCG linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined * in iterative.h. These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPBCG solver. Pass 0 to * use the default value CVSPBCG_MAXL=5. * * The return value of CVSpbcg is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvode_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpbcg(void *cvode_mem, int pretype, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_spils.h0000600000175000017500000003600011741421121021411 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the common header file for the Scaled, Preconditioned * Iterative Linear Solvers in CVODE. * ----------------------------------------------------------------- */ #ifndef _CVSPILS_H #define _CVSPILS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * CVSPILS return values * ----------------------------------------------------------------- */ #define CVSPILS_SUCCESS 0 #define CVSPILS_MEM_NULL -1 #define CVSPILS_LMEM_NULL -2 #define CVSPILS_ILL_INPUT -3 #define CVSPILS_MEM_FAIL -4 #define CVSPILS_PMEM_NULL -5 /* * ----------------------------------------------------------------- * CVSPILS solver constants * ----------------------------------------------------------------- * CVSPILS_MAXL : default value for the maximum Krylov * dimension * * CVSPILS_MSBPRE : maximum number of steps between * preconditioner evaluations * * CVSPILS_DGMAX : maximum change in gamma between * preconditioner evaluations * * CVSPILS_EPLIN : default value for factor by which the * tolerance on the nonlinear iteration is * multiplied to get a tolerance on the linear * iteration * ----------------------------------------------------------------- */ #define CVSPILS_MAXL 5 #define CVSPILS_MSBPRE 50 #define CVSPILS_DGMAX RCONST(0.2) #define CVSPILS_EPLIN RCONST(0.05) /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSetupFn * ----------------------------------------------------------------- * The user-supplied preconditioner setup function PrecSetup and * the user-supplied preconditioner solve function PrecSolve * together must define left and right preconditoner matrices * P1 and P2 (either of which may be trivial), such that the * product P1*P2 is an approximation to the Newton matrix * M = I - gamma*J. Here J is the system Jacobian J = df/dy, * and gamma is a scalar proportional to the integration step * size h. The solution of systems P z = r, with P = P1 or P2, * is to be carried out by the PrecSolve function, and PrecSetup * is to do any necessary setup operations. * * The user-supplied preconditioner setup function PrecSetup * is to evaluate and preprocess any Jacobian-related data * needed by the preconditioner solve function PrecSolve. * This might include forming a crude approximate Jacobian, * and performing an LU factorization on the resulting * approximation to M. This function will not be called in * advance of every call to PrecSolve, but instead will be called * only as often as necessary to achieve convergence within the * Newton iteration. If the PrecSolve function needs no * preparation, the PrecSetup function can be NULL. * * For greater efficiency, the PrecSetup function may save * Jacobian-related data and reuse it, rather than generating it * from scratch. In this case, it should use the input flag jok * to decide whether to recompute the data, and set the output * flag *jcurPtr accordingly. * * Each call to the PrecSetup function is preceded by a call to * the RhsFn f with the same (t,y) arguments. Thus the PrecSetup * function can use any auxiliary data that is computed and * saved by the f function and made accessible to PrecSetup. * * A function PrecSetup must have the prototype given below. * Its parameters are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data, if saved from * the previous PrecSetup call, can be reused * (with the current value of gamma). * A Precset call with jok == TRUE can only occur after * a call with jok == FALSE. * * jcurPtr is a pointer to an output integer flag which is * to be set by PrecSetup as follows: * Set *jcurPtr = TRUE if Jacobian data was recomputed. * Set *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * user_data is a pointer to user data - the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for N_Vectors which can be used by * CVSpilsPrecSetupFn as temporary storage or * work space. * * NOTE: If the user's preconditioner needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively). * The unit roundoff is available as UNIT_ROUNDOFF defined in * sundials_types.h. * * Returned value: * The value to be returned by the PrecSetup function is a flag * indicating whether it was successful. This value should be * 0 if successful, * > 0 for a recoverable error (step will be retried), * < 0 for an unrecoverable error (integration is halted). * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSolveFn * ----------------------------------------------------------------- * The user-supplied preconditioner solve function PrecSolve * is to solve a linear system P z = r in which the matrix P is * one of the preconditioner matrices P1 or P2, depending on the * type of preconditioning chosen. * * A function PrecSolve must have the prototype given below. * Its parameters are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector. * * fy is the vector f(t,y). * * r is the right-hand side vector of the linear system. * * z is the output vector computed by PrecSolve. * * gamma is the scalar appearing in the Newton matrix. * * delta is an input tolerance for use by PSolve if it uses * an iterative method in its solution. In that case, * the residual vector Res = r - P z of the system * should be made less than delta in weighted L2 norm, * i.e., sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta. * Note: the error weight vector ewt can be obtained * through a call to the routine CVodeGetErrWeights. * * lr is an input flag indicating whether PrecSolve is to use * the left preconditioner P1 or right preconditioner * P2: lr = 1 means use P1, and lr = 2 means use P2. * * user_data is a pointer to user data - the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp is a pointer to memory allocated for an N_Vector * which can be used by PSolve for work space. * * Returned value: * The value to be returned by the PrecSolve function is a flag * indicating whether it was successful. This value should be * 0 if successful, * positive for a recoverable error (step will be retried), * negative for an unrecoverable error (integration is halted). * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Type : CVSpilsJacTimesVecFn * ----------------------------------------------------------------- * The user-supplied function jtimes is to generate the product * J*v for given v, where J is the Jacobian df/dy, or an * approximation to it, and v is a given vector. It should return * 0 if successful a positive value for a recoverable error or * a negative value for an unrecoverable failure. * * A function jtimes must have the prototype given below. Its * parameters are as follows: * * v is the N_Vector to be multiplied by J. * * Jv is the output N_Vector containing J*v. * * t is the current value of the independent variable. * * y is the current value of the dependent variable * vector. * * fy is the vector f(t,y). * * user_data is a pointer to user data, the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp is a pointer to memory allocated for an N_Vector * which can be used by Jtimes for work space. * ----------------------------------------------------------------- */ typedef int (*CVSpilsJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Optional inputs to the CVSPILS linear solver * ----------------------------------------------------------------- * * CVSpilsSetPrecType resets the type of preconditioner, pretype, * from the value previously set. * This must be one of PREC_NONE, PREC_LEFT, * PREC_RIGHT, or PREC_BOTH. * * CVSpilsSetGSType specifies the type of Gram-Schmidt * orthogonalization to be used. This must be one of * the two enumeration constants MODIFIED_GS or * CLASSICAL_GS defined in iterative.h. These correspond * to using modified Gram-Schmidt and classical * Gram-Schmidt, respectively. * Default value is MODIFIED_GS. * * CVSpilsSetMaxl resets the maximum Krylov subspace size, maxl, * from the value previously set. * An input value <= 0, gives the default value. * * CVSpilsSetEpsLin specifies the factor by which the tolerance on * the nonlinear iteration is multiplied to get a * tolerance on the linear iteration. * Default value is 0.05. * * CVSpilsSetPreconditioner specifies the PrecSetup and PrecSolve functions. * Default is NULL for both arguments (no preconditioning) * * CVSpilsSetJacTimesVecFn specifies the jtimes function. Default is to * use an internal finite difference approximation routine. * * The return value of CVSpilsSet* is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_LMEM_NULL if the linear solver memory was NULL * CVSPILS_ILL_INPUT if an input has an illegal value * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpilsSetPrecType(void *cvode_mem, int pretype); SUNDIALS_EXPORT int CVSpilsSetGSType(void *cvode_mem, int gstype); SUNDIALS_EXPORT int CVSpilsSetMaxl(void *cvode_mem, int maxl); SUNDIALS_EXPORT int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac); SUNDIALS_EXPORT int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve); SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFn(void *cvode_mem, CVSpilsJacTimesVecFn jtv); /* * ----------------------------------------------------------------- * Optional outputs from the CVSPILS linear solver * ----------------------------------------------------------------- * CVSpilsGetWorkSpace returns the real and integer workspace used * by the SPILS module. * * CVSpilsGetNumPrecEvals returns the number of preconditioner * evaluations, i.e. the number of calls made * to PrecSetup with jok==FALSE. * * CVSpilsGetNumPrecSolves returns the number of calls made to * PrecSolve. * * CVSpilsGetNumLinIters returns the number of linear iterations. * * CVSpilsGetNumConvFails returns the number of linear * convergence failures. * * CVSpilsGetNumJtimesEvals returns the number of calls to jtimes. * * CVSpilsGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * times vector evaluation. * * CVSpilsGetLastFlag returns the last error flag set by any of * the CVSPILS interface functions. * * The return value of CVSpilsGet* is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals); SUNDIALS_EXPORT int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves); SUNDIALS_EXPORT int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters); SUNDIALS_EXPORT int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails); SUNDIALS_EXPORT int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals); SUNDIALS_EXPORT int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVSpilsGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVSPILS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVSpilsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_lapack.h0000600000175000017500000000570611741421121021523 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the CVODE dense linear solver CVLAPACK. * ----------------------------------------------------------------- */ #ifndef _CVLAPACK_H #define _CVLAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Function : CVLapackDense * ----------------------------------------------------------------- * A call to the CVLapackDense function links the main integrator * with the CVLAPACK linear solver using dense Jacobians. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * The return value of CVLapackDense is one of: * CVLAPACK_SUCCESS if successful * CVLAPACK_MEM_NULL if the CVODE memory was NULL * CVLAPACK_MEM_FAIL if there was a memory allocation failure * CVLAPACK_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackDense(void *cvode_mem, int N); /* * ----------------------------------------------------------------- * Function : CVLapackBand * ----------------------------------------------------------------- * A call to the CVLapackBand function links the main integrator * with the CVLAPACK linear solver using banded Jacobians. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian approximation. * * mlower is the lower bandwidth of the band Jacobian approximation. * * The return value of CVLapackBand is one of: * CVLAPACK_SUCCESS if successful * CVLAPACK_MEM_NULL if the CVODE memory was NULL * CVLAPACK_MEM_FAIL if there was a memory allocation failure * CVLAPACK_ILL_INPUT if a required vector operation is missing or * if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvode/cvode_diag.h0000600000175000017500000000735111741421121021172 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 22:10:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODE diagonal linear solver, CVDIAG. * ----------------------------------------------------------------- */ #ifndef _CVDIAG_H #define _CVDIAG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Function : CVDiag * ----------------------------------------------------------------- * A call to the CVDiag function links the main integrator with * the CVDIAG linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * The return value of CVDiag is one of: * CVDIAG_SUCCESS if successful * CVDIAG_MEM_NULL if the cvode memory was NULL * CVDIAG_MEM_FAIL if there was a memory allocation failure * CVDIAG_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDiag(void *cvode_mem); /* * ----------------------------------------------------------------- * Optional outputs from the CVDIAG linear solver * ----------------------------------------------------------------- * * CVDiagGetWorkSpace returns the real and integer workspace used * by CVDIAG. * CVDiagGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * Note: The number of diagonal approximate * Jacobians formed is equal to the number of * CVDiagSetup calls. This number is available * through CVodeGetNumLinSolvSetups. * CVDiagGetLastFlag returns the last error flag set by any of * the CVDIAG interface functions. * * The return value of CVDiagGet* is one of: * CVDIAG_SUCCESS if successful * CVDIAG_MEM_NULL if the cvode memory was NULL * CVDIAG_LMEM_NULL if the cvdiag memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVDiagGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVDIAG return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVDiagGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * CVDIAG return values * ----------------------------------------------------------------- */ #define CVDIAG_SUCCESS 0 #define CVDIAG_MEM_NULL -1 #define CVDIAG_LMEM_NULL -2 #define CVDIAG_ILL_INPUT -3 #define CVDIAG_MEM_FAIL -4 /* Additional last_flag values */ #define CVDIAG_INV_FAIL -5 #define CVDIAG_RHSFUNC_UNRECVR -6 #define CVDIAG_RHSFUNC_RECVR -7 #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/0000755000175000017500000000000011767174700017501 5ustar sylvestresylvestresundials-2.5.0/include/sundials/sundials_dense.h0000600000175000017500000001727111741421110022630 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:17:18 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for a generic package of DENSE matrix * operations, based on the DlsMat type defined in sundials_direct.h. * * There are two sets of dense solver routines listed in * this file: one set uses type DlsMat defined below and the * other set uses the type realtype ** for dense matrix arguments. * Routines that work with the type DlsMat begin with "Dense". * Routines that work with realtype** begin with "dense". * ----------------------------------------------------------------- */ #ifndef _SUNDIALS_DENSE_H #define _SUNDIALS_DENSE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Functions: DenseGETRF and DenseGETRS * ----------------------------------------------------------------- * DenseGETRF performs the LU factorization of the M by N dense * matrix A. This is done using standard Gaussian elimination * with partial (row) pivoting. Note that this applies only * to matrices with M >= N and full column rank. * * A successful LU factorization leaves the matrix A and the * pivot array p with the following information: * * (1) p[k] contains the row number of the pivot element chosen * at the beginning of elimination step k, k=0, 1, ..., N-1. * * (2) If the unique LU factorization of A is given by PA = LU, * where P is a permutation matrix, L is a lower trapezoidal * matrix with all 1's on the diagonal, and U is an upper * triangular matrix, then the upper triangular part of A * (including its diagonal) contains U and the strictly lower * trapezoidal part of A contains the multipliers, I-L. * * For square matrices (M=N), L is unit lower triangular. * * DenseGETRF returns 0 if successful. Otherwise it encountered * a zero diagonal element during the factorization. In this case * it returns the column index (numbered from one) at which * it encountered the zero. * * DenseGETRS solves the N-dimensional system A x = b using * the LU factorization in A and the pivot information in p * computed in DenseGETRF. The solution x is returned in b. This * routine cannot fail if the corresponding call to DenseGETRF * did not fail. * DenseGETRS does NOT check for a square matrix! * * ----------------------------------------------------------------- * DenseGETRF and DenseGETRS are simply wrappers around denseGETRF * and denseGETRS, respectively, which perform all the work by * directly accessing the data in the DlsMat A (i.e. the field cols) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT long int DenseGETRF(DlsMat A, long int *p); SUNDIALS_EXPORT void DenseGETRS(DlsMat A, long int *p, realtype *b); SUNDIALS_EXPORT long int denseGETRF(realtype **a, long int m, long int n, long int *p); SUNDIALS_EXPORT void denseGETRS(realtype **a, long int n, long int *p, realtype *b); /* * ----------------------------------------------------------------- * Functions : DensePOTRF and DensePOTRS * ----------------------------------------------------------------- * DensePOTRF computes the Cholesky factorization of a real symmetric * positive definite matrix A. * ----------------------------------------------------------------- * DensePOTRS solves a system of linear equations A*X = B with a * symmetric positive definite matrix A using the Cholesky factorization * A = L*L**T computed by DensePOTRF. * * ----------------------------------------------------------------- * DensePOTRF and DensePOTRS are simply wrappers around densePOTRF * and densePOTRS, respectively, which perform all the work by * directly accessing the data in the DlsMat A (i.e. the field cols) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT long int DensePOTRF(DlsMat A); SUNDIALS_EXPORT void DensePOTRS(DlsMat A, realtype *b); SUNDIALS_EXPORT long int densePOTRF(realtype **a, long int m); SUNDIALS_EXPORT void densePOTRS(realtype **a, long int m, realtype *b); /* * ----------------------------------------------------------------- * Functions : DenseGEQRF and DenseORMQR * ----------------------------------------------------------------- * DenseGEQRF computes a QR factorization of a real M-by-N matrix A: * A = Q * R (with M>= N). * * DenseGEQRF requires a temporary work vector wrk of length M. * ----------------------------------------------------------------- * DenseORMQR computes the product w = Q * v where Q is a real * orthogonal matrix defined as the product of k elementary reflectors * * Q = H(1) H(2) . . . H(k) * * as returned by DenseGEQRF. Q is an M-by-N matrix, v is a vector * of length N and w is a vector of length M (with M>=N). * * DenseORMQR requires a temporary work vector wrk of length M. * * ----------------------------------------------------------------- * DenseGEQRF and DenseORMQR are simply wrappers around denseGEQRF * and denseORMQR, respectively, which perform all the work by * directly accessing the data in the DlsMat A (i.e. the field cols) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk); SUNDIALS_EXPORT int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk); SUNDIALS_EXPORT int denseGEQRF(realtype **a, long int m, long int n, realtype *beta, realtype *v); SUNDIALS_EXPORT int denseORMQR(realtype **a, long int m, long int n, realtype *beta, realtype *v, realtype *w, realtype *wrk); /* * ----------------------------------------------------------------- * Function : DenseCopy * ----------------------------------------------------------------- * DenseCopy copies the contents of the M-by-N matrix A into the * M-by-N matrix B. * * DenseCopy is a wrapper around denseCopy which accesses the data * in the DlsMat A and B (i.e. the fields cols) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void DenseCopy(DlsMat A, DlsMat B); SUNDIALS_EXPORT void denseCopy(realtype **a, realtype **b, long int m, long int n); /* * ----------------------------------------------------------------- * Function: DenseScale * ----------------------------------------------------------------- * DenseScale scales the elements of the M-by-N matrix A by the * constant c and stores the result back in A. * * DenseScale is a wrapper around denseScale which performs the actual * scaling by accessing the data in the DlsMat A (i.e. the field * cols). * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void DenseScale(realtype c, DlsMat A); SUNDIALS_EXPORT void denseScale(realtype c, realtype **a, long int m, long int n); /* * ----------------------------------------------------------------- * Function: denseAddIdentity * ----------------------------------------------------------------- * denseAddIdentity adds the identity matrix to the n-by-n matrix * stored in the realtype** arrays. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void denseAddIdentity(realtype **a, long int n); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_types.h0000600000175000017500000000721611741421110022674 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. *------------------------------------------------------------------ * This header file exports two types: realtype and booleantype, * as well as the constants TRUE and FALSE. * * Users should include the header file sundials_types.h in every * program file and use the exported name realtype instead of * float, double or long double. * * The constants SUNDIALS_SINGLE_PRECISION, SUNDIALS_DOUBLE_PRECISION * and SUNDIALS_LONG_DOUBLE_PRECISION indicate the underlying data * type of realtype. It is set at the configuration stage. * * The legal types for realtype are float, double and long double. * * The macro RCONST gives the user a convenient way to define * real-valued constants. To use the constant 1.0, for example, * the user should write the following: * * #define ONE RCONST(1.0) * * If realtype is defined as a double, then RCONST(1.0) expands * to 1.0. If realtype is defined as a float, then RCONST(1.0) * expands to 1.0F. If realtype is defined as a long double, * then RCONST(1.0) expands to 1.0L. There is never a need to * explicitly cast 1.0 to (realtype). *------------------------------------------------------------------ */ #ifndef _SUNDIALSTYPES_H #define _SUNDIALSTYPES_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #ifndef _SUNDIALS_CONFIG_H #define _SUNDIALS_CONFIG_H #include #endif #include /* *------------------------------------------------------------------ * Type realtype * Macro RCONST * Constants BIG_REAL, SMALL_REAL, and UNIT_ROUNDOFF *------------------------------------------------------------------ */ #if defined(SUNDIALS_SINGLE_PRECISION) typedef float realtype; # define RCONST(x) x##F # define BIG_REAL FLT_MAX # define SMALL_REAL FLT_MIN # define UNIT_ROUNDOFF FLT_EPSILON #elif defined(SUNDIALS_DOUBLE_PRECISION) typedef double realtype; # define RCONST(x) x # define BIG_REAL DBL_MAX # define SMALL_REAL DBL_MIN # define UNIT_ROUNDOFF DBL_EPSILON #elif defined(SUNDIALS_EXTENDED_PRECISION) typedef long double realtype; # define RCONST(x) x##L # define BIG_REAL LDBL_MAX # define SMALL_REAL LDBL_MIN # define UNIT_ROUNDOFF LDBL_EPSILON #endif /* *------------------------------------------------------------------ * Type : booleantype *------------------------------------------------------------------ * Constants : FALSE and TRUE *------------------------------------------------------------------ * ANSI C does not have a built-in boolean data type. Below is the * definition for a new type called booleantype. The advantage of * using the name booleantype (instead of int) is an increase in * code readability. It also allows the programmer to make a * distinction between int and boolean data. Variables of type * booleantype are intended to have only the two values FALSE and * TRUE which are defined below to be equal to 0 and 1, * respectively. *------------------------------------------------------------------ */ #ifndef booleantype #define booleantype int #endif #ifndef FALSE #define FALSE 0 #endif #ifndef TRUE #define TRUE 1 #endif #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_sptfqmr.h0000600000175000017500000002400611741421110023220 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2011/06/23 00:17:51 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the implementation of the scaled * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) * linear solver. * * The SPTFQMR algorithm solves a linear system of the form Ax = b. * Preconditioning is allowed on the left (PREC_LEFT), right * (PREC_RIGHT), or both (PREC_BOTH). Scaling is allowed on both * sides. We denote the preconditioner and scaling matrices as * follows: * P1 = left preconditioner * P2 = right preconditioner * S1 = diagonal matrix of scale factors for P1-inverse b * S2 = diagonal matrix of scale factors for P2 x * The matrices A, P1, and P2 are not required explicitly; only * routines that provide A, P1-inverse, and P2-inverse as operators * are required. * * In this notation, SPTFQMR applies the underlying TFQMR method to * the equivalent transformed system: * Abar xbar = bbar, where * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse), * bbar = S1 (P1-inverse) b, and * xbar = S2 P2 x. * * The scaling matrices must be chosen so that vectors * S1 P1-inverse b and S2 P2 x have dimensionless components. If * preconditioning is done on the left only (P2 = I), by a matrix P, * then S2 must be a scaling for x, while S1 is a scaling for * P-inverse b, and so may also be taken as a scaling for x. * Similarly, if preconditioning is done on the right only (P1 = I, * P2 = P), then S1 must be a scaling for b, while S2 is a scaling * for P x, and may also be taken as a scaling for b. * * The stopping test for the SPTFQMR iterations is on the L2-norm of * the scaled preconditioned residual: * || bbar - Abar xbar ||_2 < delta * with an input test constant delta. * * The usage of this SPTFQMR solver involves supplying two routines * and making three calls. The user-supplied routines are: * atimes(A_data, x, y) to compute y = A x, given x, * and * psolve(P_data, y, x, lr) to solve P1 x = y or P2 x = y for x, * given y. * The three user calls are: * mem = SptfqmrMalloc(lmax, vec_tmpl); * to initialize memory * flag = SptfqmrSolve(mem, A_data, x, b, pretype, delta, P_data, * sx, sb, atimes, psolve, res_norm, nli, nps); * to solve the system, and * SptfqmrFree(mem); * to free the memory allocated by SptfqmrMalloc(). * Complete details for specifying atimes() and psolve() and for the * usage calls are given in the paragraphs below and in the header * file sundials_iterative.h. * ----------------------------------------------------------------- */ #ifndef _SPTFQMR_H #define _SPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: struct SptfqmrMemRec and struct *SptfqmrMem * ----------------------------------------------------------------- * A variable declaration of type struct *SptfqmrMem denotes a pointer * to a data structure of type struct SptfqmrMemRec. The SptfqmrMemRec * structure contains numerous fields that must be accessed by the * SPTFQMR linear solver module. * * l_max maximum Krylov subspace dimension that SptfqmrSolve will * be permitted to use * * r_star vector (type N_Vector) which holds the initial scaled, * preconditioned linear system residual * * q/d/v/p/u/r vectors (type N_Vector) used for workspace by * the SPTFQMR algorithm * * vtemp1/vtemp2/vtemp3 scratch vectors (type N_Vector) used as * temporary storage * ----------------------------------------------------------------- */ typedef struct { int l_max; N_Vector r_star; N_Vector q; N_Vector d; N_Vector v; N_Vector p; N_Vector *r; N_Vector u; N_Vector vtemp1; N_Vector vtemp2; N_Vector vtemp3; } SptfqmrMemRec, *SptfqmrMem; /* * ----------------------------------------------------------------- * Function : SptfqmrMalloc * ----------------------------------------------------------------- * SptfqmrMalloc allocates additional memory needed by the SPTFQMR * linear solver module. * * l_max maximum Krylov subspace dimension that SptfqmrSolve will * be permitted to use * * vec_tmpl implementation-specific template vector (type N_Vector) * (created using either N_VNew_Serial or N_VNew_Parallel) * * If successful, SptfqmrMalloc returns a non-NULL memory pointer. If * an error occurs, then a NULL pointer is returned. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl); /* * ----------------------------------------------------------------- * Function : SptfqmrSolve * ----------------------------------------------------------------- * SptfqmrSolve solves the linear system Ax = b by means of a scaled * preconditioned Transpose-Free Quasi-Minimal Residual (SPTFQMR) * method. * * mem pointer to an internal memory block allocated during a * prior call to SptfqmrMalloc * * A_data pointer to a data structure containing information * about the coefficient matrix A (passed to user-supplied * function referenced by atimes (function pointer)) * * x vector (type N_Vector) containing initial guess x_0 upon * entry, but which upon return contains an approximate solution * of the linear system Ax = b (solution only valid if return * value is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED) * * b vector (type N_Vector) set to the right-hand side vector b * of the linear system (undisturbed by function) * * pretype variable (type int) indicating the type of * preconditioning to be used (see sundials_iterative.h) * * delta tolerance on the L2 norm of the scaled, preconditioned * residual (if return value == SPTFQMR_SUCCESS, then * ||sb*P1_inv*(b-Ax)||_L2 <= delta) * * P_data pointer to a data structure containing preconditioner * information (passed to user-supplied function referenced * by psolve (function pointer)) * * sx vector (type N_Vector) containing positive scaling factors * for x (pass sx == NULL if scaling NOT required) * * sb vector (type N_Vector) containing positive scaling factors * for b (pass sb == NULL if scaling NOT required) * * atimes user-supplied routine responsible for computing the * matrix-vector product Ax (see sundials_iterative.h) * * psolve user-supplied routine responsible for solving the * preconditioned linear system Pz = r (ignored if * pretype == PREC_NONE) (see sundials_iterative.h) * * res_norm pointer (type realtype*) to the L2 norm of the * scaled, preconditioned residual (if return value * is either SPTFQMR_SUCCESS or SPTFQMR_RES_REDUCED, then * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is * the computed approximate solution, sb is the diagonal * scaling matrix for the right-hand side b, and P1_inv * is the inverse of the left-preconditioner matrix) * * nli pointer (type int*) to the total number of linear * iterations performed * * nps pointer (type int*) to the total number of calls made * to the psolve routine * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps); /* Return values for SptfqmrSolve */ #define SPTFQMR_SUCCESS 0 /* SPTFQMR algorithm converged */ #define SPTFQMR_RES_REDUCED 1 /* SPTFQMR did NOT converge, but the residual was reduced */ #define SPTFQMR_CONV_FAIL 2 /* SPTFQMR algorithm failed to converge */ #define SPTFQMR_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ #define SPTFQMR_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ #define SPTFQMR_PSET_FAIL_REC 5 /* pset faild recoverably */ #define SPTFQMR_MEM_NULL -1 /* mem argument is NULL */ #define SPTFQMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ #define SPTFQMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ #define SPTFQMR_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ /* * ----------------------------------------------------------------- * Function : SptfqmrFree * ----------------------------------------------------------------- * SptfqmrFree frees the memory allocated by a call to SptfqmrMalloc. * It is illegal to use the pointer mem after a call to SptfqmrFree. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void SptfqmrFree(SptfqmrMem mem); /* * ----------------------------------------------------------------- * Macro : SPTFQMR_VTEMP * ----------------------------------------------------------------- * This macro provides access to the work vector vtemp1 in the * memory block of the SPTFQMR module. The argument mem is the * memory pointer returned by SptfqmrMalloc, of type SptfqmrMem, * and the macro value is of type N_Vector. * * Note: Only used by IDA (vtemp1 contains P_inverse F if * nli_inc == 0). * ----------------------------------------------------------------- */ #define SPTFQMR_VTEMP(mem) (mem->vtemp1) #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_iterative.h0000600000175000017500000003150711741421110023524 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This header file contains declarations intended for use by * generic iterative solvers of Ax = b. The enumeration gives * symbolic names for the type of preconditioning to be used. * The function type declarations give the prototypes for the * functions to be called within an iterative linear solver, that * are responsible for * multiplying A by a given vector v (ATimesFn), and * solving the preconditioner equation Pz = r (PSolveFn). * ----------------------------------------------------------------- */ #ifndef _ITERATIVE_H #define _ITERATIVE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * enum : types of preconditioning * ----------------------------------------------------------------- * PREC_NONE : The iterative linear solver should not use * preconditioning. * * PREC_LEFT : The iterative linear solver uses preconditioning on * the left only. * * PREC_RIGHT : The iterative linear solver uses preconditioning on * the right only. * * PREC_BOTH : The iterative linear solver uses preconditioning on * both the left and the right. * ----------------------------------------------------------------- */ enum { PREC_NONE, PREC_LEFT, PREC_RIGHT, PREC_BOTH }; /* * ----------------------------------------------------------------- * enum : types of Gram-Schmidt routines * ----------------------------------------------------------------- * MODIFIED_GS : The iterative solver uses the modified * Gram-Schmidt routine ModifiedGS listed in this * file. * * CLASSICAL_GS : The iterative solver uses the classical * Gram-Schmidt routine ClassicalGS listed in this * file. * ----------------------------------------------------------------- */ enum { MODIFIED_GS = 1, CLASSICAL_GS = 2 }; /* * ----------------------------------------------------------------- * Type: ATimesFn * ----------------------------------------------------------------- * An ATimesFn multiplies Av and stores the result in z. The * caller is responsible for allocating memory for the z vector. * The parameter A_data is a pointer to any information about A * which the function needs in order to do its job. The vector v * is unchanged. An ATimesFn returns 0 if successful and a * non-zero value if unsuccessful. * ----------------------------------------------------------------- */ typedef int (*ATimesFn)(void *A_data, N_Vector v, N_Vector z); /* * ----------------------------------------------------------------- * Type: PSolveFn * ----------------------------------------------------------------- * A PSolveFn solves the preconditioner equation Pz = r for the * vector z. The caller is responsible for allocating memory for * the z vector. The parameter P_data is a pointer to any * information about P which the function needs in order to do * its job. The parameter lr is input, and indicates whether P * is to be taken as the left preconditioner or the right * preconditioner: lr = 1 for left and lr = 2 for right. * If preconditioning is on one side only, lr can be ignored. * The vector r is unchanged. * A PSolveFn returns 0 if successful and a non-zero value if * unsuccessful. On a failure, a negative return value indicates * an unrecoverable condition, while a positive value indicates * a recoverable one, in which the calling routine may reattempt * the solution after updating preconditioner data. * ----------------------------------------------------------------- */ typedef int (*PSolveFn)(void *P_data, N_Vector r, N_Vector z, int lr); /* * ----------------------------------------------------------------- * Function: ModifiedGS * ----------------------------------------------------------------- * ModifiedGS performs a modified Gram-Schmidt orthogonalization * of the N_Vector v[k] against the p unit N_Vectors at * v[k-1], v[k-2], ..., v[k-p]. * * v is an array of (k+1) N_Vectors v[i], i=0, 1, ..., k. * v[k-1], v[k-2], ..., v[k-p] are assumed to have L2-norm * equal to 1. * * h is the output k by k Hessenberg matrix of inner products. * This matrix must be allocated row-wise so that the (i,j)th * entry is h[i][j]. The inner products (v[i],v[k]), * i=i0, i0+1, ..., k-1, are stored at h[i][k-1]. Here * i0=MAX(0,k-p). * * k is the index of the vector in the v array that needs to be * orthogonalized against previous vectors in the v array. * * p is the number of previous vectors in the v array against * which v[k] is to be orthogonalized. * * new_vk_norm is a pointer to memory allocated by the caller to * hold the Euclidean norm of the orthogonalized vector v[k]. * * If (k-p) < 0, then ModifiedGS uses p=k. The orthogonalized * v[k] is NOT normalized and is stored over the old v[k]. Once * the orthogonalization has been performed, the Euclidean norm * of v[k] is stored in (*new_vk_norm). * * ModifiedGS returns 0 to indicate success. It cannot fail. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int ModifiedGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm); /* * ----------------------------------------------------------------- * Function: ClassicalGS * ----------------------------------------------------------------- * ClassicalGS performs a classical Gram-Schmidt * orthogonalization of the N_Vector v[k] against the p unit * N_Vectors at v[k-1], v[k-2], ..., v[k-p]. The parameters v, h, * k, p, and new_vk_norm are as described in the documentation * for ModifiedGS. * * temp is an N_Vector which can be used as workspace by the * ClassicalGS routine. * * s is a length k array of realtype which can be used as * workspace by the ClassicalGS routine. * * ClassicalGS returns 0 to indicate success. It cannot fail. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int ClassicalGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm, N_Vector temp, realtype *s); /* * ----------------------------------------------------------------- * Function: QRfact * ----------------------------------------------------------------- * QRfact performs a QR factorization of the Hessenberg matrix H. * * n is the problem size; the matrix H is (n+1) by n. * * h is the (n+1) by n Hessenberg matrix H to be factored. It is * stored row-wise. * * q is an array of length 2*n containing the Givens rotations * computed by this function. A Givens rotation has the form: * | c -s | * | s c |. * The components of the Givens rotations are stored in q as * (c, s, c, s, ..., c, s). * * job is a control flag. If job==0, then a new QR factorization * is performed. If job!=0, then it is assumed that the first * n-1 columns of h have already been factored and only the last * column needs to be updated. * * QRfact returns 0 if successful. If a zero is encountered on * the diagonal of the triangular factor R, then QRfact returns * the equation number of the zero entry, where the equations are * numbered from 1, not 0. If QRsol is subsequently called in * this situation, it will return an error because it could not * divide by the zero diagonal entry. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int QRfact(int n, realtype **h, realtype *q, int job); /* * ----------------------------------------------------------------- * Function: QRsol * ----------------------------------------------------------------- * QRsol solves the linear least squares problem * * min (b - H*x, b - H*x), x in R^n, * * where H is a Hessenberg matrix, and b is in R^(n+1). * It uses the QR factors of H computed by QRfact. * * n is the problem size; the matrix H is (n+1) by n. * * h is a matrix (computed by QRfact) containing the upper * triangular factor R of the original Hessenberg matrix H. * * q is an array of length 2*n (computed by QRfact) containing * the Givens rotations used to factor H. * * b is the (n+1)-vector appearing in the least squares problem * above. * * On return, b contains the solution x of the least squares * problem, if QRsol was successful. * * QRsol returns a 0 if successful. Otherwise, a zero was * encountered on the diagonal of the triangular factor R. * In this case, QRsol returns the equation number (numbered * from 1, not 0) of the zero entry. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int QRsol(int n, realtype **h, realtype *q, realtype *b); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_fnvector.h0000600000175000017500000000215111741421110023347 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:27:52 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file (companion of nvector.h) contains definitions * needed for the initialization of vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_H #define _FNVECTOR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #ifndef _SUNDIALS_CONFIG_H #define _SUNDIALS_CONFIG_H #include #endif /* SUNDIALS solver IDs */ #define FCMIX_CVODE 1 #define FCMIX_IDA 2 #define FCMIX_KINSOL 3 #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_spbcgs.h0000600000175000017500000001707411741421110023014 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Peter Brown and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the implementation of the scaled, * preconditioned Bi-CGSTAB (SPBCG) iterative linear solver. * ----------------------------------------------------------------- */ #ifndef _SPBCG_H #define _SPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: struct SpbcgMemRec and struct *SpbcgMem * ----------------------------------------------------------------- * A variable declaration of type struct *SpbcgMem denotes a pointer * to a data structure of type struct SpbcgMemRec. The SpbcgMemRec * structure contains numerous fields that must be accessed by the * SPBCG linear solver module. * * l_max maximum Krylov subspace dimension that SpbcgSolve will * be permitted to use * * r vector (type N_Vector) which holds the scaled, preconditioned * linear system residual * * r_star vector (type N_Vector) which holds the initial scaled, * preconditioned linear system residual * * p, q, u and Ap vectors (type N_Vector) used for workspace by * the SPBCG algorithm * * vtemp scratch vector (type N_Vector) used as temporary vector * storage * ----------------------------------------------------------------- */ typedef struct { int l_max; N_Vector r_star; N_Vector r; N_Vector p; N_Vector q; N_Vector u; N_Vector Ap; N_Vector vtemp; } SpbcgMemRec, *SpbcgMem; /* * ----------------------------------------------------------------- * Function : SpbcgMalloc * ----------------------------------------------------------------- * SpbcgMalloc allocates additional memory needed by the SPBCG * linear solver module. * * l_max maximum Krylov subspace dimension that SpbcgSolve will * be permitted to use * * vec_tmpl implementation-specific template vector (type N_Vector) * (created using either N_VNew_Serial or N_VNew_Parallel) * * If successful, SpbcgMalloc returns a non-NULL memory pointer. If * an error occurs, then a NULL pointer is returned. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl); /* * ----------------------------------------------------------------- * Function : SpbcgSolve * ----------------------------------------------------------------- * SpbcgSolve solves the linear system Ax = b by means of a scaled * preconditioned Bi-CGSTAB (SPBCG) iterative method. * * mem pointer to an internal memory block allocated during a * prior call to SpbcgMalloc * * A_data pointer to a data structure containing information * about the coefficient matrix A (passed to user-supplied * function referenced by atimes (function pointer)) * * x vector (type N_Vector) containing initial guess x_0 upon * entry, but which upon return contains an approximate solution * of the linear system Ax = b (solution only valid if return * value is either SPBCG_SUCCESS or SPBCG_RES_REDUCED) * * b vector (type N_Vector) set to the right-hand side vector b * of the linear system (undisturbed by function) * * pretype variable (type int) indicating the type of * preconditioning to be used (see sundials_iterative.h) * * delta tolerance on the L2 norm of the scaled, preconditioned * residual (if return value == SPBCG_SUCCESS, then * ||sb*P1_inv*(b-Ax)||_L2 <= delta) * * P_data pointer to a data structure containing preconditioner * information (passed to user-supplied function referenced * by psolve (function pointer)) * * sx vector (type N_Vector) containing positive scaling factors * for x (pass sx == NULL if scaling NOT required) * * sb vector (type N_Vector) containing positive scaling factors * for b (pass sb == NULL if scaling NOT required) * * atimes user-supplied routine responsible for computing the * matrix-vector product Ax (see sundials_iterative.h) * * psolve user-supplied routine responsible for solving the * preconditioned linear system Pz = r (ignored if * pretype == PREC_NONE) (see sundials_iterative.h) * * res_norm pointer (type realtype*) to the L2 norm of the * scaled, preconditioned residual (if return value * is either SPBCG_SUCCESS or SPBCG_RES_REDUCED, then * *res_norm = ||sb*P1_inv*(b-Ax)||_L2, where x is * the computed approximate solution, sb is the diagonal * scaling matrix for the right-hand side b, and P1_inv * is the inverse of the left-preconditioner matrix) * * nli pointer (type int*) to the total number of linear * iterations performed * * nps pointer (type int*) to the total number of calls made * to the psolve routine * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps); /* Return values for SpbcgSolve */ #define SPBCG_SUCCESS 0 /* SPBCG algorithm converged */ #define SPBCG_RES_REDUCED 1 /* SPBCG did NOT converge, but the residual was reduced */ #define SPBCG_CONV_FAIL 2 /* SPBCG algorithm failed to converge */ #define SPBCG_PSOLVE_FAIL_REC 3 /* psolve failed recoverably */ #define SPBCG_ATIMES_FAIL_REC 4 /* atimes failed recoverably */ #define SPBCG_PSET_FAIL_REC 5 /* pset faild recoverably */ #define SPBCG_MEM_NULL -1 /* mem argument is NULL */ #define SPBCG_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ #define SPBCG_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ #define SPBCG_PSET_FAIL_UNREC -4 /* pset failed unrecoverably */ /* * ----------------------------------------------------------------- * Function : SpbcgFree * ----------------------------------------------------------------- * SpbcgFree frees the memory allocated by a call to SpbcgMalloc. * It is illegal to use the pointer mem after a call to SpbcgFree. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void SpbcgFree(SpbcgMem mem); /* * ----------------------------------------------------------------- * Macro : SPBCG_VTEMP * ----------------------------------------------------------------- * This macro provides access to the vector r in the * memory block of the SPBCG module. The argument mem is the * memory pointer returned by SpbcgMalloc, of type SpbcgMem, * and the macro value is of type N_Vector. * * Note: Only used by IDA (r contains P_inverse F if nli_inc == 0). * ----------------------------------------------------------------- */ #define SPBCG_VTEMP(mem) (mem->r) #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_lapack.h0000600000175000017500000001123311741421110022755 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2009/02/17 02:39:26 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for a generic package of direct matrix * operations for use with BLAS/LAPACK. * ----------------------------------------------------------------- */ #ifndef _SUNDIALS_LAPACK_H #define _SUNDIALS_LAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ================================================================== * Blas and Lapack functions * ================================================================== */ #if defined(SUNDIALS_F77_FUNC) #define dcopy_f77 SUNDIALS_F77_FUNC(dcopy, DCOPY) #define dscal_f77 SUNDIALS_F77_FUNC(dscal, DSCAL) #define dgemv_f77 SUNDIALS_F77_FUNC(dgemv, DGEMV) #define dtrsv_f77 SUNDIALS_F77_FUNC(dtrsv, DTRSV) #define dsyrk_f77 SUNDIALS_F77_FUNC(dsyrk, DSKYR) #define dgbtrf_f77 SUNDIALS_F77_FUNC(dgbtrf, DGBTRF) #define dgbtrs_f77 SUNDIALS_F77_FUNC(dgbtrs, DGBTRS) #define dgetrf_f77 SUNDIALS_F77_FUNC(dgetrf, DGETRF) #define dgetrs_f77 SUNDIALS_F77_FUNC(dgetrs, DGETRS) #define dgeqp3_f77 SUNDIALS_F77_FUNC(dgeqp3, DGEQP3) #define dgeqrf_f77 SUNDIALS_F77_FUNC(dgeqrf, DGEQRF) #define dormqr_f77 SUNDIALS_F77_FUNC(dormqr, DORMQR) #define dpotrf_f77 SUNDIALS_F77_FUNC(dpotrf, DPOTRF) #define dpotrs_f77 SUNDIALS_F77_FUNC(dpotrs, DPOTRS) #else #define dcopy_f77 dcopy_ #define dscal_f77 dscal_ #define dgemv_f77 dgemv_ #define dtrsv_f77 dtrsv_ #define dsyrk_f77 dsyrk_ #define dgbtrf_f77 dgbtrf_ #define dgbtrs_f77 dgbtrs_ #define dgeqp3_f77 dgeqp3_ #define dgeqrf_f77 dgeqrf_ #define dgetrf_f77 dgetrf_ #define dgetrs_f77 dgetrs_ #define dormqr_f77 dormqr_ #define dpotrf_f77 dpotrf_ #define dpotrs_f77 dpotrs_ #endif /* Level-1 BLAS */ extern void dcopy_f77(int *n, const double *x, const int *inc_x, double *y, const int *inc_y); extern void dscal_f77(int *n, const double *alpha, double *x, const int *inc_x); /* Level-2 BLAS */ extern void dgemv_f77(const char *trans, int *m, int *n, const double *alpha, const double *a, int *lda, const double *x, int *inc_x, const double *beta, double *y, int *inc_y, int len_trans); extern void dtrsv_f77(const char *uplo, const char *trans, const char *diag, const int *n, const double *a, const int *lda, double *x, const int *inc_x, int len_uplo, int len_trans, int len_diag); /* Level-3 BLAS */ extern void dsyrk_f77(const char *uplo, const char *trans, const int *n, const int *k, const double *alpha, const double *a, const int *lda, const double *beta, const double *c, const int *ldc, int len_uplo, int len_trans); /* LAPACK */ extern void dgbtrf_f77(const int *m, const int *n, const int *kl, const int *ku, double *ab, int *ldab, int *ipiv, int *info); extern void dgbtrs_f77(const char *trans, const int *n, const int *kl, const int *ku, const int *nrhs, double *ab, const int *ldab, int *ipiv, double *b, const int *ldb, int *info, int len_trans); extern void dgeqp3_f77(const int *m, const int *n, double *a, const int *lda, int *jpvt, double *tau, double *work, const int *lwork, int *info); extern void dgeqrf_f77(const int *m, const int *n, double *a, const int *lda, double *tau, double *work, const int *lwork, int *info); extern void dgetrf_f77(const int *m, const int *n, double *a, int *lda, int *ipiv, int *info); extern void dgetrs_f77(const char *trans, const int *n, const int *nrhs, double *a, const int *lda, int *ipiv, double *b, const int *ldb, int *info, int len_trans); extern void dormqr_f77(const char *side, const char *trans, const int *m, const int *n, const int *k, double *a, const int *lda, double *tau, double *c, const int *ldc, double *work, const int *lwork, int *info, int len_side, int len_trans); extern void dpotrf_f77(const char *uplo, const int *n, double *a, int *lda, int *info, int len_uplo); extern void dpotrs_f77(const char *uplo, const int *n, const int *nrhs, double *a, const int *lda, double *b, const int *ldb, int * info, int len_uplo); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_band.h0000600000175000017500000001461311741421110022433 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:17:18 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for a generic BAND linear solver * package, based on the DlsMat type defined in sundials_direct.h. * * There are two sets of band solver routines listed in * this file: one set uses type DlsMat defined below and the * other set uses the type realtype ** for band matrix arguments. * Routines that work with the type DlsMat begin with "Band". * Routines that work with realtype ** begin with "band" * ----------------------------------------------------------------- */ #ifndef _SUNDIALS_BAND_H #define _SUNDIALS_BAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Function : BandGBTRF * ----------------------------------------------------------------- * Usage : ier = BandGBTRF(A, p); * if (ier != 0) ... A is singular * ----------------------------------------------------------------- * BandGBTRF performs the LU factorization of the N by N band * matrix A. This is done using standard Gaussian elimination * with partial pivoting. * * A successful LU factorization leaves the "matrix" A and the * pivot array p with the following information: * * (1) p[k] contains the row number of the pivot element chosen * at the beginning of elimination step k, k=0, 1, ..., N-1. * * (2) If the unique LU factorization of A is given by PA = LU, * where P is a permutation matrix, L is a lower triangular * matrix with all 1's on the diagonal, and U is an upper * triangular matrix, then the upper triangular part of A * (including its diagonal) contains U and the strictly lower * triangular part of A contains the multipliers, I-L. * * BandGBTRF returns 0 if successful. Otherwise it encountered * a zero diagonal element during the factorization. In this case * it returns the column index (numbered from one) at which * it encountered the zero. * * Important Note: A must be allocated to accommodate the increase * in upper bandwidth that occurs during factorization. If * mathematically, A is a band matrix with upper bandwidth mu and * lower bandwidth ml, then the upper triangular factor U can * have upper bandwidth as big as smu = MIN(n-1,mu+ml). The lower * triangular factor L has lower bandwidth ml. Allocate A with * call A = BandAllocMat(N,mu,ml,smu), where mu, ml, and smu are * as defined above. The user does not have to zero the "extra" * storage allocated for the purpose of factorization. This will * handled by the BandGBTRF routine. * * BandGBTRF is only a wrapper around bandGBTRF. All work is done * in bandGBTRF works directly on the data in the DlsMat A (i.e., * the field cols). * ----------------------------------------------------------------- */ SUNDIALS_EXPORT long int BandGBTRF(DlsMat A, long int *p); SUNDIALS_EXPORT long int bandGBTRF(realtype **a, long int n, long int mu, long int ml, long int smu, long int *p); /* * ----------------------------------------------------------------- * Function : BandGBTRS * ----------------------------------------------------------------- * Usage : BandGBTRS(A, p, b); * ----------------------------------------------------------------- * BandGBTRS solves the N-dimensional system A x = b using * the LU factorization in A and the pivot information in p * computed in BandGBTRF. The solution x is returned in b. This * routine cannot fail if the corresponding call to BandGBTRF * did not fail. * * BandGBTRS is only a wrapper around bandGBTRS which does all the * work directly on the data in the DlsMat A (i.e., the field cols). * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void BandGBTRS(DlsMat A, long int *p, realtype *b); SUNDIALS_EXPORT void bandGBTRS(realtype **a, long int n, long int smu, long int ml, long int *p, realtype *b); /* * ----------------------------------------------------------------- * Function : BandCopy * ----------------------------------------------------------------- * Usage : BandCopy(A, B, copymu, copyml); * ----------------------------------------------------------------- * BandCopy copies the submatrix with upper and lower bandwidths * copymu, copyml of the N by N band matrix A into the N by N * band matrix B. * * BandCopy is a wrapper around bandCopy which accesses the data * in the DlsMat A and B (i.e. the fields cols) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void BandCopy(DlsMat A, DlsMat B, long int copymu, long int copyml); SUNDIALS_EXPORT void bandCopy(realtype **a, realtype **b, long int n, long int a_smu, long int b_smu, long int copymu, long int copyml); /* * ----------------------------------------------------------------- * Function: BandScale * ----------------------------------------------------------------- * Usage : BandScale(c, A); * ----------------------------------------------------------------- * A(i,j) <- c*A(i,j), j-(A->mu) <= i <= j+(A->ml). * * BandScale is a wrapper around bandScale which performs the actual * scaling by accessing the data in the DlsMat A (i.e. the field * cols). * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void BandScale(realtype c, DlsMat A); SUNDIALS_EXPORT void bandScale(realtype c, realtype **a, long int n, long int mu, long int ml, long int smu); /* * ----------------------------------------------------------------- * Function: bandAddIdentity * ----------------------------------------------------------------- * bandAddIdentity adds the identity matrix to the n-by-n matrix * stored in the realtype** arrays. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void bandAddIdentity(realtype **a, long int n, long int smu); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_spgmr.h0000600000175000017500000002770011741421110022660 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2011/06/23 00:17:51 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the implementation of SPGMR Krylov * iterative linear solver. The SPGMR algorithm is based on the * Scaled Preconditioned GMRES (Generalized Minimal Residual) * method. * * The SPGMR algorithm solves a linear system A x = b. * Preconditioning is allowed on the left, right, or both. * Scaling is allowed on both sides, and restarts are also allowed. * We denote the preconditioner and scaling matrices as follows: * P1 = left preconditioner * P2 = right preconditioner * S1 = diagonal matrix of scale factors for P1-inverse b * S2 = diagonal matrix of scale factors for P2 x * The matrices A, P1, and P2 are not required explicitly; only * routines that provide A, P1-inverse, and P2-inverse as * operators are required. * * In this notation, SPGMR applies the underlying GMRES method to * the equivalent transformed system * Abar xbar = bbar , where * Abar = S1 (P1-inverse) A (P2-inverse) (S2-inverse) , * bbar = S1 (P1-inverse) b , and xbar = S2 P2 x . * * The scaling matrices must be chosen so that vectors S1 * P1-inverse b and S2 P2 x have dimensionless components. * If preconditioning is done on the left only (P2 = I), by a * matrix P, then S2 must be a scaling for x, while S1 is a * scaling for P-inverse b, and so may also be taken as a scaling * for x. Similarly, if preconditioning is done on the right only * (P1 = I, P2 = P), then S1 must be a scaling for b, while S2 is * a scaling for P x, and may also be taken as a scaling for b. * * The stopping test for the SPGMR iterations is on the L2 norm of * the scaled preconditioned residual: * || bbar - Abar xbar ||_2 < delta * with an input test constant delta. * * The usage of this SPGMR solver involves supplying two routines * and making three calls. The user-supplied routines are * atimes (A_data, x, y) to compute y = A x, given x, * and * psolve (P_data, y, x, lr) * to solve P1 x = y or P2 x = y for x, given y. * The three user calls are: * mem = SpgmrMalloc(lmax, vec_tmpl); * to initialize memory, * flag = SpgmrSolve(mem,A_data,x,b,..., * P_data,s1,s2,atimes,psolve,...); * to solve the system, and * SpgmrFree(mem); * to free the memory created by SpgmrMalloc. * Complete details for specifying atimes and psolve and for the * usage calls are given below and in sundials_iterative.h. * ----------------------------------------------------------------- */ #ifndef _SPGMR_H #define _SPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: SpgmrMemRec, SpgmrMem * ----------------------------------------------------------------- * SpgmrMem is a pointer to an SpgmrMemRec which contains * the memory needed by SpgmrSolve. The SpgmrMalloc routine * returns a pointer of type SpgmrMem which should then be passed * in subsequent calls to SpgmrSolve. The SpgmrFree routine frees * the memory allocated by SpgmrMalloc. * * l_max is the maximum Krylov dimension that SpgmrSolve will be * permitted to use. * * V is the array of Krylov basis vectors v_1, ..., v_(l_max+1), * stored in V[0], ..., V[l_max], where l_max is the second * parameter to SpgmrMalloc. Each v_i is a vector of type * N_Vector. * * Hes is the (l_max+1) x l_max Hessenberg matrix. It is stored * row-wise so that the (i,j)th element is given by Hes[i][j]. * * givens is a length 2*l_max array which represents the * Givens rotation matrices that arise in the algorithm. The * Givens rotation matrices F_0, F_1, ..., F_j, where F_i is * * 1 * 1 * c_i -s_i <--- row i * s_i c_i * 1 * 1 * * are represented in the givens vector as * givens[0]=c_0, givens[1]=s_0, givens[2]=c_1, givens[3]=s_1, * ..., givens[2j]=c_j, givens[2j+1]=s_j. * * xcor is a vector (type N_Vector) which holds the scaled, * preconditioned correction to the initial guess. * * yg is a length (l_max+1) array of realtype used to hold "short" * vectors (e.g. y and g). * * vtemp is a vector (type N_Vector) used as temporary vector * storage during calculations. * ----------------------------------------------------------------- */ typedef struct _SpgmrMemRec { int l_max; N_Vector *V; realtype **Hes; realtype *givens; N_Vector xcor; realtype *yg; N_Vector vtemp; } SpgmrMemRec, *SpgmrMem; /* * ----------------------------------------------------------------- * Function : SpgmrMalloc * ----------------------------------------------------------------- * SpgmrMalloc allocates the memory used by SpgmrSolve. It * returns a pointer of type SpgmrMem which the user of the * SPGMR package should pass to SpgmrSolve. The parameter l_max * is the maximum Krylov dimension that SpgmrSolve will be * permitted to use. The parameter vec_tmpl is a pointer to an * N_Vector used as a template to create new vectors by duplication. * This routine returns NULL if there is a memory request failure. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl); /* * ----------------------------------------------------------------- * Function : SpgmrSolve * ----------------------------------------------------------------- * SpgmrSolve solves the linear system Ax = b using the SPGMR * method. The return values are given by the symbolic constants * below. The first SpgmrSolve parameter is a pointer to memory * allocated by a prior call to SpgmrMalloc. * * mem is the pointer returned by SpgmrMalloc to the structure * containing the memory needed by SpgmrSolve. * * A_data is a pointer to information about the coefficient * matrix A. This pointer is passed to the user-supplied function * atimes. * * x is the initial guess x_0 upon entry and the solution * N_Vector upon exit with return value SPGMR_SUCCESS or * SPGMR_RES_REDUCED. For all other return values, the output x * is undefined. * * b is the right hand side N_Vector. It is undisturbed by this * function. * * pretype is the type of preconditioning to be used. Its * legal values are enumerated in sundials_iterative.h. These * values are PREC_NONE=0, PREC_LEFT=1, PREC_RIGHT=2, and * PREC_BOTH=3. * * gstype is the type of Gram-Schmidt orthogonalization to be * used. Its legal values are enumerated in sundials_iterative.h. * These values are MODIFIED_GS=0 and CLASSICAL_GS=1. * * delta is the tolerance on the L2 norm of the scaled, * preconditioned residual. On return with value SPGMR_SUCCESS, * this residual satisfies || s1 P1_inv (b - Ax) ||_2 <= delta. * * max_restarts is the maximum number of times the algorithm is * allowed to restart. * * P_data is a pointer to preconditioner information. This * pointer is passed to the user-supplied function psolve. * * s1 is an N_Vector of positive scale factors for P1-inv b, where * P1 is the left preconditioner. (Not tested for positivity.) * Pass NULL if no scaling on P1-inv b is required. * * s2 is an N_Vector of positive scale factors for P2 x, where * P2 is the right preconditioner. (Not tested for positivity.) * Pass NULL if no scaling on P2 x is required. * * atimes is the user-supplied function which performs the * operation of multiplying A by a given vector. Its description * is given in sundials_iterative.h. * * psolve is the user-supplied function which solves a * preconditioner system Pz = r, where P is P1 or P2. Its full * description is given in sundials_iterative.h. The psolve function * will not be called if pretype is NONE; in that case, the user * should pass NULL for psolve. * * res_norm is a pointer to the L2 norm of the scaled, * preconditioned residual. On return with value SPGMR_SUCCESS or * SPGMR_RES_REDUCED, (*res_norm) contains the value * || s1 P1_inv (b - Ax) ||_2 for the computed solution x. * For all other return values, (*res_norm) is undefined. The * caller is responsible for allocating the memory (*res_norm) * to be filled in by SpgmrSolve. * * nli is a pointer to the number of linear iterations done in * the execution of SpgmrSolve. The caller is responsible for * allocating the memory (*nli) to be filled in by SpgmrSolve. * * nps is a pointer to the number of calls made to psolve during * the execution of SpgmrSolve. The caller is responsible for * allocating the memory (*nps) to be filled in by SpgmrSolve. * * Note: Repeated calls can be made to SpgmrSolve with varying * input arguments. If, however, the problem size N or the * maximum Krylov dimension l_max changes, then a call to * SpgmrMalloc must be made to obtain new memory for SpgmrSolve * to use. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, int gstype, realtype delta, int max_restarts, void *P_data, N_Vector s1, N_Vector s2, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps); /* Return values for SpgmrSolve */ #define SPGMR_SUCCESS 0 /* Converged */ #define SPGMR_RES_REDUCED 1 /* Did not converge, but reduced norm of residual */ #define SPGMR_CONV_FAIL 2 /* Failed to converge */ #define SPGMR_QRFACT_FAIL 3 /* QRfact found singular matrix */ #define SPGMR_PSOLVE_FAIL_REC 4 /* psolve failed recoverably */ #define SPGMR_ATIMES_FAIL_REC 5 /* atimes failed recoverably */ #define SPGMR_PSET_FAIL_REC 6 /* pset faild recoverably */ #define SPGMR_MEM_NULL -1 /* mem argument is NULL */ #define SPGMR_ATIMES_FAIL_UNREC -2 /* atimes returned failure flag */ #define SPGMR_PSOLVE_FAIL_UNREC -3 /* psolve failed unrecoverably */ #define SPGMR_GS_FAIL -4 /* Gram-Schmidt routine faiuled */ #define SPGMR_QRSOL_FAIL -5 /* QRsol found singular R */ #define SPGMR_PSET_FAIL_UNREC -6 /* pset failed unrecoverably */ /* * ----------------------------------------------------------------- * Function : SpgmrFree * ----------------------------------------------------------------- * SpgmrMalloc frees the memory allocated by SpgmrMalloc. It is * illegal to use the pointer mem after a call to SpgmrFree. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void SpgmrFree(SpgmrMem mem); /* * ----------------------------------------------------------------- * Macro: SPGMR_VTEMP * ----------------------------------------------------------------- * This macro provides access to the work vector vtemp in the * memory block of the SPGMR module. The argument mem is the * memory pointer returned by SpgmrMalloc, of type SpgmrMem, * and the macro value is of type N_Vector. * On a return from SpgmrSolve with *nli = 0, this vector * contains the scaled preconditioned initial residual, * s1 * P1_inverse * (b - A x_0). * ----------------------------------------------------------------- */ #define SPGMR_VTEMP(mem) (mem->vtemp) #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_direct.h0000600000175000017500000003161711741421110023004 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/22 22:18:49 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This header file contains definitions and declarations for use by * generic direct linear solvers for Ax = b. It defines types for * dense and banded matrices and corresponding accessor macros. * ----------------------------------------------------------------- */ #ifndef _SUNDIALS_DIRECT_H #define _SUNDIALS_DIRECT_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * C O N S T A N T S * ================================================================= */ /* * SUNDIALS_DENSE: dense matrix * SUNDIALS_BAND: banded matrix */ #define SUNDIALS_DENSE 1 #define SUNDIALS_BAND 2 /* * ================================================================== * Type definitions * ================================================================== */ /* * ----------------------------------------------------------------- * Type : DlsMat * ----------------------------------------------------------------- * The type DlsMat is defined to be a pointer to a structure * with various sizes, a data field, and an array of pointers to * the columns which defines a dense or band matrix for use in * direct linear solvers. The M and N fields indicates the number * of rows and columns, respectively. The data field is a one * dimensional array used for component storage. The cols field * stores the pointers in data for the beginning of each column. * ----------------------------------------------------------------- * For DENSE matrices, the relevant fields in DlsMat are: * type = SUNDIALS_DENSE * M - number of rows * N - number of columns * ldim - leading dimension (ldim >= M) * data - pointer to a contiguous block of realtype variables * ldata - length of the data array =ldim*N * cols - array of pointers. cols[j] points to the first element * of the j-th column of the matrix in the array data. * * The elements of a dense matrix are stored columnwise (i.e columns * are stored one on top of the other in memory). * If A is of type DlsMat, then the (i,j)th element of A (with * 0 <= i < M and 0 <= j < N) is given by (A->data)[j*n+i]. * * The DENSE_COL and DENSE_ELEM macros below allow a user to access * efficiently individual matrix elements without writing out explicit * data structure references and without knowing too much about the * underlying element storage. The only storage assumption needed is * that elements are stored columnwise and that a pointer to the * jth column of elements can be obtained via the DENSE_COL macro. * ----------------------------------------------------------------- * For BAND matrices, the relevant fields in DlsMat are: * type = SUNDIALS_BAND * M - number of rows * N - number of columns * mu - upper bandwidth, 0 <= mu <= min(M,N) * ml - lower bandwidth, 0 <= ml <= min(M,N) * s_mu - storage upper bandwidth, mu <= s_mu <= N-1. * The dgbtrf routine writes the LU factors into the storage * for A. The upper triangular factor U, however, may have * an upper bandwidth as big as MIN(N-1,mu+ml) because of * partial pivoting. The s_mu field holds the upper * bandwidth allocated for A. * ldim - leading dimension (ldim >= s_mu) * data - pointer to a contiguous block of realtype variables * ldata - length of the data array =ldim*(s_mu+ml+1) * cols - array of pointers. cols[j] points to the first element * of the j-th column of the matrix in the array data. * * The BAND_COL, BAND_COL_ELEM, and BAND_ELEM macros below allow a * user to access individual matrix elements without writing out * explicit data structure references and without knowing too much * about the underlying element storage. The only storage assumption * needed is that elements are stored columnwise and that a pointer * into the jth column of elements can be obtained via the BAND_COL * macro. The BAND_COL_ELEM macro selects an element from a column * which has already been isolated via BAND_COL. The macro * BAND_COL_ELEM allows the user to avoid the translation * from the matrix location (i,j) to the index in the array returned * by BAND_COL at which the (i,j)th element is stored. * ----------------------------------------------------------------- */ typedef struct _DlsMat { int type; long int M; long int N; long int ldim; long int mu; long int ml; long int s_mu; realtype *data; long int ldata; realtype **cols; } *DlsMat; /* * ================================================================== * Data accessor macros * ================================================================== */ /* * ----------------------------------------------------------------- * DENSE_COL and DENSE_ELEM * ----------------------------------------------------------------- * * DENSE_COL(A,j) references the jth column of the M-by-N dense * matrix A, 0 <= j < N. The type of the expression DENSE_COL(A,j) * is (realtype *). After the assignment in the usage above, col_j * may be treated as an array indexed from 0 to M-1. The (i,j)-th * element of A is thus referenced by col_j[i]. * * DENSE_ELEM(A,i,j) references the (i,j)th element of the dense * M-by-N matrix A, 0 <= i < M ; 0 <= j < N. * * ----------------------------------------------------------------- */ #define DENSE_COL(A,j) ((A->cols)[j]) #define DENSE_ELEM(A,i,j) ((A->cols)[j][i]) /* * ----------------------------------------------------------------- * BAND_COL, BAND_COL_ELEM, and BAND_ELEM * ----------------------------------------------------------------- * * BAND_COL(A,j) references the diagonal element of the jth column * of the N by N band matrix A, 0 <= j <= N-1. The type of the * expression BAND_COL(A,j) is realtype *. The pointer returned by * the call BAND_COL(A,j) can be treated as an array which is * indexed from -(A->mu) to (A->ml). * * BAND_COL_ELEM references the (i,j)th entry of the band matrix A * when used in conjunction with BAND_COL. The index (i,j) should * satisfy j-(A->mu) <= i <= j+(A->ml). * * BAND_ELEM(A,i,j) references the (i,j)th element of the M-by-N * band matrix A, where 0 <= i,j <= N-1. The location (i,j) should * further satisfy j-(A->mu) <= i <= j+(A->ml). * * ----------------------------------------------------------------- */ #define BAND_COL(A,j) (((A->cols)[j])+(A->s_mu)) #define BAND_COL_ELEM(col_j,i,j) (col_j[(i)-(j)]) #define BAND_ELEM(A,i,j) ((A->cols)[j][(i)-(j)+(A->s_mu)]) /* * ================================================================== * Exported function prototypes (functions working on dlsMat) * ================================================================== */ /* * ----------------------------------------------------------------- * Function: NewDenseMat * ----------------------------------------------------------------- * NewDenseMat allocates memory for an M-by-N dense matrix and * returns the storage allocated (type DlsMat). NewDenseMat * returns NULL if the request for matrix storage cannot be * satisfied. See the above documentation for the type DlsMat * for matrix storage details. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT DlsMat NewDenseMat(long int M, long int N); /* * ----------------------------------------------------------------- * Function: NewBandMat * ----------------------------------------------------------------- * NewBandMat allocates memory for an M-by-N band matrix * with upper bandwidth mu, lower bandwidth ml, and storage upper * bandwidth smu. Pass smu as follows depending on whether A will * be LU factored: * * (1) Pass smu = mu if A will not be factored. * * (2) Pass smu = MIN(N-1,mu+ml) if A will be factored. * * NewBandMat returns the storage allocated (type DlsMat) or * NULL if the request for matrix storage cannot be satisfied. * See the documentation for the type DlsMat for matrix storage * details. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT DlsMat NewBandMat(long int N, long int mu, long int ml, long int smu); /* * ----------------------------------------------------------------- * Functions: DestroyMat * ----------------------------------------------------------------- * DestroyMat frees the memory allocated by NewDenseMat or NewBandMat * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void DestroyMat(DlsMat A); /* * ----------------------------------------------------------------- * Function: NewIntArray * ----------------------------------------------------------------- * NewIntArray allocates memory an array of N int's and returns * the pointer to the memory it allocates. If the request for * memory storage cannot be satisfied, it returns NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int *NewIntArray(int N); /* * ----------------------------------------------------------------- * Function: NewLintArray * ----------------------------------------------------------------- * NewLintArray allocates memory an array of N long int's and returns * the pointer to the memory it allocates. If the request for * memory storage cannot be satisfied, it returns NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT long int *NewLintArray(long int N); /* * ----------------------------------------------------------------- * Function: NewRealArray * ----------------------------------------------------------------- * NewRealArray allocates memory an array of N realtype and returns * the pointer to the memory it allocates. If the request for * memory storage cannot be satisfied, it returns NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype *NewRealArray(long int N); /* * ----------------------------------------------------------------- * Function: DestroyArray * ----------------------------------------------------------------- * DestroyArray frees memory allocated by NewIntArray, NewLintArray, * or NewRealArray. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void DestroyArray(void *p); /* * ----------------------------------------------------------------- * Function : AddIdentity * ----------------------------------------------------------------- * AddIdentity adds 1.0 to the main diagonal (A_ii, i=1,2,...,N-1) of * the M-by-N matrix A (M>= N) and stores the result back in A. * AddIdentity is typically used with square matrices. * AddIdentity does not check for M >= N and therefore a segmentation * fault will occur if M < N! * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void AddIdentity(DlsMat A); /* * ----------------------------------------------------------------- * Function : SetToZero * ----------------------------------------------------------------- * SetToZero sets all the elements of the M-by-N matrix A to 0.0. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void SetToZero(DlsMat A); /* * ----------------------------------------------------------------- * Functions: PrintMat * ----------------------------------------------------------------- * This function prints the M-by-N (dense or band) matrix A to * standard output as it would normally appear on paper. * It is intended as debugging tools with small values of M and N. * The elements are printed using the %g/%lg/%Lg option. * A blank line is printed before and after the matrix. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void PrintMat(DlsMat A); /* * ================================================================== * Exported function prototypes (functions working on realtype**) * ================================================================== */ SUNDIALS_EXPORT realtype **newDenseMat(long int m, long int n); SUNDIALS_EXPORT realtype **newBandMat(long int n, long int smu, long int ml); SUNDIALS_EXPORT void destroyMat(realtype **a); SUNDIALS_EXPORT int *newIntArray(int n); SUNDIALS_EXPORT long int *newLintArray(long int n); SUNDIALS_EXPORT realtype *newRealArray(long int m); SUNDIALS_EXPORT void destroyArray(void *v); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_config.in0000600000175000017500000000526111741421110023152 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/15 22:45:17 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. *------------------------------------------------------------------ * SUNDIALS configuration header file *------------------------------------------------------------------ */ /* Define SUNDIALS version number */ #define SUNDIALS_PACKAGE_VERSION "@PACKAGE_VERSION@" /* FCMIX: Define Fortran name-mangling macro for C identifiers. * Depending on the inferred scheme, one of the following six * macros will be defined: * #define SUNDIALS_F77_FUNC(name,NAME) name * #define SUNDIALS_F77_FUNC(name,NAME) name ## _ * #define SUNDIALS_F77_FUNC(name,NAME) name ## __ * #define SUNDIALS_F77_FUNC(name,NAME) NAME * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## _ * #define SUNDIALS_F77_FUNC(name,NAME) NAME ## __ */ @F77_MANGLE_MACRO1@ /* FCMIX: Define Fortran name-mangling macro for C identifiers * which contain underscores. */ @F77_MANGLE_MACRO2@ /* Define precision of SUNDIALS data type 'realtype' * Depending on the precision level, one of the following * three macros will be defined: * #define SUNDIALS_SINGLE_PRECISION 1 * #define SUNDIALS_DOUBLE_PRECISION 1 * #define SUNDIALS_EXTENDED_PRECISION 1 */ @PRECISION_LEVEL@ /* Use generic math functions * If it was decided that generic math functions can be used, then * #define SUNDIALS_USE_GENERIC_MATH */ @GENERIC_MATH_LIB@ /* Blas/Lapack available * If working libraries for Blas/lapack support were found, then * #define SUNDIALS_BLAS_LAPACK 1 * otherwise * #define SUNDIALS_BLAS_LAPACK 0 */ @BLAS_LAPACK_MACRO@ /* FNVECTOR: Allow user to specify different MPI communicator * If it was found that the MPI implementation supports MPI_Comm_f2c, then * #define SUNDIALS_MPI_COMM_F2C 1 * otherwise * #define SUNDIALS_MPI_COMM_F2C 0 */ @F77_MPI_COMM_F2C@ /* Mark SUNDIALS API functions for export/import * When building shared SUNDIALS libraries under Windows, use * #define SUNDIALS_EXPORT __declspec(dllexport) * When linking to shared SUNDIALS libraries under Windows, use * #define SUNDIALS_EXPORT __declspec(dllimport) * In all other cases (other platforms or static libraries under * Windows), the SUNDIALS_EXPORT macro is empty */ @SUNDIALS_EXPORT@ sundials-2.5.0/include/sundials/sundials_nvector.h0000600000175000017500000003713411741421110023212 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for a generic NVECTOR package. * It defines the N_Vector structure (_generic_N_Vector) which * contains the following fields: * - an implementation-dependent 'content' field which contains * the description and actual data of the vector * - an 'ops' filed which contains a structure listing operations * acting on such vectors * * Part I of this file contains type declarations for the * _generic_N_Vector and _generic_N_Vector_Ops structures, as well * as references to pointers to such structures (N_Vector). * * Part II of this file contains the prototypes for the vector * functions which operate on N_Vector. * * At a minimum, a particular implementation of an NVECTOR must * do the following: * - specify the 'content' field of N_Vector, * - implement the operations on those N_Vectors, * - provide a constructor routine for new vectors * * Additionally, an NVECTOR implementation may provide the following: * - macros to access the underlying N_Vector data * - a constructor for an array of N_Vectors * - a constructor for an empty N_Vector (i.e., a new N_Vector with * a NULL data pointer). * - a routine to print the content of an N_Vector * ----------------------------------------------------------------- */ #ifndef _NVECTOR_H #define _NVECTOR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Generic definition of N_Vector * ----------------------------------------------------------------- */ /* Forward reference for pointer to N_Vector_Ops object */ typedef struct _generic_N_Vector_Ops *N_Vector_Ops; /* Forward reference for pointer to N_Vector object */ typedef struct _generic_N_Vector *N_Vector; /* Define array of N_Vectors */ typedef N_Vector *N_Vector_S; /* Structure containing function pointers to vector operations */ struct _generic_N_Vector_Ops { N_Vector (*nvclone)(N_Vector); N_Vector (*nvcloneempty)(N_Vector); void (*nvdestroy)(N_Vector); void (*nvspace)(N_Vector, long int *, long int *); realtype* (*nvgetarraypointer)(N_Vector); void (*nvsetarraypointer)(realtype *, N_Vector); void (*nvlinearsum)(realtype, N_Vector, realtype, N_Vector, N_Vector); void (*nvconst)(realtype, N_Vector); void (*nvprod)(N_Vector, N_Vector, N_Vector); void (*nvdiv)(N_Vector, N_Vector, N_Vector); void (*nvscale)(realtype, N_Vector, N_Vector); void (*nvabs)(N_Vector, N_Vector); void (*nvinv)(N_Vector, N_Vector); void (*nvaddconst)(N_Vector, realtype, N_Vector); realtype (*nvdotprod)(N_Vector, N_Vector); realtype (*nvmaxnorm)(N_Vector); realtype (*nvwrmsnorm)(N_Vector, N_Vector); realtype (*nvwrmsnormmask)(N_Vector, N_Vector, N_Vector); realtype (*nvmin)(N_Vector); realtype (*nvwl2norm)(N_Vector, N_Vector); realtype (*nvl1norm)(N_Vector); void (*nvcompare)(realtype, N_Vector, N_Vector); booleantype (*nvinvtest)(N_Vector, N_Vector); booleantype (*nvconstrmask)(N_Vector, N_Vector, N_Vector); realtype (*nvminquotient)(N_Vector, N_Vector); }; /* * ----------------------------------------------------------------- * A vector is a structure with an implementation-dependent * 'content' field, and a pointer to a structure of vector * operations corresponding to that implementation. * ----------------------------------------------------------------- */ struct _generic_N_Vector { void *content; struct _generic_N_Vector_Ops *ops; }; /* * ----------------------------------------------------------------- * Functions exported by NVECTOR module * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * N_VClone * Creates a new vector of the same type as an existing vector. * It does not copy the vector, but rather allocates storage for * the new vector. * * N_VCloneEmpty * Creates a new vector of the same type as an existing vector, * but does not allocate storage. * * N_VDestroy * Destroys a vector created with N_VClone. * * N_VSpace * Returns space requirements for one N_Vector (type 'realtype' in * lrw and type 'long int' in liw). * * N_VGetArrayPointer * Returns a pointer to the data component of the given N_Vector. * NOTE: This function assumes that the internal data is stored * as a contiguous 'realtype' array. This routine is only used in * the solver-specific interfaces to the dense and banded linear * solvers, as well as the interfaces to the banded preconditioners * distributed with SUNDIALS. * * N_VSetArrayPointer * Overwrites the data field in the given N_Vector with a user-supplied * array of type 'realtype'. * NOTE: This function assumes that the internal data is stored * as a contiguous 'realtype' array. This routine is only used in * the interfaces to the dense linear solver. * * N_VLinearSum * Performs the operation z = a*x + b*y * * N_VConst * Performs the operation z[i] = c for i = 0, 1, ..., N-1 * * N_VProd * Performs the operation z[i] = x[i]*y[i] for i = 0, 1, ..., N-1 * * N_VDiv * Performs the operation z[i] = x[i]/y[i] for i = 0, 1, ..., N-1 * * N_VScale * Performs the operation z = c*x * * N_VAbs * Performs the operation z[i] = |x[i]| for i = 0, 1, ..., N-1 * * N_VInv * Performs the operation z[i] = 1/x[i] for i = 0, 1, ..., N-1 * This routine does not check for division by 0. It should be * called only with an N_Vector x which is guaranteed to have * all non-zero components. * * N_VAddConst * Performs the operation z[i] = x[i] + b for i = 0, 1, ..., N-1 * * N_VDotProd * Returns the dot product of two vectors: * sum (i = 0 to N-1) {x[i]*y[i]} * * N_VMaxNorm * Returns the maximum norm of x: * max (i = 0 to N-1) ABS(x[i]) * * N_VWrmsNorm * Returns the weighted root mean square norm of x with weight * vector w: * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] * * N_VWrmsNormMask * Returns the weighted root mean square norm of x with weight * vector w, masked by the elements of id: * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i]*msk[i])^2})/N] * where msk[i] = 1.0 if id[i] > 0 and * msk[i] = 0.0 if id[i] < 0 * * N_VMin * Returns the smallest element of x: * min (i = 0 to N-1) x[i] * * N_VWL2Norm * Returns the weighted Euclidean L2 norm of x with weight * vector w: * sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] * * N_VL1Norm * Returns the L1 norm of x: * sum (i = 0 to N-1) {ABS(x[i])} * * N_VCompare * Performs the operation * z[i] = 1.0 if ABS(x[i]) >= c i = 0, 1, ..., N-1 * 0.0 otherwise * * N_VInvTest * Performs the operation z[i] = 1/x[i] with a test for * x[i] == 0.0 before inverting x[i]. * This routine returns TRUE if all components of x are non-zero * (successful inversion) and returns FALSE otherwise. * * N_VConstrMask * Performs the operation : * m[i] = 1.0 if constraint test fails for x[i] * m[i] = 0.0 if constraint test passes for x[i] * where the constraint tests are as follows: * If c[i] = +2.0, then x[i] must be > 0.0. * If c[i] = +1.0, then x[i] must be >= 0.0. * If c[i] = -1.0, then x[i] must be <= 0.0. * If c[i] = -2.0, then x[i] must be < 0.0. * This routine returns a boolean FALSE if any element failed * the constraint test, TRUE if all passed. It also sets a * mask vector m, with elements equal to 1.0 where the * corresponding constraint test failed, and equal to 0.0 * where the constraint test passed. * This routine is specialized in that it is used only for * constraint checking. * * N_VMinQuotient * Performs the operation : * minq = min ( num[i]/denom[i]) over all i such that * denom[i] != 0. * This routine returns the minimum of the quotients obtained * by term-wise dividing num[i] by denom[i]. A zero element * in denom will be skipped. If no such quotients are found, * then the large value BIG_REAL is returned. * * ----------------------------------------------------------------- * * The following table lists the vector functions used by * different modules in SUNDIALS. The symbols in the table * have the following meaning: * S - called by the solver; * D - called by the dense linear solver module * B - called by the band linear solver module * Di - called by the diagonal linear solver module * I - called by the iterative linear solver module * BP - called by the band preconditioner module * BBDP - called by the band-block diagonal preconditioner module * F - called by the Fortran-to-C interface * * ------------------------------------------------ * MODULES * NVECTOR ------------------------------------------------ * FUNCTIONS CVODE/CVODES IDA KINSOL * ----------------------------------------------------------------- * N_VClone S Di I S I BBDP S I BBDP * ----------------------------------------------------------------- * N_VCloneEmpty F F F * ----------------------------------------------------------------- * N_VDestroy S Di I S I BBDP S I BBDP * ----------------------------------------------------------------- * N_VSpace S S S * ----------------------------------------------------------------- * N_VGetArrayPointer D B BP BBDP F D B BBDP BBDP F * ----------------------------------------------------------------- * N_VSetArrayPointer D F D F * ----------------------------------------------------------------- * N_VLinearSum S D Di I S D I S I * ----------------------------------------------------------------- * N_VConst S I S I I * ----------------------------------------------------------------- * N_VProd S Di I S I S I * ----------------------------------------------------------------- * N_VDiv S Di I S I S I * ----------------------------------------------------------------- * N_VScale S D B Di I BP BBDP S D B I BBDP S I BBDP * ----------------------------------------------------------------- * N_VAbs S S S * ----------------------------------------------------------------- * N_VInv S Di S S * ----------------------------------------------------------------- * N_VAddConst S Di S * ----------------------------------------------------------------- * N_VDotProd I I I * ----------------------------------------------------------------- * N_VMaxNorm S S S * ----------------------------------------------------------------- * N_VWrmsNorm S D B I BP BBDP S * ----------------------------------------------------------------- * N_VWrmsNormMask S * ----------------------------------------------------------------- * N_VMin S S S * ----------------------------------------------------------------- * N_VWL2Norm S I * ----------------------------------------------------------------- * N_VL1Norm I * ----------------------------------------------------------------- * N_VCompare Di S * ----------------------------------------------------------------- * N_VInvTest Di * ----------------------------------------------------------------- * N_VConstrMask S S * ----------------------------------------------------------------- * N_VMinQuotient S S * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VClone(N_Vector w); SUNDIALS_EXPORT N_Vector N_VCloneEmpty(N_Vector w); SUNDIALS_EXPORT void N_VDestroy(N_Vector v); SUNDIALS_EXPORT void N_VSpace(N_Vector v, long int *lrw, long int *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer(realtype *v_data, N_Vector v); SUNDIALS_EXPORT void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm(N_Vector x); SUNDIALS_EXPORT void N_VCompare(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient(N_Vector num, N_Vector denom); /* * ----------------------------------------------------------------- * Additional functions exported by NVECTOR module * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * N_VCloneEmptyVectorArray * Creates (by cloning 'w') an array of 'count' empty N_Vectors * * N_VCloneVectorArray * Creates (by cloning 'w') an array of 'count' N_Vectors * * N_VDestroyVectorArray * Frees memory for an array of 'count' N_Vectors that was * created by a call to N_VCloneVectorArray * * These functions are used by the SPGMR iterative linear solver * module and by the CVODES and IDAS solvers. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray(N_Vector *vs, int count); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/sundials/sundials_math.h0000600000175000017500000001030611741421110022453 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for a simple C-language math library. The * routines listed here work with the type realtype as defined in * the header file sundials_types.h. * ----------------------------------------------------------------- */ #ifndef _SUNDIALSMATH_H #define _SUNDIALSMATH_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Macros : MIN and MAX * ----------------------------------------------------------------- * MIN(A,B) returns the minimum of A and B * * MAX(A,B) returns the maximum of A and B * * SQR(A) returns A^2 * ----------------------------------------------------------------- */ #ifndef MIN #define MIN(A, B) ((A) < (B) ? (A) : (B)) #endif #ifndef MAX #define MAX(A, B) ((A) > (B) ? (A) : (B)) #endif #ifndef SQR #define SQR(A) ((A)*(A)) #endif #ifndef ABS #define ABS RAbs #endif #ifndef SQRT #define SQRT RSqrt #endif #ifndef EXP #define EXP RExp #endif /* * ----------------------------------------------------------------- * Function : RPowerI * ----------------------------------------------------------------- * Usage : int exponent; * realtype base, ans; * ans = RPowerI(base,exponent); * ----------------------------------------------------------------- * RPowerI returns the value of base^exponent, where base is of type * realtype and exponent is of type int. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype RPowerI(realtype base, int exponent); /* * ----------------------------------------------------------------- * Function : RPowerR * ----------------------------------------------------------------- * Usage : realtype base, exponent, ans; * ans = RPowerR(base,exponent); * ----------------------------------------------------------------- * RPowerR returns the value of base^exponent, where both base and * exponent are of type realtype. If base < ZERO, then RPowerR * returns ZERO. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype RPowerR(realtype base, realtype exponent); /* * ----------------------------------------------------------------- * Function : RSqrt * ----------------------------------------------------------------- * Usage : realtype sqrt_x; * sqrt_x = RSqrt(x); * ----------------------------------------------------------------- * RSqrt(x) returns the square root of x. If x < ZERO, then RSqrt * returns ZERO. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype RSqrt(realtype x); /* * ----------------------------------------------------------------- * Function : RAbs (a.k.a. ABS) * ----------------------------------------------------------------- * Usage : realtype abs_x; * abs_x = RAbs(x); * ----------------------------------------------------------------- * RAbs(x) returns the absolute value of x. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype RAbs(realtype x); /* * ----------------------------------------------------------------- * Function : RExp (a.k.a. EXP) * ----------------------------------------------------------------- * Usage : realtype exp_x; * exp_x = RExp(x); * ----------------------------------------------------------------- * RExp(x) returns e^x (base-e exponential function). * ----------------------------------------------------------------- */ SUNDIALS_EXPORT realtype RExp(realtype x); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/0000755000175000017500000000000011767174700016577 5ustar sylvestresylvestresundials-2.5.0/include/idas/idas_sptfqmr.h0000600000175000017500000000507211741421242021424 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/07/05 19:10:36 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the IDAS scaled preconditioned * TFQMR linear solver module, IDASPTFQMR. * * Part I contains function prototypes for using IDASPTFQMR on forward * problems (DAE integration and/or FSA) * * Part II contains function prototypes for using IDASPTFQMR on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _IDASSPTFQMR_H #define _IDASSPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : IDASptfqmr * ----------------------------------------------------------------- * A call to the IDASptfqmr function links the main integrator with * the IDASPTFQMR linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value. * Otherwise pass a positive integer. * * The return values of IDASptfqmr are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the IDAS memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in idas_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASptfqmr(void *ida_mem, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASptfqmrB(void *ida_mem, int which, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_bbdpre.h0000600000175000017500000003175311741421242021173 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDABBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with IDAS and * IDASpgmr/IDASpbcg/IDASptfqmr. */ #ifndef _IDASBBDPRE_H #define _IDASBBDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * PART I - forward problems * ================================================================= */ /* * ----------------------------------------------------------------- * * SUMMARY * * These routines provide a preconditioner matrix that is * block-diagonal with banded blocks. The blocking corresponds * to the distribution of the dependent variable vector y among * the processors. Each preconditioner block is generated from * the Jacobian of the local part (on the current processor) of a * given function G(t,y,y') approximating F(t,y,y'). The blocks * are generated by a difference quotient scheme on each processor * independently. This scheme utilizes an assumed banded structure * with given half-bandwidths, mudq and mldq. However, the banded * Jacobian block kept by the scheme has half-bandwiths mukeep and * mlkeep, which may be smaller. * * The user's calling program should have the following form: * * #include * #include * ... * y0 = N_VNew_Parallel(...); * yp0 = N_VNew_Parallel(...); * ... * ida_mem = IDACreate(...); * ier = IDAInit(...); * ... * flag = IDASptfqmr(ida_mem, maxl); * -or- * flag = IDASpgmr(ida_mem, maxl); * -or- * flag = IDASpbcg(ida_mem, maxl); * ... * flag = IDABBDPrecInit(ida_mem, Nlocal, mudq, mldq, * mukeep, mlkeep, dq_rel_yy, Gres, Gcomm); * ... * ier = IDASolve(...); * ... * IDAFree(&ida_mem); * * N_VDestroy(y0); * N_VDestroy(yp0); * * The user-supplied routines required are: * * res is the function F(t,y,y') defining the DAE system to * be solved: F(t,y,y') = 0. * * Gres is the function defining a local approximation * G(t,y,y') to F, for the purposes of the preconditioner. * * Gcomm is the function performing communication needed * for Glocal. * * Notes: * * 1) This header file is included by the user for the definition * of the IBBDPrecData type and for needed function prototypes. * * 2) The IDABBDPrecInit call includes half-bandwidths mudq and * mldq to be used in the approximate Jacobian. They need * not be the true half-bandwidths of the Jacobian of the * local block of G, when smaller values may provide a greater * efficiency. Similarly, mukeep and mlkeep, specifying the * bandwidth kept for the approximate Jacobian, need not be * the true half-bandwidths. Also, mukeep, mlkeep, mudq, and * mldq need not be the same on every processor. * * 3) The actual name of the user's res function is passed to * IDAInit, and the names of the user's Gres and Gcomm * functions are passed to IDABBDPrecInit. * * 4) The pointer to the user-defined data block user_data, which * is set through IDASetUserData is also available to the user * in glocal and gcomm. * * 5) Optional outputs specific to this module are available by * way of routines listed below. These include work space sizes * and the cumulative number of glocal calls. The costs * associated with this module also include nsetups banded LU * factorizations, nsetups gcomm calls, and nps banded * backsolve calls, where nsetups and nps are integrator * optional outputs. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : IDABBDLocalFn * ----------------------------------------------------------------- * The user must supply a function G(t,y,y') which approximates * the function F for the system F(t,y,y') = 0, and which is * computed locally (without interprocess communication). * (The case where G is mathematically identical to F is allowed.) * The implementation of this function must have type IDABBDLocalFn. * * This function takes as input the independent variable value tt, * the current solution vector yy, the current solution * derivative vector yp, and a pointer to the user-defined data * block user_data. It is to compute the local part of G(t,y,y') * and store it in the vector gval. (Providing memory for yy and * gval is handled within this preconditioner module.) It is * expected that this routine will save communicated data in work * space defined by the user, and made available to the * preconditioner function for the problem. The user_data * parameter is the same as that passed by the user to the * IDAMalloc routine. * * An IDABBDLocalFn Gres is to return an int, defined in the same * way as for the residual function: 0 (success), +1 or -1 (fail). * ----------------------------------------------------------------- */ typedef int (*IDABBDLocalFn)(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); /* * ----------------------------------------------------------------- * Type : IDABBDCommFn * ----------------------------------------------------------------- * The user may supply a function of type IDABBDCommFn which * performs all interprocess communication necessary to * evaluate the approximate system function described above. * * This function takes as input the solution vectors yy and yp, * and a pointer to the user-defined data block user_data. The * user_data parameter is the same as that passed by the user to * the IDASetUserData routine. * * The IDABBDCommFn Gcomm is expected to save communicated data in * space defined with the structure *user_data. * * A IDABBDCommFn Gcomm returns an int value equal to 0 (success), * > 0 (recoverable error), or < 0 (unrecoverable error). * * Each call to the IDABBDCommFn is preceded by a call to the system * function res with the same vectors yy and yp. Thus the * IDABBDCommFn gcomm can omit any communications done by res if * relevant to the evaluation of the local function glocal. * A NULL communication function can be passed to IDABBDPrecInit * if all necessary communication was done by res. * ----------------------------------------------------------------- */ typedef int (*IDABBDCommFn)(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, void *user_data); /* * ----------------------------------------------------------------- * Function : IDABBDPrecInit * ----------------------------------------------------------------- * IDABBDPrecInit allocates and initializes the BBD preconditioner. * * The parameters of IDABBDPrecInit are as follows: * * ida_mem is a pointer to the memory blockreturned by IDACreate. * * Nlocal is the length of the local block of the vectors yy etc. * on the current processor. * * mudq, mldq are the upper and lower half-bandwidths to be used * in the computation of the local Jacobian blocks. * * mukeep, mlkeep are the upper and lower half-bandwidths to be * used in saving the Jacobian elements in the local * block of the preconditioner matrix PP. * * dq_rel_yy is an optional input. It is the relative increment * to be used in the difference quotient routine for * Jacobian calculation in the preconditioner. The * default is sqrt(unit roundoff), and specified by * passing dq_rel_yy = 0. * * Gres is the name of the user-supplied function G(t,y,y') * that approximates F and whose local Jacobian blocks * are to form the preconditioner. * * Gcomm is the name of the user-defined function that performs * necessary interprocess communication for the * execution of glocal. * * The return value of IDABBDPrecInit is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_ILL_INPUT if an input has an illegal value * IDASPILS_MEM_FAIL if a memory allocation request failed * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm); /* * ----------------------------------------------------------------- * Function : IDABBDPrecReInit * ----------------------------------------------------------------- * IDABBDPrecReInit reinitializes the IDABBDPRE module when * solving a sequence of problems of the same size with * IDASPGMR/IDABBDPRE, IDASPBCG/IDABBDPRE, or IDASPTFQMR/IDABBDPRE * provided there is no change in Nlocal, mukeep, or mlkeep. After * solving one problem, and after calling IDAReInit to reinitialize * the integrator for a subsequent problem, call IDABBDPrecReInit. * * All arguments have the same names and meanings as those * of IDABBDPrecInit. * * The return value of IDABBDPrecReInit is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, long int mudq, long int mldq, realtype dq_rel_yy); /* * ----------------------------------------------------------------- * Optional outputs for IDABBDPRE * ----------------------------------------------------------------- * IDABBDPrecGetWorkSpace returns the real and integer work space * for IDABBDPRE. * IDABBDPrecGetNumGfnEvals returns the number of calls to the * user Gres function. * * The return value of IDABBDPrecGet* is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP); /* * ================================================================= * PART II - backward problems * ================================================================= */ /* * ----------------------------------------------------------------- * Types: IDALocalFnB and IDACommFnB * ----------------------------------------------------------------- * Local approximation function and inter-process communication * function for the BBD preconditioner on the backward phase. * ----------------------------------------------------------------- */ typedef int (*IDABBDLocalFnB)(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB); typedef int (*IDABBDCommFnB)(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, void *user_dataB); /* * ----------------------------------------------------------------- * Functions: IDABBDPrecInitB, IDABBDPrecReInit * ----------------------------------------------------------------- * Interface functions for the IDABBDPRE preconditioner to be used * on the backward phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecInitB(void *ida_mem, int which, long int NlocalB, long int mudqB, long int mldqB, long int mukeepB, long int mlkeepB, realtype dq_rel_yyB, IDABBDLocalFnB GresB, IDABBDCommFnB GcommB); SUNDIALS_EXPORT int IDABBDPrecReInitB(void *ida_mem, int which, long int mudqB, long int mldqB, realtype dq_rel_yyB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_direct.h0000600000175000017500000004211711741421242021203 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common header file for the direct linear solvers in IDAS. * ----------------------------------------------------------------- */ #ifndef _IDADLS_H #define _IDADLS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * I D A S D I R E C T C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * IDASDIRECT return values * ----------------------------------------------------------------- */ #define IDADLS_SUCCESS 0 #define IDADLS_MEM_NULL -1 #define IDADLS_LMEM_NULL -2 #define IDADLS_ILL_INPUT -3 #define IDADLS_MEM_FAIL -4 /* Additional last_flag values */ #define IDADLS_JACFUNC_UNRECVR -5 #define IDADLS_JACFUNC_RECVR -6 /* Return values for the adjoint module */ #define IDADLS_NO_ADJ -101 #define IDADLS_LMEMB_NULL -102 /* * ================================================================= * PART I: F O R W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * FUNCTION TYPES * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Types : IDADlsDenseJacFn * ----------------------------------------------------------------- * * A dense Jacobian approximation function djac must be of type * IDADlsDenseJacFn. * Its parameters are: * * N is the problem size, and length of all vector arguments. * * t is the current value of the independent variable t. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * f is the residual vector F(tt,yy,yp). * * c_j is the scalar in the system Jacobian, proportional to * the inverse of the step size h. * * user_data is a pointer to user Jacobian data - the same as the * user_data parameter passed to IDASetRdata. * * Jac is the dense matrix (of type DlsMat) to be loaded by * an IDADlsDenseJacFn routine with an approximation to the * system Jacobian matrix * J = dF/dy' + gamma*dF/dy * at the given point (t,y,y'), where the ODE system is * given by F(t,y,y') = 0. * Note that Jac is NOT preset to zero! * * tmp1, tmp2, tmp3 are pointers to memory allocated for * N_Vectors which can be used by an IDADlsDenseJacFn routine * as temporary storage or work space. * * A IDADlsDenseJacFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load a dense Jac: * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = LAPACK_DENSE_COL(Jac,j); * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * (2) (without macros - explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = (Jac->data)[j]; * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * A third way, using the LAPACK_DENSE_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively * (see ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h. * * ----------------------------------------------------------------- */ typedef int (*IDADlsDenseJacFn)(long int N, realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Types : IDADlsBandJacFn * ----------------------------------------------------------------- * A banded Jacobian approximation function bjac must have the * prototype given below. Its parameters are: * * Neq is the problem size, and length of all vector arguments. * * mupper is the upper bandwidth of the banded Jacobian matrix. * * mlower is the lower bandwidth of the banded Jacobian matrix. * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the residual vector F(tt,yy,yp). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * user_data is a pointer to user Jacobian data - the same as the * user_data parameter passed to IDASetRdata. * * Jac is the band matrix (of type BandMat) to be loaded by * an IDADlsBandJacFn routine with an approximation to the * system Jacobian matrix * J = dF/dy + cj*dF/dy' * at the given point (t,y,y'), where the DAE system is * given by F(t,y,y') = 0. Jac is preset to zero, so only * the nonzero elements need to be loaded. See note below. * * tmp1, tmp2, tmp3 are pointers to memory allocated for * N_Vectors which can be used by an IDADlsBandJacFn routine * as temporary storage or work space. * * An IDADlsBandJacFn function should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load Jac: * * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = BAND_COL(Jac,j); * for (i=j-mupper; i <= j+mlower; i++) { * generate J_ij = the (i,j)th Jacobian element * BAND_COL_ELEM(col_j,i,j) = J_ij; * } * } * * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) * for (j=0; j < Neq; j++) { * col_j = BAND_COL(Jac,j); * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * * A third way, using the BAND_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively (see * ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * ----------------------------------------------------------------- */ typedef int (*IDADlsBandJacFn)(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Optional inputs to the IDADLS linear solver * ----------------------------------------------------------------- * IDADlsSetDenseJacFn specifies the dense Jacobian approximation * routine to be used for a direct dense linear solver. * * IDADlsSetBandJacFn specifies the band Jacobian approximation * routine to be used for a direct band linear solver. * * By default, a difference quotient approximation, supplied with * the solver is used. * * The return value is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac); SUNDIALS_EXPORT int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac); /* * ----------------------------------------------------------------- * Optional outputs from the IDADLS linear solver * ----------------------------------------------------------------- * * IDADlsGetWorkSpace returns the real and integer workspace used * by the direct linear solver. * IDADlsGetNumJacEvals returns the number of calls made to the * Jacobian evaluation routine jac. * IDADlsGetNumResEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * IDADlsGetLastFlag returns the last error flag set by any of * the IDADLS interface functions. * * The return value of IDADlsGet* is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); SUNDIALS_EXPORT int IDADlsGetNumResEvals(void *ida_mem, long int *nfevalsLS); SUNDIALS_EXPORT int IDADlsGetLastFlag(void *ida_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a IDADLS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDADlsGetReturnFlagName(long int flag); /* * ================================================================= * PART II: B A C K W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * FUNCTION TYPES * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type: IDADlsDenseJacFnB * ----------------------------------------------------------------- * A dense Jacobian approximation function JacB for the adjoint * (backward) problem must have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*IDADlsDenseJacFnB)(long int NeqB, realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * Type : IDADlsBandJacFnB * ----------------------------------------------------------------- * A band Jacobian approximation function JacB for the adjoint * (backward) problem must have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*IDADlsBandJacFnB)(long int NeqB, long int mupperB, long int mlowerB, realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * EXPORTED FUNCTIONS * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Functions: IDADlsSetJacFnB * ----------------------------------------------------------------- * IDADlsSetDenseJacFnB and IDADlsSetBandJacFnB specify the dense * and band, respectively, Jacobian functions to be used by a * IDASDIRECT linear solver for the bacward integration phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADlsSetDenseJacFnB(void *ida_mem, int which, IDADlsDenseJacFnB jacB); SUNDIALS_EXPORT int IDADlsSetBandJacFnB(void *idaa_mem, int which, IDADlsBandJacFnB jacB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_lapack.h0000600000175000017500000000713711741421242021167 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2008/04/18 19:42:38 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the IDAS dense linear solver IDASLAPACK. * ----------------------------------------------------------------- */ #ifndef _IDALAPACK_H #define _IDALAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDALapackDense * ----------------------------------------------------------------- * A call to the IDALapackDense function links the main integrator * with the IDALAPACK linear solver using dense Jacobians. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * N is the size of the DAE system. * * The return value of IDALapackDense is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDAS memory was NULL * IDADLS_MEM_FAIL if there was a memory allocation failure * IDADLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackDense(void *ida_mem, int N); /* * ----------------------------------------------------------------- * Function : IDALapackBand * ----------------------------------------------------------------- * A call to the IDALapackBand function links the main integrator * with the IDALAPACK linear solver using banded Jacobians. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian approximation. * * mlower is the lower bandwidth of the band Jacobian approximation. * * The return value of IDALapackBand is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDAS memory was NULL * IDADLS_MEM_FAIL if there was a memory allocation failure * IDADLS_ILL_INPUT if a required vector operation is missing * or if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackBand(void *ida_mem, int N, int mupper, int mlower); /* * ----------------------------------------------------------------- * Function: IDALapackDenseB * ----------------------------------------------------------------- * IDALapackDenseB links the main IDAS integrator with the dense * IDALAPACK linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackDenseB(void *ida_mem, int NeqB); /* * ----------------------------------------------------------------- * Function: IDALapackBandB * ----------------------------------------------------------------- * IDALapackBandB links the main IDAS integrator with the band * IDALAPACK linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackBandB(void *ida_mem, int NeqB, int mupperB, int mlowerB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas.h0000600000175000017500000030471111741421242017652 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.26 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the header (include) file for the main IDAS solver. * ----------------------------------------------------------------- * * IDAS is used to solve numerically the initial value problem * for the differential algebraic equation (DAE) system * F(t,y,y') = 0, * given initial conditions * y(t0) = y0, y'(t0) = yp0. * Here y and F are vectors of length N. * * Additionally, IDAS can perform forward or adjoint sensitivity * analysis. * ----------------------------------------------------------------- */ #ifndef _IDAS_H #define _IDAS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * I D A S C O N S T A N T S * ================================================================= */ /* * ---------------------------------------------------------------- * Inputs to: * IDAInit, IDAReInit, * IDASensInit, IDASensReInit, * IDAQuadInit, IDAQuadReInit, * IDAQuadSensInit, IDAQuadSensReInit, * IDACalcIC, IDASolve, * IDAAdjInit * ---------------------------------------------------------------- */ /* itask */ #define IDA_NORMAL 1 #define IDA_ONE_STEP 2 /* icopt */ #define IDA_YA_YDP_INIT 1 #define IDA_Y_INIT 2 /* ism */ #define IDA_SIMULTANEOUS 1 #define IDA_STAGGERED 2 /* DQtype */ #define IDA_CENTERED 1 #define IDA_FORWARD 2 /* interp */ #define IDA_HERMITE 1 #define IDA_POLYNOMIAL 2 /* * =============================================================== * IDAS RETURN VALUES * =============================================================== */ #define IDA_SUCCESS 0 #define IDA_TSTOP_RETURN 1 #define IDA_ROOT_RETURN 2 #define IDA_WARNING 99 #define IDA_TOO_MUCH_WORK -1 #define IDA_TOO_MUCH_ACC -2 #define IDA_ERR_FAIL -3 #define IDA_CONV_FAIL -4 #define IDA_LINIT_FAIL -5 #define IDA_LSETUP_FAIL -6 #define IDA_LSOLVE_FAIL -7 #define IDA_RES_FAIL -8 #define IDA_REP_RES_ERR -9 #define IDA_RTFUNC_FAIL -10 #define IDA_CONSTR_FAIL -11 #define IDA_FIRST_RES_FAIL -12 #define IDA_LINESEARCH_FAIL -13 #define IDA_NO_RECOVERY -14 #define IDA_MEM_NULL -20 #define IDA_MEM_FAIL -21 #define IDA_ILL_INPUT -22 #define IDA_NO_MALLOC -23 #define IDA_BAD_EWT -24 #define IDA_BAD_K -25 #define IDA_BAD_T -26 #define IDA_BAD_DKY -27 #define IDA_NO_QUAD -30 #define IDA_QRHS_FAIL -31 #define IDA_FIRST_QRHS_ERR -32 #define IDA_REP_QRHS_ERR -33 #define IDA_NO_SENS -40 #define IDA_SRES_FAIL -41 #define IDA_REP_SRES_ERR -42 #define IDA_BAD_IS -43 #define IDA_NO_QUADSENS -50 #define IDA_QSRHS_FAIL -51 #define IDA_FIRST_QSRHS_ERR -52 #define IDA_REP_QSRHS_ERR -53 /* * ----------------------------------------- * IDAA return flags * ----------------------------------------- */ #define IDA_NO_ADJ -101 #define IDA_NO_FWD -102 #define IDA_NO_BCK -103 #define IDA_BAD_TB0 -104 #define IDA_REIFWD_FAIL -105 #define IDA_FWD_FAIL -106 #define IDA_GETY_BADT -107 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ---------------------------------------------------------------- * Type : IDAResFn * ---------------------------------------------------------------- * The F function which defines the DAE system F(t,y,y')=0 * must have type IDAResFn. * Symbols are as follows: * t <-> t y <-> yy * y' <-> yp F <-> rr * A IDAResFn takes as input the independent variable value t, * the dependent variable vector yy, and the derivative (with * respect to t) of the yy vector, yp. It stores the result of * F(t,y,y') in the vector rr. The yy, yp, and rr arguments are of * type N_Vector. The user_data parameter is the pointer user_data * passed by the user to the IDASetUserData routine. This user-supplied * pointer is passed to the user's res function every time it is called, * to provide access in res to user data. * * A IDAResFn res should return a value of 0 if successful, a positive * value if a recoverable error occured (e.g. yy has an illegal value), * or a negative value if a nonrecoverable error occured. In the latter * case, the program halts. If a recoverable error occured, the integrator * will attempt to correct and retry. * ---------------------------------------------------------------- */ typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); /* * ----------------------------------------------------------------- * Type : IDARootFn * ----------------------------------------------------------------- * A function g, which defines a set of functions g_i(t,y,y') whose * roots are sought during the integration, must have type IDARootFn. * The function g takes as input the independent variable value t, * the dependent variable vector y, and its t-derivative yp (= y'). * It stores the nrtfn values g_i(t,y,y') in the realtype array gout. * (Allocation of memory for gout is handled within IDA.) * The user_data parameter is the same as that passed by the user * to the IDASetUserData routine. This user-supplied pointer is * passed to the user's g function every time it is called. * * An IDARootFn should return 0 if successful or a non-zero value * if an error occured (in which case the integration will be halted). * ----------------------------------------------------------------- */ typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data); /* * ----------------------------------------------------------------- * Type : IDAEwtFn * ----------------------------------------------------------------- * A function e, which sets the error weight vector ewt, must have * type IDAEwtFn. * The function e takes as input the current dependent variable y. * It must set the vector of error weights used in the WRMS norm: * * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] * * Typically, the vector ewt has components: * * ewt_i = 1 / (reltol * |y_i| + abstol_i) * * The user_data parameter is the same as that passed by the user * to the IDASetUserData routine. This user-supplied pointer is * passed to the user's e function every time it is called. * An IDAEwtFn e must return 0 if the error weight vector has been * successfuly set and a non-zero value otherwise. * ----------------------------------------------------------------- */ typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); /* * ----------------------------------------------------------------- * Type : IDAErrHandlerFn * ----------------------------------------------------------------- * A function eh, which handles error messages, must have type * IDAErrHandlerFn. * The function eh takes as input the error code, the name of the * module reporting the error, the error message, and a pointer to * user data, the same as that passed to IDASetUserData. * * All error codes are negative, except IDA_WARNING which indicates * a warning (the solver continues). * * An IDAErrHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*IDAErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); /* * ----------------------------------------------------------------- * Type : IDAQuadRhsFn * ----------------------------------------------------------------- * The rhsQ function which defines the right hand side of the * quadrature equations yQ' = rhsQ(t,y) must have type IDAQuadRhsFn. * rhsQ takes as input the value of the independent variable t, * the vector of states y and y' and must store the result of rhsQ in * rrQ. (Allocation of memory for rrQ is handled by IDAS). * * The user_data parameter is the same as the user_data parameter * set by the user through the IDASetUserData routine and is * passed to the rhsQ function every time it is called. * * A function of type IDAQuadRhsFn should return 0 if successful, * a negative value if an unrecoverable error occured, and a positive * value if a recoverable error (e.g. invalid y values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) IDAS will * try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*IDAQuadRhsFn)(realtype tres, N_Vector yy, N_Vector yp, N_Vector rrQ, void *user_data); /* * ----------------------------------------------------------------- * Type : IDASensResFn * ----------------------------------------------------------------- * The resS function which defines the right hand side of the * sensitivity DAE systems F_y * s + F_y' * s' + F_p = 0 * must have type IDASensResFn. * * resS takes as input the number of sensitivities Ns, the * independent variable value t, the states yy and yp and the * corresponding value of the residual in resval, and the dependent * sensitivity vectors yyS and ypS. It stores the residual in * resvalS. (Memory allocation for resvalS is handled within IDAS) * * The user_data parameter is the same as the user_data parameter * set by the user through the IDASetUserData routine and is * passed to the resS function every time it is called. * * A IDASensResFn should return 0 if successful, a negative value if * an unrecoverable error occured, and a positive value if a * recoverable error (e.g. invalid y, yp, yyS or ypS values) * occured. If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) IDAS will * try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*IDASensResFn)(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type : IDAQuadSensRhsFn * ----------------------------------------------------------------- * The rhsQS function which defines the RHS of the sensitivity DAE * systems for quadratures must have type IDAQuadSensRhsFn. * * rhsQS takes as input the number of sensitivities Ns (the same as * that passed to IDAQuadSensInit), the independent variable * value t, the states yy, yp and the dependent sensitivity vectors * yyS and ypS, as well as the current value of the quadrature RHS * rrQ. It stores the result of rhsQS in rhsvalQS. * (Allocation of memory for resvalQS is handled within IDAS) * * A IDAQuadSensRhsFn should return 0 if successful, a negative * value if an unrecoverable error occured, and a positive value * if a recoverable error (e.g. invalid yy, yp, yyS or ypS values) * occured. If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) IDAS * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*IDAQuadSensRhsFn)(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *rhsvalQS, void *user_data, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); /* * ----------------------------------------------------------------- * Types: IDAResFnB and IDAResFnBS * ----------------------------------------------------------------- * The resB function which defines the right hand side of the * DAE systems to be integrated backwards must have type IDAResFnB. * If the backward problem depends on forward sensitivities, its * RHS function must have type IDAResFnBS. * ----------------------------------------------------------------- * Types: IDAQuadRhsFnB and IDAQuadRhsFnBS * ----------------------------------------------------------------- * The rhsQB function which defines the quadratures to be integrated * backwards must have type IDAQuadRhsFnB. * If the backward problem depends on forward sensitivities, its * quadrature RHS function must have type IDAQuadRhsFnBS. * ----------------------------------------------------------------- */ typedef int (*IDAResFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); typedef int (*IDAResFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrBS, void *user_dataB); typedef int (*IDAQuadRhsFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rhsvalBQ, void *user_dataB); typedef int (*IDAQuadRhsFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsvalBQS, void *user_dataB); /* * ================================================================ * U S E R - C A L L A B L E R O U T I N E S * ================================================================ */ /* * ---------------------------------------------------------------- * Function : IDACreate * ---------------------------------------------------------------- * IDACreate creates an internal memory block for a problem to * be solved by IDA. * * If successful, IDACreate returns a pointer to initialized * problem memory. This pointer should be passed to IDAInit. * If an initialization error occurs, IDACreate prints an error * message to standard err and returns NULL. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT void *IDACreate(void); /* * ---------------------------------------------------------------- * Integrator optional input specification functions * ---------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * | * Function | Optional input / [ default value ] * | * ---------------------------------------------------------------- * | * IDASetErrHandlerFn | user-provided ErrHandler function. * | [internal] * | * IDASetErrFile | the file pointer for an error file * | where all IDA warning and error * | messages will be written if the default * | internal error handling function is used. * | This parameter can be stdout (standard * | output), stderr (standard error), or a * | file pointer (corresponding to a user * | error file opened for writing) returned * | by fopen. * | If not called, then all messages will * | be written to the standard error stream. * | [stderr] * | * IDASetUserData | a pointer to user data that will be * | passed to all user-supplied functions. * | [NULL] * | * IDASetMaxOrd | maximum lmm order to be used by the * | solver. * | [5] * | * IDASetMaxNumSteps | maximum number of internal steps to be * | taken by the solver in its attempt to * | reach tout. * | [500] * | * IDASetInitStep | initial step size. * | [estimated by IDA] * | * IDASetMaxStep | maximum absolute value of step size * | allowed. * | [infinity] * | * IDASetStopTime | the independent variable value past * | which the solution is not to proceed. * | [infinity] * | * IDASetNonlinConvCoef | Newton convergence test constant * | for use during integration. * | [0.33] * | * IDASetMaxErrTestFails| Maximum number of error test failures * | in attempting one step. * | [10] * | * IDASetMaxNonlinIters | Maximum number of nonlinear solver * | iterations at one solution. * | [4] * | * IDASetMaxConvFails | Maximum number of allowable conv. * | failures in attempting one step. * | [10] * | * IDASetSuppressAlg | flag to indicate whether or not to * | suppress algebraic variables in the * | local error tests: * | FALSE = do not suppress; * | TRUE = do suppress; * | [FALSE] * | NOTE: if suppressed algebraic variables * | is selected, the nvector 'id' must be * | supplied for identification of those * | algebraic components (see IDASetId) * | * IDASetId | an N_Vector, which states a given * | element to be either algebraic or * | differential. * | A value of 1.0 indicates a differential * | variable while a 0.0 indicates an * | algebraic variable. 'id' is required * | if optional input SUPPRESSALG is set, * | or if IDACalcIC is to be called with * | icopt = IDA_YA_YDP_INIT. * | * IDASetConstraints | an N_Vector defining inequality * | constraints for each component of the * | solution vector y. If a given element * | of this vector has values +2 or -2, * | then the corresponding component of y * | will be constrained to be > 0.0 or * | <0.0, respectively, while if it is +1 * | or -1, the y component is constrained * | to be >= 0.0 or <= 0.0, respectively. * | If a component of constraints is 0.0, * | then no constraint is imposed on the * | corresponding component of y. * | The presence of a non-NULL constraints * | vector that is not 0.0 (ZERO) in all * | components will cause constraint * | checking to be performed. * | * ----------------------------------------------------------------- * | * IDASetRootDirection | Specifies the direction of zero * | crossings to be monitored * | [both directions] * | * IDASetNoInactiveRootWarn | disable warning about possible * | g==0 at beginning of integration * | * ---------------------------------------------------------------- * Return flag: * IDA_SUCCESS if successful * IDA_MEM_NULL if the IDAS memory is NULL * IDA_ILL_INPUT if an argument has an illegal value * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); /* * ---------------------------------------------------------------- * Function : IDAInit * ---------------------------------------------------------------- * IDAInit allocates and initializes memory for a problem to * to be solved by IDAS. * * res is the residual function F in F(t,y,y') = 0. * * t0 is the initial value of t, the independent variable. * * yy0 is the initial condition vector y(t0). * * yp0 is the initial condition vector y'(t0) * * IDA_SUCCESS if successful * IDA_MEM_NULL if the IDAS memory was NULL * IDA_MEM_FAIL if a memory allocation failed * IDA_ILL_INPUT f an argument has an illegal value. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0); /* * ---------------------------------------------------------------- * Function : IDAReInit * ---------------------------------------------------------------- * IDAReInit re-initializes IDAS for the solution of a problem, * where a prior call to IDAInit has been made. * IDAReInit performs the same input checking and initializations * that IDAInit does. * But it does no memory allocation, assuming that the existing * internal memory is sufficient for the new problem. * * The use of IDAReInit requires that the maximum method order, * maxord, is no larger for the new problem than for the problem * specified in the last call to IDAInit. This condition is * automatically fulfilled if the default value for maxord is * specified. * * Following the call to IDAReInit, a call to the linear solver * specification routine is necessary if a different linear solver * is chosen, but may not be otherwise. If the same linear solver * is chosen, and there are no changes in its input parameters, * then no call to that routine is needed. * * The first argument to IDAReInit is: * * ida_mem = pointer to IDA memory returned by IDACreate. * * All the remaining arguments to IDAReInit have names and * meanings identical to those of IDAInit. * * The return value of IDAReInit is equal to SUCCESS = 0 if there * were no errors; otherwise it is a negative int equal to: * IDA_MEM_NULL indicating ida_mem was NULL, or * IDA_NO_MALLOC indicating that ida_mem was not allocated. * IDA_ILL_INPUT indicating an input argument was illegal * (including an attempt to increase maxord). * In case of an error return, an error message is also printed. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0); /* * ----------------------------------------------------------------- * Functions : IDASStolerances * IDASVtolerances * IDAWFtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances. One of them * MUST be called before the first call to IDA. * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) * which will be called to set the error weight vector. * * The tolerances reltol and abstol define a vector of error weights, * ewt, with components * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). * This vector is used in all error and convergence tests, which * use a weighted RMS norm on all error-like vectors v: * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), * where N is the problem dimension. * * The return value of these functions is equal to IDA_SUCCESS = 0 if * there were no errors; otherwise it is a negative int equal to: * IDa_MEM_NULL indicating ida_mem was NULL (i.e., * IDACreate has not been called). * IDA_NO_MALLOC indicating that ida_mem has not been * allocated (i.e., IDAInit has not been * called). * IDA_ILL_INPUT indicating an input argument was illegal * (e.g. a negative tolerance) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); /* ---------------------------------------------------------------- * Initial Conditions optional input specification functions * ---------------------------------------------------------------- * The following functions can be called to set optional inputs * to control the initial conditions calculations. * * | * Function | Optional input / [ default value ] * | * -------------------------------------------------------------- * | * IDASetNonlinConvCoefIC | positive coeficient in the Newton * | convergence test. This test uses a * | weighted RMS norm (with weights * | defined by the tolerances, as in * | IDASolve). For new initial value * | vectors y and y' to be accepted, the * | norm of J-inverse F(t0,y,y') is * | required to be less than epiccon, * | where J is the system Jacobian. * | [0.01 * 0.33] * | * IDASetMaxNumStepsIC | maximum number of values of h allowed * | when icopt = IDA_YA_YDP_INIT, where * | h appears in the system Jacobian, * | J = dF/dy + (1/h)dF/dy'. * | [5] * | * IDASetMaxNumJacsIC | maximum number of values of the * | approximate Jacobian or preconditioner * | allowed, when the Newton iterations * | appear to be slowly converging. * | [4] * | * IDASetMaxNumItersIC | maximum number of Newton iterations * | allowed in any one attempt to solve * | the IC problem. * | [10] * | * IDASetLineSearchOffIC | a boolean flag to turn off the * | linesearch algorithm. * | [FALSE] * | * IDASetStepToleranceIC | positive lower bound on the norm of * | a Newton step. * | [(unit roundoff)^(2/3) * * ---------------------------------------------------------------- * Return flag: * IDA_SUCCESS if successful * IDA_MEM_NULL if the IDAS memory is NULL * IDA_ILL_INPUT if an argument has an illegal value * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); /* * ----------------------------------------------------------------- * Function : IDARootInit * ----------------------------------------------------------------- * IDARootInit initializes a rootfinding problem to be solved * during the integration of the DAE system. It must be called * after IDACreate, and before IDASolve. The arguments are: * * ida_mem = pointer to IDA memory returned by IDACreate. * * nrtfn = number of functions g_i, an int >= 0. * * g = name of user-supplied function, of type IDARootFn, * defining the functions g_i whose roots are sought. * * If a new problem is to be solved with a call to IDAReInit, * where the new problem has no root functions but the prior one * did, then call IDARootInit with nrtfn = 0. * * The return value of IDARootInit is IDA_SUCCESS = 0 if there were * no errors; otherwise it is a negative int equal to: * IDA_MEM_NULL indicating ida_mem was NULL, or * IDA_MEM_FAIL indicating a memory allocation failed. * (including an attempt to increase maxord). * IDA_ILL_INPUT indicating nrtfn > 0 but g = NULL. * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); /* * ----------------------------------------------------------------- * Quadrature optional input specification functions * ----------------------------------------------------------------- * The following function can be called to set optional inputs * to values other than the defaults given below: * * Function | Optional input / [ default value ] * -------------------------------------------------------------- * | * IDASetQuadErrCon | are quadrature variables considered in * | the error control? * | If yes, set tolerances for quadrature * | integration. * | [errconQ = FALSE] * | * ----------------------------------------------------------------- * If successful, the function return IDA_SUCCESS. If an argument * has an illegal value, they print an error message to the * file specified by errfp and return one of the error flags * defined for the IDASet* routines. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetQuadErrCon(void *ida_mem, booleantype errconQ); /* * ---------------------------------------------------------------- * Function : IDAQuadInit and IDAQuadReInit * ---------------------------------------------------------------- * IDAQuadInit allocates and initializes memory related to * quadrature integration. * * IDAQuadReInit re-initializes IDAS's quadrature related * memory for a problem, assuming it has already been allocated * in prior calls to IDAInit and IDAQuadInit. * * ida_mem is a pointer to IDAS memory returned by IDACreate * * rhsQ is the user-provided integrand routine. * * yQ0 is a pointer to a vector specification structure * for N_Vectors containing quadrature variables. * * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAQuadInit(void *ida_mem, IDAQuadRhsFn rhsQ, N_Vector yQ0); SUNDIALS_EXPORT int IDAQuadReInit(void *ida_mem, N_Vector yQ0); /* * ----------------------------------------------------------------- * Functions : IDAQuadSStolerances * IDAQuadSVtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for quadrature * variables. One of them MUST be called before the first call to * IDA IF error control on the quadrature variables is enabled * (see IDASetQuadErrCon). * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * * Return values: * IDA_SUCCESS if successful * IDA_MEM_NULL if the solver memory was NULL * IDA_NO_QUAD if quadratures were not initialized * IDA_ILL_INPUT if an input argument was illegal * (e.g. a negative tolerance) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAQuadSStolerances(void *ida_mem, realtype reltolQ, realtype abstolQ); SUNDIALS_EXPORT int IDAQuadSVtolerances(void *ida_mem, realtype reltolQ, N_Vector abstolQ); /* * ---------------------------------------------------------------- * Forward sensitivity optional input specification functions * ---------------------------------------------------------------- * The following functions can be called to set optional inputs * to other values than the defaults given below: * * Function | Optional input / [ default value ] * | * -------------------------------------------------------------- * | * IDASetSensDQMethod | controls the selection of finite * | difference schemes used in evaluating * | the sensitivity right hand sides: * | (centered vs. forward and * | simultaneous vs. separate) * | [DQtype=IDA_CENTERED] * | [DQrhomax=0.0] * | * IDASetSensParams | parameter information: * | p: pointer to problem parameters * | plist: list of parameters with respect * | to which sensitivities are to be * | computed. * | pbar: order of magnitude info. * | Typically, if p[plist[i]] is nonzero, * | pbar[i]=p[plist[i]]. * | [p=NULL] * | [plist=NULL] * | [pbar=NULL] * | * IDASetSensErrCon | are sensitivity variables considered in * | the error control? * | [TRUE] * | * IDASetSensMaxNonlinIters | Maximum number of nonlinear solver * | iterations for sensitivity systems * | (staggered) * | [4] * | * -------------------------------------------------------------- * If successful, these functions return IDA_SUCCESS. If an argument * has an illegal value, they return one of the error flags * defined for the IDASet* routines. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetSensDQMethod(void *ida_mem, int DQtype, realtype DQrhomax); SUNDIALS_EXPORT int IDASetSensParams(void *ida_mem, realtype *p, realtype *pbar, int *plist); SUNDIALS_EXPORT int IDASetSensErrCon(void *ida_mem, booleantype errconS); SUNDIALS_EXPORT int IDASetSensMaxNonlinIters(void *ida_mem, int maxcorS); /* * ---------------------------------------------------------------- * Function : IDASensInit * ---------------------------------------------------------------- * IDASensInit allocates and initializes memory related to * sensitivity computations. * * ida_mem is a pointer to IDAS memory returned by IDACreate. * * Ns is the number of sensitivities to be computed. * * ism is the type of corrector used in sensitivity * analysis. The legal values are: SIMULTANEOUS * and STAGGERED (see previous description) * * yS0 is the array of initial condition vectors for * sensitivity variables. * * ypS0 is the array of initial condition vectors for * sensitivity derivatives. * * If successful, IDASensInit returns SUCCESS. If an * initialization error occurs, IDASensInit returns one of * the error flags defined above. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASensInit(void *ida_mem, int Ns, int ism, IDASensResFn resS, N_Vector *yS0, N_Vector *ypS0); /* * ---------------------------------------------------------------- * Function : IDASensReInit * ---------------------------------------------------------------- * IDASensReInit re-initializes the IDAS sensitivity related * memory for a problem, assuming it has already been allocated * in prior calls to IDAInit and IDASensInit. * * All problem specification inputs are checked for errors. * The number of sensitivities Ns is assumed to be unchanged * since the previous call to IDASensInit. * If any error occurs during initialization, it is reported to * the file whose file pointer is errfp. * * IDASensReInit potentially does some minimal memory allocation * (for the sensitivity absolute tolerance). * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASensReInit(void *ida_mem, int ism, N_Vector *yS0, N_Vector *ypS0); /* * ----------------------------------------------------------------- * Function : IDASensToggleOff * ----------------------------------------------------------------- * IDASensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory so that * sensitivity computations can be later toggled ON (through * IDASensReInit). * * * The return value is equal to IDA_SUCCESS = 0 if there were no * errors or IDA_MEM_NULL if ida_mem was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASensToggleOff(void *ida_mem); /* * ----------------------------------------------------------------- * Functions : IDASensSStolerances * IDASensSVtolerances * IDASensEEtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to IDASolve. * * IDASensSStolerances specifies scalar relative and absolute tolerances. * IDASensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * IDASensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. * * The return value is equal to IDA_SUCCESS = 0 if there were no * errors; otherwise it is a negative int equal to: * IDA_MEM_NULL indicating ida_mem was NULL, or * IDA_NO_SENS indicating there was not a prior call to * IDASensInit. * IDA_ILL_INPUT indicating an input argument was illegal * (e.g. negative tolerances) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASensSStolerances(void *ida_mem, realtype reltolS, realtype *abstolS); SUNDIALS_EXPORT int IDASensSVtolerances(void *ida_mem, realtype reltolS, N_Vector *abstolS); SUNDIALS_EXPORT int IDASensEEtolerances(void *ida_mem); /* * ----------------------------------------------------------------- * Function : IDAQuadSensInit and IDAQuadSensReInit * ----------------------------------------------------------------- * IDAQuadSensInit allocates and initializes memory related to * quadrature integration. * * IDAQuadSensReInit re-initializes IDAS' sensitivity quadrature * related memory for a problem, assuming it has already been * allocated in prior calls to IDAInit and IDAQuadSensInit. * The number of quadratures Ns is assumed to be unchanged * since the previous call to IDAQuadInit. * * ida_mem is a pointer to IDAS memory returned by IDACreate * * resQS is the sensitivity righ-hand side function * (pass NULL to use the internal DQ approximation) * * yQS is an N_Vector with initial values for sensitivities * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAQuadSensInit(void *ida_mem, IDAQuadSensRhsFn resQS, N_Vector *yQS0); SUNDIALS_EXPORT int IDAQuadSensReInit(void *ida_mem, N_Vector *yQS0); /* * ----------------------------------------------------------------- * Functions : IDAQuadSensSStolerances * IDAQuadSensSVtolerances * IDAQuadSensEEtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to IDAS IF these variables are included in the error test. * * IDAQuadSensSStolerances specifies scalar relative and absolute tolerances. * IDAQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * IDAQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of IDAQuad**tolerances. * * The return value is equal to IDA_SUCCESS = 0 if there were no * errors; otherwise it is a negative int equal to: * IDA_MEM_NULL if ida_mem was NULL, or * IDA_NO_QUADSENS if there was not a prior call to * IDAQuadSensInit. * IDA_ILL_INPUT if an input argument was illegal * (e.g. negative tolerances) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAQuadSensSStolerances(void *ida_mem, realtype reltolQS, realtype *abstolQS); SUNDIALS_EXPORT int IDAQuadSensSVtolerances(void *ida_mem, realtype reltolQS, N_Vector *abstolQS); SUNDIALS_EXPORT int IDAQuadSensEEtolerances(void *ida_mem); /* * ----------------------------------------------------------------- * Function: IDASetQuadSensErrCon * ----------------------------------------------------------------- * IDASetQuadSensErrCon specifies if quadrature sensitivity variables * are considered or not in the error control. * * If yes, tolerances for quadrature sensitivity variables are * required. The function is optional, by default IDAS does not * quadrature sensitivities in error control. * * The return value is equal to IDA_SUCCESS = 0 if there were no * errors or IDA_MEM_NULL if ida_mem was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetQuadSensErrCon(void *ida_mem, booleantype errconQS); /* * ---------------------------------------------------------------- * Function : IDACalcIC * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for the DAE * system for a class of index-one problems of semi-implicit form. * It uses Newton iteration combined with a Linesearch algorithm. * Calling IDACalcIC is optional. It is only necessary when the * initial conditions do not solve the given system. I.e., if * y0 and yp0 are known to satisfy F(t0, y0, yp0) = 0, then * a call to IDACalcIC is NOT necessary (for index-one problems). * * A call to IDACalcIC must be preceded by a successful call to * IDAInit or IDAReInit for the given DAE problem, and by a * successful call to the linear system solver specification * routine. * * The call to IDACalcIC should precede the call(s) to IDASolve * for the given problem. * * The arguments to IDACalcIC are as follows: * * ida_mem is the pointer to IDA memory returned by IDACreate. * * icopt is the option of IDACalcIC to be used. * icopt = IDA_YA_YDP_INIT directs IDACalcIC to compute * the algebraic components of y and differential * components of y', given the differential * components of y. This option requires that the * N_Vector id was set through a call to IDASetId * specifying the differential and algebraic * components. * icopt = IDA_Y_INIT directs IDACalcIC to compute all * components of y, given y'. id is not required. * * tout1 is the first value of t at which a soluton will be * requested (from IDASolve). (This is needed here to * determine the direction of integration and rough scale * in the independent variable t.) * * * IDACalcIC returns an int flag. Its symbolic values and their * meanings are as follows. (The numerical return values are set * above in this file.) All unsuccessful returns give a negative * return value. If IFACalcIC failed, y0 and yp0 contain * (possibly) altered values, computed during the attempt. * * IDA_SUCCESS IDACalcIC was successful. The corrected * initial value vectors were stored internally. * * IDA_MEM_NULL The argument ida_mem was NULL. * * IDA_ILL_INPUT One of the input arguments was illegal. * See printed message. * * IDA_LINIT_FAIL The linear solver's init routine failed. * * IDA_BAD_EWT Some component of the error weight vector * is zero (illegal), either for the input * value of y0 or a corrected value. * * IDA_RES_FAIL The user's residual routine returned * a non-recoverable error flag. * * IDA_FIRST_RES_FAIL The user's residual routine returned * a recoverable error flag on the first call, * but IDACalcIC was unable to recover. * * IDA_LSETUP_FAIL The linear solver's setup routine had a * non-recoverable error. * * IDA_LSOLVE_FAIL The linear solver's solve routine had a * non-recoverable error. * * IDA_NO_RECOVERY The user's residual routine, or the linear * solver's setup or solve routine had a * recoverable error, but IDACalcIC was * unable to recover. * * IDA_CONSTR_FAIL IDACalcIC was unable to find a solution * satisfying the inequality constraints. * * IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a * solution with a step larger than steptol * in weighted RMS norm. * * IDA_CONV_FAIL IDACalcIC failed to get convergence of the * Newton iterations. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); /* * ---------------------------------------------------------------- * Function : IDASolve * ---------------------------------------------------------------- * IDASolve integrates the DAE over an interval in t, the * independent variable. If itask is IDA_NORMAL, then the solver * integrates from its current internal t value to a point at or * beyond tout, then interpolates to t = tout and returns y(tret) * in the user-allocated vector yret. In general, tret = tout. * If itask is IDA_ONE_STEP, then the solver takes one internal * step of the independent variable and returns in yret the value * of y at the new internal independent variable value. In this * case, tout is used only during the first call to IDASolve to * determine the direction of integration and the rough scale of * the problem. If tstop is enabled (through a call to IDASetStopTime), * then IDASolve returns the solution at tstop. Once the integrator * returns at a tstop time, any future testing for tstop is disabled * (and can be reenabled only though a new call to IDASetStopTime). * The time reached by the solver is placed in (*tret). The * user is responsible for allocating the memory for this value. * * ida_mem is the pointer (void) to IDA memory returned by * IDACreate. * * tout is the next independent variable value at which a * computed solution is desired. * * tret is a pointer to a real location. IDASolve sets (*tret) * to the actual t value reached, corresponding to the * solution vector yret. In IDA_NORMAL mode, with no * errors and no roots found, (*tret) = tout. * * yret is the computed solution vector. With no errors, * yret = y(tret). * * ypret is the derivative of the computed solution at t = tret. * * Note: yret and ypret may be the same N_Vectors as y0 and yp0 * in the call to IDAInit or IDAReInit. * * itask is IDA_NORMAL or IDA_ONE_STEP. These two modes are described above. * * * The return values for IDASolve are described below. * (The numerical return values are defined above in this file.) * All unsuccessful returns give a negative return value. * * IDA_SUCCESS * IDASolve succeeded and no roots were found. * * IDA_ROOT_RETURN: IDASolve succeeded, and found one or more roots. * If nrtfn > 1, call IDAGetRootInfo to see which g_i were found * to have a root at (*tret). * * IDA_TSTOP_RETURN: * IDASolve returns computed results for the independent variable * value tstop. That is, tstop was reached. * * IDA_MEM_NULL: * The ida_mem argument was NULL. * * IDA_ILL_INPUT: * One of the inputs to IDASolve is illegal. This includes the * situation when a component of the error weight vectors * becomes < 0 during internal stepping. It also includes the * situation where a root of one of the root functions was found * both at t0 and very near t0. The ILL_INPUT flag * will also be returned if the linear solver function IDA--- * (called by the user after calling IDACreate) failed to set one * of the linear solver-related fields in ida_mem or if the linear * solver's init routine failed. In any case, the user should see * the printed error message for more details. * * IDA_TOO_MUCH_WORK: * The solver took mxstep internal steps but could not reach tout. * The default value for mxstep is MXSTEP_DEFAULT = 500. * * IDA_TOO_MUCH_ACC: * The solver could not satisfy the accuracy demanded by the user * for some internal step. * * IDA_ERR_FAIL: * Error test failures occurred too many times (=MXETF = 10) during * one internal step. * * IDA_CONV_FAIL: * Convergence test failures occurred too many times (= MXNCF = 10) * during one internal step. * * IDA_LSETUP_FAIL: * The linear solver's setup routine failed * in an unrecoverable manner. * * IDA_LSOLVE_FAIL: * The linear solver's solve routine failed * in an unrecoverable manner. * * IDA_CONSTR_FAIL: * The inequality constraints were violated, * and the solver was unable to recover. * * IDA_REP_RES_ERR: * The user's residual function repeatedly returned a recoverable * error flag, but the solver was unable to recover. * * IDA_RES_FAIL: * The user's residual function returned a nonrecoverable error * flag. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); /* * ---------------------------------------------------------------- * Function: IDAGetDky * ---------------------------------------------------------------- * * This routine computes the k-th derivative of the interpolating * polynomial at the time t and stores the result in the vector dky. * * The return values are: * IDA_SUCCESS: succeess. * IDA_BAD_T: t is not in the interval [tn-hu,tn]. * IDA_MEM_NULL: The ida_mem argument was NULL. * IDA_BAD_DKY if the dky vector is NULL. * IDA_BAD_K if the requested k is not in the range 0,1,...,order used * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky); /* ---------------------------------------------------------------- * Integrator optional output extraction functions * ---------------------------------------------------------------- * * The following functions can be called to get optional outputs * and statistics related to the main integrator. * ---------------------------------------------------------------- * * IDAGetWorkSpace returns the IDA real and integer workspace sizes * IDAGetNumSteps returns the cumulative number of internal * steps taken by the solver * IDAGetNumResEvals returns the number of calls to the user's * res function * IDAGetNumLinSolvSetups returns the number of calls made to * the linear solver's setup routine * IDAGetNumErrTestFails returns the number of local error test * failures that have occured * IDAGetNumBacktrackOps returns the number of backtrack * operations done in the linesearch algorithm in IDACalcIC * IDAGetConsistentIC returns the consistent initial conditions * computed by IDACalcIC * IDAGetLastOrder returns the order used during the last * internal step * IDAGetCurentOrder returns the order to be used on the next * internal step * IDAGetActualInitStep returns the actual initial step size * used by IDA * IDAGetLastStep returns the step size for the last internal * step (if from IDASolve), or the last value of the * artificial step size h (if from IDACalcIC) * IDAGetCurrentStep returns the step size to be attempted on the * next internal step * IDAGetCurrentTime returns the current internal time reached * by the solver * IDAGetTolScaleFactor returns a suggested factor by which the * user's tolerances should be scaled when too much * accuracy has been requested for some internal step * IDAGetErrWeights returns the current state error weight vector. * The user must allocate space for eweight. * IDAGetEstLocalErrors returns the estimated local errors. The user * must allocate space for the vector ele. * IDAGetNumGEvals returns the number of calls to the user's * g function (for rootfinding) * IDAGetRootInfo returns the indices for which g_i was found to * have a root. The user must allocate space for rootsfound. * For i = 0 ... nrtfn-1, rootsfound[i] = 1 if g_i has a root, * and rootsfound[i]= 0 if not. * * IDAGet* return values: * IDA_SUCCESS if succesful * IDA_MEM_NULL if the IDAS memory was NULL * IDA_ILL_INPUT if some input is illegal * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, N_Vector yp0_mod); SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); /* * ---------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in a group. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); /* * ---------------------------------------------------------------- * Nonlinear solver optional output extraction functions * ---------------------------------------------------------------- * * The following functions can be called to get optional outputs * and statistics related to the nonlinear solver. * -------------------------------------------------------------- * * IDAGetNumNonlinSolvIters returns the number of nonlinear * solver iterations performed. * IDAGetNumNonlinSolvConvFails returns the number of nonlinear * convergence failures. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); /* * ---------------------------------------------------------------- * As a convenience, the following function provides the * nonlinear solver optional outputs in a group. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails); /* * ----------------------------------------------------------------- * Quadrature integration solution extraction routines * ----------------------------------------------------------------- * The following function can be called to obtain the quadrature * variables after a successful integration step. * If quadratures were not computed, it returns IDA_NO_QUAD. * * IDAGetQuad returns the quadrature variables at the same time * as that at which IDASolve returned the solution. * * IDAGetQuadDky returns the quadrature variables (or their * derivatives up to the current method order) at any time within * the last integration step (dense output). * * The output vectors yQout and dky must be allocated by the user. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuad(void *ida_mem, realtype *t, N_Vector yQout); SUNDIALS_EXPORT int IDAGetQuadDky(void *ida_mem, realtype t, int k, N_Vector dky); /* * ----------------------------------------------------------------- * Quadrature integration optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the integration of quadratures. * ----------------------------------------------------------------- * IDAGetQuadNumRhsEvals returns the number of calls to the * user function rhsQ defining the right hand * side of the quadrature variables. * IDAGetQuadNumErrTestFails returns the number of local error * test failures for quadrature variables. * IDAGetQuadErrWeights returns the vector of error weights for * the quadrature variables. The user must * allocate space for ewtQ. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuadNumRhsEvals(void *ida_mem, long int *nrhsQevals); SUNDIALS_EXPORT int IDAGetQuadNumErrTestFails(void *ida_mem, long int *nQetfails); SUNDIALS_EXPORT int IDAGetQuadErrWeights(void *ida_mem, N_Vector eQweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuadStats(void *ida_mem, long int *nrhsQevals, long int *nQetfails); /* * ----------------------------------------------------------------- * Sensitivity solution extraction routines * ----------------------------------------------------------------- * The following functions can be called to obtain the sensitivity * variables after a successful integration step. * * IDAGetSens and IDAGetSens1 return all the sensitivity vectors * or only one of them, respectively, at the same time as that at * which IDASolve returned the solution. * The array of output vectors or output vector ySout must be * allocated by the user. * * IDAGetSensDky1 computes the kth derivative of the is-th * sensitivity (is=1, 2, ..., Ns) of the y function at time t, * where tn-hu <= t <= tn, tn denotes the current internal time * reached, and hu is the last internal step size successfully * used by the solver. The user may request k=0, 1, ..., qu, * where qu is the current order. * The is-th sensitivity derivative vector is returned in dky. * This vector must be allocated by the caller. It is only legal * to call this function after a successful return from IDASolve * with sensitivity computations enabled. * Arguments have the same meaning as in IDADGetky. * * IDAGetSensDky computes the k-th derivative of all * sensitivities of the y function at time t. It repeatedly calls * IDAGetSensDky. The argument dkyS must be a pointer to * N_Vector and must be allocated by the user to hold at least Ns * vectors. * * Return values are similar to those of IDAGetDky. Additionally, * these functions can return IDA_NO_SENS if sensitivities were * not computed and IDA_BAD_IS if is < 0 or is >= Ns. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetSens(void *ida_mem, realtype *tret, N_Vector *yySout); SUNDIALS_EXPORT int IDAGetSens1(void *ida_mem, realtype *tret, int is, N_Vector yySret); SUNDIALS_EXPORT int IDAGetSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyS); SUNDIALS_EXPORT int IDAGetSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyS); /* * ----------------------------------------------------------------- * Consistent sensitivity IC calculation optional outputs * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetSensConsistentIC(void *ida_mem, N_Vector *yyS0, N_Vector *ypS0); /* * ----------------------------------------------------------------- * Forward sensitivity optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the integration of sensitivities. * ----------------------------------------------------------------- * IDAGetSensNumResEvals returns the number of calls to the * sensitivity residual function. * IDAGetNumResEvalsSens returns the number of calls to the * user res routine due to finite difference * evaluations of the sensitivity equations. * IDAGetSensNumErrTestFails returns the number of local error * test failures for sensitivity variables. * IDAGetSensNumLinSolvSetups returns the number of calls made * to the linear solver's setup routine * due to sensitivity computations. * IDAGetSensErrWeights returns the sensitivity error weight * vectors. The user need not allocate space * for ewtS. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetSensNumResEvals(void *ida_mem, long int *nresSevals); SUNDIALS_EXPORT int IDAGetNumResEvalsSens(void *ida_mem, long int *nresevalsS); SUNDIALS_EXPORT int IDAGetSensNumErrTestFails(void *ida_mem, long int *nSetfails); SUNDIALS_EXPORT int IDAGetSensNumLinSolvSetups(void *ida_mem, long int *nlinsetupsS); SUNDIALS_EXPORT int IDAGetSensErrWeights(void *ida_mem, N_Vector_S eSweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetSensStats(void *ida_mem, long int *nresSevals, long int *nresevalsS, long int *nSetfails, long int *nlinsetupsS); /* * ---------------------------------------------------------------- * Sensitivity nonlinear solver optional output extraction functions * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetSensNumNonlinSolvIters(void *ida_mem, long int *nSniters); SUNDIALS_EXPORT int IDAGetSensNumNonlinSolvConvFails(void *ida_mem, long int *nSncfails); SUNDIALS_EXPORT int IDAGetSensNonlinSolvStats(void *ida_mem, long int *nSniters, long int *nSncfails); /* * ----------------------------------------------------------------- * Quadrature sensitivity optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs and * statistics related to the integration of quadrature sensitivitiess. * ----------------------------------------------------------------- * IDAGetQuadSensNumRhsEvals returns the number of calls to the * user function fQS defining the right hand side of the * quadrature sensitivity equations. * IDAGetQuadSensNumErrTestFails returns the number of local error * test failures for quadrature sensitivity variables. * IDAGetQuadSensErrWeights returns the vector of error weights * for the quadrature sensitivity variables. The user must * allocate space for ewtQS. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuadSensNumRhsEvals(void *ida_mem, long int *nrhsQSevals); SUNDIALS_EXPORT int IDAGetQuadSensNumErrTestFails(void *ida_mem, long int *nQSetfails); SUNDIALS_EXPORT int IDAGetQuadSensErrWeights(void *ida_mem, N_Vector *eQSweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the above * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuadSensStats(void *ida_mem, long int *nrhsQSevals, long int *nQSetfails); /* * ----------------------------------------------------------------- * Quadrature Sensitivity solution extraction routines * ----------------------------------------------------------------- * The following functions can be called to obtain the sensitivity * variables after a successful integration step. * * IDAGetQuadSens and IDAGetQuadSens1 return all the sensitivity * vectors or only one of them, respectively, at the same time * as that at which IDASolve returned the solution. * The array of output vectors or output vector yQSout must be * allocated by the user. * * IDAGetQuadSensDky1 computes the kth derivative of the is-th * sensitivity (is=1, 2, ..., Ns) of the quadrature function at * time t, where tn - hu <= t <= tn, tn denotes the current * internal time reached and hu is the last internal * successfully step size. The user may request k=0,..., qu, * where qu is the current order. * * The is-th sensitivity derivative vector is returned in dky. * This vector must be allocated by the caller. It is only legal * to call this function after a successful return from IDASolve * with sensitivity computations enabled. * Arguments have the same meaning as in IDADGetky. * * IDAGetQuadSensDky computes the k-th derivative of all * sensitivities of the y function at time t. It repeatedly calls * IDAGetQuadSensDky. The argument dkyS must be a pointer to * N_Vector and must be allocated by the user to hold at least Ns * vectors. * * Return values are similar to those of IDAGetDky. Additionally, * these functions can return IDA_NO_SENS if sensitivities were * not computed and IDA_BAD_IS if is < 0 or is >= Ns. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetQuadSens(void *ida_mem, realtype *tret, N_Vector *yyQSout); SUNDIALS_EXPORT int IDAGetQuadSens1(void *ida_mem, realtype *tret, int is, N_Vector yyQSret); SUNDIALS_EXPORT int IDAGetQuadSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyQS); SUNDIALS_EXPORT int IDAGetQuadSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyQS); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with an IDAS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDAGetReturnFlagName(long int flag); /* * ---------------------------------------------------------------- * Function : IDAFree * ---------------------------------------------------------------- * IDAFree frees the problem memory IDA_mem allocated by * IDAInit. Its only argument is the pointer idamem * returned by IDAInit. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT void IDAFree(void **ida_mem); /* * ----------------------------------------------------------------- * Function : IDAQuadFree * ----------------------------------------------------------------- * IDAQuadFree frees the problem memory in ida_mem allocated * for quadrature integration. Its only argument is the pointer * ida_mem returned by IDACreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void IDAQuadFree(void *ida_mem); /* * ----------------------------------------------------------------- * Function : IDASensFree * ----------------------------------------------------------------- * IDASensFree frees the problem memory in ida_mem allocated * for sensitivity analysis. Its only argument is the pointer * ida_mem returned by IDACreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void IDASensFree(void *ida_mem); /* * ----------------------------------------------------------------- * Function : IDAQuadSensFree * ----------------------------------------------------------------- * IDAQuadSensFree frees the problem memory in ida_mem allocated * for quadrature sensitivity analysis. Its only argument is the * pointer ida_mem returned by IDACreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void IDAQuadSensFree(void* ida_mem); /* * ================================================================= * * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * IDAAdjInit * ----------------------------------------------------------------- * IDAAdjInit specifies some parameters for ASA, initializes ASA * and allocates space for the adjoint memory structure. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAAdjInit(void *ida_mem, long int steps, int interp); /* * ----------------------------------------------------------------- * IDAAdjReInit * ----------------------------------------------------------------- * IDAAdjReInit reinitializes the IDAS memory structure for ASA, * assuming that the number of steps between check points and the * type of interpolation remained unchanged. The list of check points * (and associated memory) is deleted. The list of backward problems * is kept (however, new backward problems can be added to this list * by calling IDACreateB). The IDAS memory for the forward and * backward problems can be reinitialized separately by calling * IDAReInit and IDAReInitB, respectively. * NOTE: if a entirely new list of backward problems is desired, * then simply free the adjoint memory (by calling IDAAdjFree) * and reinitialize ASA with IDAAdjReInit * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAAdjReInit(void *ida_mem); /* * ----------------------------------------------------------------- * IDAAdjFree * ----------------------------------------------------------------- * IDAAdjFree frees the memory allocated by IDAAdjInit. * It is typically called by IDAFree. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void IDAAdjFree(void *ida_mem); /* * ================================================================= * * OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ================================================================= * * Interfaces to IDAS functions for setting-up backward problems. * * ================================================================= */ SUNDIALS_EXPORT int IDACreateB(void *ida_mem, int *which); SUNDIALS_EXPORT int IDAInitB(void *ida_mem, int which, IDAResFnB resB, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDAInitBS(void *ida_mem, int which, IDAResFnBS resS, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDAReInitB(void *ida_mem, int which, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDASStolerancesB(void *ida_mem, int which, realtype relTolB, realtype absTolB); SUNDIALS_EXPORT int IDASVtolerancesB(void *ida_mem, int which, realtype relTolB, N_Vector absTolB); SUNDIALS_EXPORT int IDAQuadInitB(void *ida_mem, int which, IDAQuadRhsFnB rhsQB, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadInitBS(void *ida_mem, int which, IDAQuadRhsFnBS rhsQS, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadReInitB(void *ida_mem, int which, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadSStolerancesB(void *ida_mem, int which, realtype reltolQB, realtype abstolQB); SUNDIALS_EXPORT int IDAQuadSVtolerancesB(void *ida_mem, int which, realtype reltolQB, N_Vector abstolQB); /* * ---------------------------------------------------------------- * The following functions computes consistent initial conditions * for the backward problems. * ---------------------------------------------------------------- * Function : IDACalcICB * ---------------------------------------------------------------- * IDACalcICB calculates corrected initial conditions for a DAE * backward system (index-one in semi-implicit form). * ---------------------------------------------------------------- * Function : IDACalcICBS * ---------------------------------------------------------------- * IDACalcICBS calculates corrected initial conditions for a DAE * backward problems that also depends on the sensitivities. * * They use Newton iteration combined with a Linesearch algorithm. * * Calling IDACalcICB(S) is optional. It is only necessary when the * initial conditions do not solve the given system. I.e., if * yB0 and ypB0 are known to satisfy the backward problem, then * a call to IDACalcICB is NOT necessary (for index-one problems). * * Any call to IDACalcICB(S) should precede the call(s) to * IDASolveB for the given problem. * * The functions compute the algebraic components of y and * differential components of y', given the differential * components of y. This option requires that the N_Vector id was * set through a call to IDASetIdB specifying the differential and * algebraic components. * * The arguments to IDACalcICB(S) are as follows: * * ida_mem is the pointer to IDA memory returned by IDACreate. * * which is the index of the backward problem returned by * IDACreateB * * tout1 is the first value of t at which a soluton will be * requested (from IDASolveB). (This is needed here to * determine the direction of integration and rough * scale in the independent variable t.) * * yy0 state variables y and y' corresponding to the initial * yp0 time at which the backward problem is (re)started. * * yyS0 sensitivities variables corresponding to the initial * ypS0 time at which the backward problem is (re)started. * * Return value is a int flag. For more information see IDACalcIC. */ SUNDIALS_EXPORT int IDACalcICB (void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0); SUNDIALS_EXPORT int IDACalcICBS(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0, N_Vector *yyS0, N_Vector *ypS0); /* * ================================================================= * * MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * IDASolveF * ----------------------------------------------------------------- * IDASolveF integrates towards tout and returns solution into yret * and ypret. * * In the same time, it stores check point data every 'steps'. * * IDASolveF can be called repeatedly by the user. * * ncheckPtr represents the number of check points stored so far. * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASolveF(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask, int *ncheckPtr); /* * ----------------------------------------------------------------- * IDASolveB * ----------------------------------------------------------------- * IDASolveB performs the integration of all backward problems * specified through calls to IDACreateB through a sequence of * forward-backward runs in between consecutive check points. It can * be called either in IDA_NORMAL or IDA_ONE_STEP mode. After a * successful return from IDASolveB, the solution and quadrature * variables at the current return time for any given backward * problem can be obtained by calling IDAGetB and IDAGetQuadB. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASolveB(void *ida_mem, realtype tBout, int itaskB); /* * ================================================================= * * OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * IDASetAdjNoSensi * ----------------------------------------------------------------- * Disables the forward sensitivity analysis in IDASolveF. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetAdjNoSensi(void *ida_mem); /* * ----------------------------------------------------------------- * Optional input functions for backward problems * ----------------------------------------------------------------- * These functions are just wrappers around the corresponding * functions from the forward module, with some particularizations * for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetUserDataB(void *ida_mem, int which, void *user_dataB); SUNDIALS_EXPORT int IDASetMaxOrdB(void *ida_mem, int which, int maxordB); SUNDIALS_EXPORT int IDASetMaxNumStepsB(void *ida_mem, int which, long int mxstepsB); SUNDIALS_EXPORT int IDASetInitStepB(void *ida_mem, int which, realtype hinB); SUNDIALS_EXPORT int IDASetMaxStepB(void *ida_mem, int which, realtype hmaxB); SUNDIALS_EXPORT int IDASetSuppressAlgB(void *ida_mem, int which, booleantype suppressalgB); SUNDIALS_EXPORT int IDASetIdB(void *ida_mem, int which, N_Vector idB); SUNDIALS_EXPORT int IDASetConstraintsB(void *ida_mem, int which, N_Vector constraintsB); SUNDIALS_EXPORT int IDASetQuadErrConB(void *ida_mem, int which, int errconQB); /* * ================================================================= * * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * IDAGetB and IDAGetQuadB * ----------------------------------------------------------------- * Extraction functions for the solution and quadratures for a given * backward problem. They return their corresponding output vector * at the current time reached by the integration of the backward * problem. To obtain the solution or quadratures associated with * a given backward problem at some other time within the last * integration step (dense output), first obtain a pointer to the * proper IDAS memory by calling IDAGetAdjIDABmem and then use it * to call IDAGetDky and IDAGetQuadDky. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetB(void* ida_mem, int which, realtype *tret, N_Vector yy, N_Vector yp); SUNDIALS_EXPORT int IDAGetQuadB(void *ida_mem, int which, realtype *tret, N_Vector qB); /* * ================================================================= * * OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * IDAGetAdjIDABmem * ----------------------------------------------------------------- * IDAGetAdjIDABmem returns a (void *) pointer to the IDAS * memory allocated for the backward problem. This pointer can * then be used to call any of the IDAGet* IDAS routines to * extract optional output for the backward integration phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void *IDAGetAdjIDABmem(void *ida_mem, int which); /* * ----------------------------------------------------------------- * IDAGetConsistentICB * ----------------------------------------------------------------- * IDAGetConsistentIC returns the consistent initial conditions * computed by IDACalcICB or IDCalcICBS */ SUNDIALS_EXPORT int IDAGetConsistentICB(void *ida_mem, int which, N_Vector yyB0, N_Vector ypB0); /* * ----------------------------------------------------------------- * IDAGetAdjY * ----------------------------------------------------------------- * Returns the interpolated forward solution at time t. This * function is a wrapper around the interpType-dependent internal * function. * The calling function must allocate space for yy and yp. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetAdjY(void *ida_mem, realtype t, N_Vector yy, N_Vector yp); /* * ----------------------------------------------------------------- * IDAGetAdjCheckPointsInfo * ----------------------------------------------------------------- * Loads an array of nckpnts structures of type IDAadjCheckPointRec * defined below. * * The user must allocate space for ckpnt (ncheck+1). * ----------------------------------------------------------------- */ typedef struct { void *my_addr; void *next_addr; realtype t0; realtype t1; long int nstep; int order; realtype step; } IDAadjCheckPointRec; SUNDIALS_EXPORT int IDAGetAdjCheckPointsInfo(void *ida_mem, IDAadjCheckPointRec *ckpnt); /* * ----------------------------------------------------------------- * IDAGetAdjDataPointHermite * ----------------------------------------------------------------- * Returns the 2 vectors stored for cubic Hermite interpolation at * the data point 'which'. The user must allocate space for yy and * yd. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_HERMITE or * IDA_SUCCESS otherwise. * * ----------------------------------------------------------------- * IDAGetAdjDataPointPolynomial * ----------------------------------------------------------------- * Returns the vector stored for polynomial interpolation at the * data point 'which'. The user must allocate space for y. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_POLYNOMIAL or * IDA_SUCCESS otherwise. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetAdjDataPointHermite(void *ida_mem, int which, realtype *t, N_Vector yy, N_Vector yd); SUNDIALS_EXPORT int IDAGetAdjDataPointPolynomial(void *ida_mem, int which, realtype *t, int *order, N_Vector y); /* * ----------------------------------------------------------------- * IDAGetAdjCurrentCheckPoint * ----------------------------------------------------------------- * Returns the address of the 'active' check point. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetAdjCurrentCheckPoint(void *ida_mem, void **addr); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_spbcgs.h0000600000175000017500000000505411741421242021211 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/07/05 19:10:36 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the IDAS scaled preconditioned * Bi-CGSTAB linear solver module, IDASPBCG. * * Part I contains function prototypes for using IDASPBCG on forward * problems (DAE integration and/or FSA) * * Part II contains function prototypes for using IDASPBCG on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _IDASSPBCG_H #define _IDASSPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : IDASpbcg * ----------------------------------------------------------------- * A call to the IDASpbcg function links the main integrator with * the IDASPBCG linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value. * Otherwise pass a positive integer. * * The return values of IDASpbcg are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the IDAS memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in idas_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpbcg(void *ida_mem, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpbcgB(void *ida_mem, int which, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_band.h0000600000175000017500000000655011741421242020636 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDAS band linear solver * module, IDABAND. It interfaces between the band module and the * integrator when a banded linear solver is appropriate. * * Part I contains type definitions and function prototypes for using * IDABAND on forward problems (DAE integration and/or FSA) * * Part II contains type definitions and function prototypes for using * IDABAND on adjoint (backward) problems * ----------------------------------------------------------------- */ #ifndef _IDASBAND_H #define _IDASBAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDABand * ----------------------------------------------------------------- * A call to the IDABand function links the main integrator * with the IDABAND linear solver module. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * mupper is the upper bandwidth of the banded Jacobian matrix. * * mlower is the lower bandwidth of the banded Jacobian matrix. * * The return values of IDABand are: * IDADLS_SUCCESS = 0 if successful * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure * IDADLS_ILL_INPUT = -2 if the input was illegal or NVECTOR bad. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDABand will first * test for a compatible N_Vector internal representation * by checking that the N_VGetArrayPointer function exists. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABand(void *ida_mem, long int Neq, long int mupper, long int mlower); /* * ----------------------------------------------------------------- * Function: IDABandB * ----------------------------------------------------------------- * IDABandB links the main IDAS integrator with the IDABAND * linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABandB(void *idaadj_mem, int which, long int NeqB, long int mupperB, long int mlowerB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_dense.h0000600000175000017500000000543211741421242021026 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDADENSE linear solver module. * ----------------------------------------------------------------- */ #ifndef _IDASDENSE_H #define _IDASDENSE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDADense * ----------------------------------------------------------------- * A call to the IDADense function links the main integrator * with the IDADENSE linear solver module. * * ida_mem is the pointer to integrator memory returned by * IDACreate. * * Neq is the problem size * * IDADense returns: * IDADLS_SUCCESS = 0 if successful * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure * IDADLS_ILL_INPUT = -2 if NVECTOR found incompatible * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDADense will first * test for a compatible N_Vector internal representation * by checking that the functions N_VGetArrayPointer and * N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADense(void *ida_mem, long int Neq); /* * ----------------------------------------------------------------- * Function: IDADenseB * ----------------------------------------------------------------- * IDADenseB links the main IDAS integrator with the IDADENSE * linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADenseB(void *ida_mem, int which, long int NeqB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_spgmr.h0000600000175000017500000000623511741421242021062 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/07/05 19:10:36 $ * ----------------------------------------------------------------- * Programmers: Alan Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the header file for the IDAS Scaled Preconditioned GMRES * linear solver module, IDASPGMR. * * Part I contains function prototypes for using IDASPGMR on forward * problems (DAE integration and/or FSA) * * Part II contains function prototypes for using IDASPGMR on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _IDASSPGMR_H #define _IDASSPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * * Function : IDASpgmr * ----------------------------------------------------------------- * A call to the IDASpgmr function links the main integrator with * the IDASPGMR linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value, * MIN(Neq, 5). Otherwise pass a positive integer. * * The return values of IDASpgmr are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the IDAS memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in idas_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpgmr(void *ida_mem, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpgmrB(void *ida_mem, int which, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/idas/idas_spils.h0000600000175000017500000004170411741421242021064 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2010/12/01 22:15:15 $ * ----------------------------------------------------------------- * Programmers: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the common header file for the Scaled and Preconditioned * Iterative Linear Solvers in IDAS. * ----------------------------------------------------------------- */ #ifndef _IDASSPILS_H #define _IDASSPILS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * IDASPILS return values * ----------------------------------------------------------------- */ #define IDASPILS_SUCCESS 0 #define IDASPILS_MEM_NULL -1 #define IDASPILS_LMEM_NULL -2 #define IDASPILS_ILL_INPUT -3 #define IDASPILS_MEM_FAIL -4 #define IDASPILS_PMEM_NULL -5 /* Return values for the adjoint module */ #define IDASPILS_NO_ADJ -101 #define IDASPILS_LMEMB_NULL -102 /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSetupFn * ----------------------------------------------------------------- * The optional user-supplied functions PrecSetup and PrecSolve * together must define the left preconditoner matrix P * approximating the system Jacobian matrix * J = dF/dy + c_j*dF/dy' * (where the DAE system is F(t,y,y') = 0), and solve the linear * systems P z = r. PrecSetup is to do any necessary setup * operations, and PrecSolve is to compute the solution of * P z = r. * * The preconditioner setup function PrecSetup is to evaluate and * preprocess any Jacobian-related data needed by the * preconditioner solve function PrecSolve. This might include * forming a crude approximate Jacobian, and performing an LU * factorization on it. This function will not be called in * advance of every call to PrecSolve, but instead will be called * only as often as necessary to achieve convergence within the * Newton iteration. If the PrecSolve function needs no * preparation, the PrecSetup function can be NULL. * * Each call to the PrecSetup function is preceded by a call to * the system function res with the same (t,y,y') arguments. * Thus the PrecSetup function can use any auxiliary data that is * computed and saved by the res function and made accessible * to PrecSetup. * * A preconditioner setup function PrecSetup must have the * prototype given below. Its parameters are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the current value of the residual vector F(t,y,y'). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * user_data is a pointer to user data, the same as the user_data * parameter passed to IDASetUserData. * * tmp1, tmp2, tmp3 are pointers to vectors of type N_Vector * which can be used by an IDASpilsPrecSetupFn routine * as temporary storage or work space. * * NOTE: If the user's preconditioner needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively (see * ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * The IDASpilsPrecSetupFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSetupFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSolveFn * ----------------------------------------------------------------- * The optional user-supplied function PrecSolve must compute a * solution to the linear system P z = r, where P is the left * preconditioner defined by the user. If no preconditioning * is desired, pass NULL for PrecSolve to IDASp*. * * A preconditioner solve function PrecSolve must have the * prototype given below. Its parameters are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector y. * * yp is the current value of the derivative vector y'. * * rr is the current value of the residual vector F(t,y,y'). * * rvec is the input right-hand side vector r. * * zvec is the computed solution vector z. * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * delta is an input tolerance for use by PrecSolve if it uses an * iterative method in its solution. In that case, the * the residual vector r - P z of the system should be * made less than delta in weighted L2 norm, i.e., * sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta . * Note: the error weight vector ewt can be obtained * through a call to the routine IDAGetErrWeights. * * user_data is a pointer to user data, the same as the user_data * parameter passed to IDASetUserData. * * tmp is an N_Vector which can be used by the PrecSolve * routine as temporary storage or work space. * * The IDASpilsPrecSolveFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * Following a recoverable error, the integrator will attempt to * recover by updating the preconditioner and/or reducing the * stepsize. * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSolveFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Type : IDASpilsJacTimesVecFn * ----------------------------------------------------------------- * The user-supplied function jtimes is to generate the product * J*v for given v, where J is the Jacobian matrix * J = dF/dy + c_j*dF/dy' * or an approximation to it, and v is a given vector. * It should return 0 if successful and a nonzero int otherwise. * * A function jtimes must have the prototype given below. Its * parameters are as follows: * * tt is the current value of the independent variable. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the current value of the residual vector F(t,y,y'). * * v is the N_Vector to be multiplied by J. * * Jv is the output N_Vector containing J*v. * * c_j is the scalar in the system Jacobian, proportional * to 1/hh. * * user_data is a pointer to user data, the same as the * pointer passed to IDASetUserData. * * tmp1, tmp2 are two N_Vectors which can be used by Jtimes for * work space. * ----------------------------------------------------------------- */ typedef int (*IDASpilsJacTimesVecFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Optional inputs to the IDASPILS linear solver * ----------------------------------------------------------------- * * IDASpilsSetPreconditioner specifies the PrecSetup and PrecSolve * functions, as well as a pointer to user preconditioner * data. This pointer is passed to PrecSetup and PrecSolve * every time these routines are called. * Default is NULL for al three arguments. * IDASpilsSetJacTimesVecFn specifies the jtimes function. * Default is to use an internal finite difference * approximation routine. * IDASpilsSetGSType specifies the type of Gram-Schmidt * orthogonalization to be used. This must be one of * the two enumeration constants MODIFIED_GS or * CLASSICAL_GS defined in iterativ.h. These correspond * to using modified Gram-Schmidt and classical * Gram-Schmidt, respectively. * Default value is MODIFIED_GS. * Only for IDASPGMR. * IDASpilsSetMaxRestarts specifies the maximum number of restarts * to be used in the GMRES algorithm. maxrs must be a * non-negative integer. Pass 0 to specify no restarts. * Default is 5. * Only for IDASPGMR. * IDASpbcgSetMaxl specifies the maximum Krylov subspace size. * Default is 5. * Only for IDASPBCG and IDASPTFQMR. * IDASpilsSetEpsLin specifies the factor in the linear iteration * convergence test constant. * Default is 0.05 * IDASpilsSetIncrementFactor specifies a factor in the increments * to yy used in the difference quotient approximations * to matrix-vector products Jv. * Default is 1.0 * * The return value of IDASpilsSet* is one of: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the IDAS memory was NULL * IDASPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve); SUNDIALS_EXPORT int IDASpilsSetJacTimesVecFn(void *ida_mem, IDASpilsJacTimesVecFn jtv); SUNDIALS_EXPORT int IDASpilsSetGSType(void *ida_mem, int gstype); SUNDIALS_EXPORT int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs); SUNDIALS_EXPORT int IDASpilsSetMaxl(void *ida_mem, int maxl); SUNDIALS_EXPORT int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); SUNDIALS_EXPORT int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); /* * ----------------------------------------------------------------- * Optional outputs from the IDASPILS linear solver *---------------------------------------------------------------- * * IDASpilsGetWorkSpace returns the real and integer workspace used * by IDASPILS. * IDASpilsGetNumPrecEvals returns the number of preconditioner * evaluations, i.e. the number of calls made to PrecSetup * with jok==FALSE. * IDASpilsGetNumPrecSolves returns the number of calls made to * PrecSolve. * IDASpilsGetNumLinIters returns the number of linear iterations. * IDASpilsGetNumConvFails returns the number of linear * convergence failures. * IDASpilsGetNumJtimesEvals returns the number of calls to jtimes * IDASpilsGetNumResEvals returns the number of calls to the user * res routine due to finite difference Jacobian times vector * evaluation. * IDASpilsGetLastFlag returns the last error flag set by any of * the IDASPILS interface functions. * * The return value of IDASpilsGet* is one of: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the IDAS memory was NULL * IDASPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); SUNDIALS_EXPORT int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); SUNDIALS_EXPORT int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); SUNDIALS_EXPORT int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); SUNDIALS_EXPORT int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); SUNDIALS_EXPORT int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); SUNDIALS_EXPORT int IDASpilsGetLastFlag(void *ida_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a IDASPILS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDASpilsGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSetupFnB * ----------------------------------------------------------------- * A function PrecSetupB for the adjoint (backward) problem must have * the prototype given below. * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSetupFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSolveFnB * ----------------------------------------------------------------- * A function PrecSolveB for the adjoint (backward) problem must * have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSolveFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *user_dataB, N_Vector tmpB); /* * ----------------------------------------------------------------- * Type : IDASpilsJacTimesVecFnB * ----------------------------------------------------------------- * A function jtimesB for the adjoint (backward) problem must have * the prototype given below. * ----------------------------------------------------------------- */ typedef int (*IDASpilsJacTimesVecFnB)(realtype t, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B); /* * ----------------------------------------------------------------- * Functions * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpilsSetGSTypeB(void *ida_mem, int which, int gstypeB); SUNDIALS_EXPORT int IDASpilsSetMaxRestartsB(void *ida_mem, int which, int maxrsB); SUNDIALS_EXPORT int IDASpilsSetEpsLinB(void *ida_mem, int which, realtype eplifacB); SUNDIALS_EXPORT int IDASpilsSetMaxlB(void *ida_mem, int which, int maxlB); SUNDIALS_EXPORT int IDASpilsSetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB); SUNDIALS_EXPORT int IDASpilsSetPreconditionerB(void *ida_mem, int which, IDASpilsPrecSetupFnB psetB, IDASpilsPrecSolveFnB psolveB); SUNDIALS_EXPORT int IDASpilsSetJacTimesVecFnB(void *ida_mem, int which, IDASpilsJacTimesVecFnB jtvB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/0000755000175000017500000000000011767174700016414 5ustar sylvestresylvestresundials-2.5.0/include/ida/ida_bbdpre.h0000600000175000017500000002600711741421215020621 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:14:08 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDABBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with IDA and * IDASPGMR/IDASPBCG/IDASPTFQMR. * * Summary: * * These routines provide a preconditioner matrix that is * block-diagonal with banded blocks. The blocking corresponds * to the distribution of the dependent variable vector y among * the processors. Each preconditioner block is generated from * the Jacobian of the local part (on the current processor) of a * given function G(t,y,y') approximating F(t,y,y'). The blocks * are generated by a difference quotient scheme on each processor * independently. This scheme utilizes an assumed banded structure * with given half-bandwidths, mudq and mldq. However, the banded * Jacobian block kept by the scheme has half-bandwiths mukeep and * mlkeep, which may be smaller. * * The user's calling program should have the following form: * * #include * #include * ... * y0 = N_VNew_Parallel(...); * yp0 = N_VNew_Parallel(...); * ... * ida_mem = IDACreate(...); * ier = IDAInit(...); * ... * flag = IDASptfqmr(ida_mem, maxl); * -or- * flag = IDASpgmr(ida_mem, maxl); * -or- * flag = IDASpbcg(ida_mem, maxl); * ... * flag = IDABBDPrecInit(ida_mem, Nlocal, mudq, mldq, * mukeep, mlkeep, dq_rel_yy, Gres, Gcomm); * ... * ier = IDASolve(...); * ... * IDAFree(&ida_mem); * * N_VDestroy(y0); * N_VDestroy(yp0); * * The user-supplied routines required are: * * res is the function F(t,y,y') defining the DAE system to * be solved: F(t,y,y') = 0. * * Gres is the function defining a local approximation * G(t,y,y') to F, for the purposes of the preconditioner. * * Gcomm is the function performing communication needed * for Glocal. * * Notes: * * 1) This header file is included by the user for the definition * of the IBBDPrecData type and for needed function prototypes. * * 2) The IDABBDPrecInit call includes half-bandwidths mudq and * mldq to be used in the approximate Jacobian. They need * not be the true half-bandwidths of the Jacobian of the * local block of G, when smaller values may provide a greater * efficiency. Similarly, mukeep and mlkeep, specifying the * bandwidth kept for the approximate Jacobian, need not be * the true half-bandwidths. Also, mukeep, mlkeep, mudq, and * mldq need not be the same on every processor. * * 3) The actual name of the user's res function is passed to * IDAInit, and the names of the user's Gres and Gcomm * functions are passed to IDABBDPrecInit. * * 4) The pointer to the user-defined data block user_data, which * is set through IDASetUserData is also available to the user * in glocal and gcomm. * * 5) Optional outputs specific to this module are available by * way of routines listed below. These include work space sizes * and the cumulative number of glocal calls. The costs * associated with this module also include nsetups banded LU * factorizations, nsetups gcomm calls, and nps banded * backsolve calls, where nsetups and nps are integrator * optional outputs. * ----------------------------------------------------------------- */ #ifndef _IDABBDPRE_H #define _IDABBDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Type : IDABBDLocalFn * ----------------------------------------------------------------- * The user must supply a function G(t,y,y') which approximates * the function F for the system F(t,y,y') = 0, and which is * computed locally (without interprocess communication). * (The case where G is mathematically identical to F is allowed.) * The implementation of this function must have type IDABBDLocalFn. * * This function takes as input the independent variable value tt, * the current solution vector yy, the current solution * derivative vector yp, and a pointer to the user-defined data * block user_data. It is to compute the local part of G(t,y,y') * and store it in the vector gval. (Providing memory for yy and * gval is handled within this preconditioner module.) It is * expected that this routine will save communicated data in work * space defined by the user, and made available to the * preconditioner function for the problem. The user_data * parameter is the same as that passed by the user to the * IDASetRdata routine. * * An IDABBDLocalFn Gres is to return an int, defined in the same * way as for the residual function: 0 (success), +1 or -1 (fail). * ----------------------------------------------------------------- */ typedef int (*IDABBDLocalFn)(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); /* * ----------------------------------------------------------------- * Type : IDABBDCommFn * ----------------------------------------------------------------- * The user may supply a function of type IDABBDCommFn which * performs all interprocess communication necessary to * evaluate the approximate system function described above. * * This function takes as input the solution vectors yy and yp, * and a pointer to the user-defined data block user_data. The * user_data parameter is the same as that passed by the user to * the IDASetUserData routine. * * The IDABBDCommFn Gcomm is expected to save communicated data in * space defined with the structure *user_data. * * A IDABBDCommFn Gcomm returns an int value equal to 0 (success), * > 0 (recoverable error), or < 0 (unrecoverable error). * * Each call to the IDABBDCommFn is preceded by a call to the system * function res with the same vectors yy and yp. Thus the * IDABBDCommFn gcomm can omit any communications done by res if * relevant to the evaluation of the local function glocal. * A NULL communication function can be passed to IDABBDPrecInit * if all necessary communication was done by res. * ----------------------------------------------------------------- */ typedef int (*IDABBDCommFn)(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, void *user_data); /* * ----------------------------------------------------------------- * Function : IDABBDPrecInit * ----------------------------------------------------------------- * IDABBDPrecInit allocates and initializes the BBD preconditioner. * * The parameters of IDABBDPrecInit are as follows: * * ida_mem is a pointer to the memory blockreturned by IDACreate. * * Nlocal is the length of the local block of the vectors yy etc. * on the current processor. * * mudq, mldq are the upper and lower half-bandwidths to be used * in the computation of the local Jacobian blocks. * * mukeep, mlkeep are the upper and lower half-bandwidths to be * used in saving the Jacobian elements in the local * block of the preconditioner matrix PP. * * dq_rel_yy is an optional input. It is the relative increment * to be used in the difference quotient routine for * Jacobian calculation in the preconditioner. The * default is sqrt(unit roundoff), and specified by * passing dq_rel_yy = 0. * * Gres is the name of the user-supplied function G(t,y,y') * that approximates F and whose local Jacobian blocks * are to form the preconditioner. * * Gcomm is the name of the user-defined function that performs * necessary interprocess communication for the * execution of glocal. * * The return value of IDABBDPrecInit is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_ILL_INPUT if an input has an illegal value * IDASPILS_MEM_FAIL if a memory allocation request failed * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm); /* * ----------------------------------------------------------------- * Function : IDABBDPrecReInit * ----------------------------------------------------------------- * IDABBDPrecReInit reinitializes the IDABBDPRE module when * solving a sequence of problems of the same size with * IDASPGMR/IDABBDPRE, IDASPBCG/IDABBDPRE, or IDASPTFQMR/IDABBDPRE * provided there is no change in Nlocal, mukeep, or mlkeep. After * solving one problem, and after calling IDAReInit to reinitialize * the integrator for a subsequent problem, call IDABBDPrecReInit. * * All arguments have the same names and meanings as those * of IDABBDPrecInit. * * The return value of IDABBDPrecReInit is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, long int mudq, long int mldq, realtype dq_rel_yy); /* * ----------------------------------------------------------------- * Optional outputs for IDABBDPRE * ----------------------------------------------------------------- * IDABBDPrecGetWorkSpace returns the real and integer work space * for IDABBDPRE. * IDABBDPrecGetNumGfnEvals returns the number of calls to the * user Gres function. * * The return value of IDABBDPrecGet* is one of: * IDASPILS_SUCCESS if no errors occurred * IDASPILS_MEM_NULL if the integrator memory is NULL * IDASPILS_LMEM_NULL if the linear solver memory is NULL * IDASPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_direct.h0000600000175000017500000003471611741421215020643 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:14:09 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common header file for the direct linear solvers in IDA. * ----------------------------------------------------------------- */ #ifndef _IDADLS_H #define _IDADLS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * I D A D I R E C T C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * IDADLS return values * ----------------------------------------------------------------- */ #define IDADLS_SUCCESS 0 #define IDADLS_MEM_NULL -1 #define IDADLS_LMEM_NULL -2 #define IDADLS_ILL_INPUT -3 #define IDADLS_MEM_FAIL -4 /* Additional last_flag values */ #define IDADLS_JACFUNC_UNRECVR -5 #define IDADLS_JACFUNC_RECVR -6 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : IDADlsDenseJacFn * ----------------------------------------------------------------- * * A dense Jacobian approximation function djac must be of type * IDADlsDenseJacFn. * Its parameters are: * * N is the problem size, and length of all vector arguments. * * t is the current value of the independent variable t. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * f is the residual vector F(tt,yy,yp). * * c_j is the scalar in the system Jacobian, proportional to * the inverse of the step size h. * * user_data is a pointer to user Jacobian data - the same as the * user_data parameter passed to IDASetRdata. * * Jac is the dense matrix (of type DlsMat) to be loaded by * an IDADlsDenseJacFn routine with an approximation to the * system Jacobian matrix * J = dF/dy' + gamma*dF/dy * at the given point (t,y,y'), where the ODE system is * given by F(t,y,y') = 0. * Note that Jac is NOT preset to zero! * * tmp1, tmp2, tmp3 are pointers to memory allocated for * N_Vectors which can be used by an IDADlsDenseJacFn routine * as temporary storage or work space. * * A IDADlsDenseJacFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load a dense Jac: * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = LAPACK_DENSE_COL(Jac,j); * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * (2) (without macros - explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = (Jac->data)[j]; * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * A third way, using the LAPACK_DENSE_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively * (see ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h. * * ----------------------------------------------------------------- */ typedef int (*IDADlsDenseJacFn)(long int N, realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Types : IDADlsBandJacFn * ----------------------------------------------------------------- * A banded Jacobian approximation function bjac must have the * prototype given below. Its parameters are: * * Neq is the problem size, and length of all vector arguments. * * mupper is the upper bandwidth of the banded Jacobian matrix. * * mlower is the lower bandwidth of the banded Jacobian matrix. * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the residual vector F(tt,yy,yp). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * user_data is a pointer to user Jacobian data - the same as the * user_data parameter passed to IDASetRdata. * * Jac is the band matrix (of type BandMat) to be loaded by * an IDADlsBandJacFn routine with an approximation to the * system Jacobian matrix * J = dF/dy + cj*dF/dy' * at the given point (t,y,y'), where the DAE system is * given by F(t,y,y') = 0. Jac is preset to zero, so only * the nonzero elements need to be loaded. See note below. * * tmp1, tmp2, tmp3 are pointers to memory allocated for * N_Vectors which can be used by an IDADlsBandJacFn routine * as temporary storage or work space. * * An IDADlsBandJacFn function should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load Jac: * * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = BAND_COL(Jac,j); * for (i=j-mupper; i <= j+mlower; i++) { * generate J_ij = the (i,j)th Jacobian element * BAND_COL_ELEM(col_j,i,j) = J_ij; * } * } * * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) * for (j=0; j < Neq; j++) { * col_j = BAND_COL(Jac,j); * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * * A third way, using the BAND_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively (see * ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * ----------------------------------------------------------------- */ typedef int (*IDADlsBandJacFn)(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Optional inputs to the IDADLS linear solver * ----------------------------------------------------------------- * IDADlsSetDenseJacFn specifies the dense Jacobian approximation * routine to be used for a direct dense linear solver. * * IDADlsSetBandJacFn specifies the band Jacobian approximation * routine to be used for a direct band linear solver. * * By default, a difference quotient approximation, supplied with * the solver is used. * * The return value is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac); SUNDIALS_EXPORT int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac); /* * ----------------------------------------------------------------- * Optional outputs from the IDADLS linear solver * ----------------------------------------------------------------- * * IDADlsGetWorkSpace returns the real and integer workspace used * by the direct linear solver. * IDADlsGetNumJacEvals returns the number of calls made to the * Jacobian evaluation routine jac. * IDADlsGetNumResEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * IDADlsGetLastFlag returns the last error flag set by any of * the IDADLS interface functions. * * The return value of IDADlsGet* is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); SUNDIALS_EXPORT int IDADlsGetNumResEvals(void *ida_mem, long int *nfevalsLS); SUNDIALS_EXPORT int IDADlsGetLastFlag(void *ida_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a IDADLS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDADlsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida.h0000600000175000017500000014055711741421215017312 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.14 $ * $Date: 2010/12/01 22:14:08 $ * ----------------------------------------------------------------- * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the header (include) file for the main IDA solver. * ----------------------------------------------------------------- * * IDA is used to solve numerically the initial value problem * for the differential algebraic equation (DAE) system * F(t,y,y') = 0, * given initial conditions * y(t0) = y0, y'(t0) = yp0. * Here y and F are vectors of length N. * * ----------------------------------------------------------------- */ #ifndef _IDA_H #define _IDA_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * I D A C O N S T A N T S * ================================================================= */ /* * ---------------------------------------------------------------- * Inputs to IDAInit, IDAReInit, IDACalcIC, and IDASolve. * ---------------------------------------------------------------- */ /* itask */ #define IDA_NORMAL 1 #define IDA_ONE_STEP 2 /* icopt */ #define IDA_YA_YDP_INIT 1 #define IDA_Y_INIT 2 /* * ---------------------------------------- * IDA return flags * ---------------------------------------- */ #define IDA_SUCCESS 0 #define IDA_TSTOP_RETURN 1 #define IDA_ROOT_RETURN 2 #define IDA_WARNING 99 #define IDA_TOO_MUCH_WORK -1 #define IDA_TOO_MUCH_ACC -2 #define IDA_ERR_FAIL -3 #define IDA_CONV_FAIL -4 #define IDA_LINIT_FAIL -5 #define IDA_LSETUP_FAIL -6 #define IDA_LSOLVE_FAIL -7 #define IDA_RES_FAIL -8 #define IDA_REP_RES_ERR -9 #define IDA_RTFUNC_FAIL -10 #define IDA_CONSTR_FAIL -11 #define IDA_FIRST_RES_FAIL -12 #define IDA_LINESEARCH_FAIL -13 #define IDA_NO_RECOVERY -14 #define IDA_MEM_NULL -20 #define IDA_MEM_FAIL -21 #define IDA_ILL_INPUT -22 #define IDA_NO_MALLOC -23 #define IDA_BAD_EWT -24 #define IDA_BAD_K -25 #define IDA_BAD_T -26 #define IDA_BAD_DKY -27 /* * ---------------------------------------------------------------- * Type : IDAResFn * ---------------------------------------------------------------- * The F function which defines the DAE system F(t,y,y')=0 * must have type IDAResFn. * Symbols are as follows: * t <-> t y <-> yy * y' <-> yp F <-> rr * A IDAResFn takes as input the independent variable value t, * the dependent variable vector yy, and the derivative (with * respect to t) of the yy vector, yp. It stores the result of * F(t,y,y') in the vector rr. The yy, yp, and rr arguments are of * type N_Vector. The user_data parameter is the pointer user_data * passed by the user to the IDASetRdata routine. This user-supplied * pointer is passed to the user's res function every time it is called, * to provide access in res to user data. * * A IDAResFn res should return a value of 0 if successful, a positive * value if a recoverable error occured (e.g. yy has an illegal value), * or a negative value if a nonrecoverable error occured. In the latter * case, the program halts. If a recoverable error occured, the integrator * will attempt to correct and retry. * ---------------------------------------------------------------- */ typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); /* * ----------------------------------------------------------------- * Type : IDARootFn * ----------------------------------------------------------------- * A function g, which defines a set of functions g_i(t,y,y') whose * roots are sought during the integration, must have type IDARootFn. * The function g takes as input the independent variable value t, * the dependent variable vector y, and its t-derivative yp (= y'). * It stores the nrtfn values g_i(t,y,y') in the realtype array gout. * (Allocation of memory for gout is handled within IDA.) * The user_data parameter is the same as that passed by the user * to the IDASetRdata routine. This user-supplied pointer is * passed to the user's g function every time it is called. * * An IDARootFn should return 0 if successful or a non-zero value * if an error occured (in which case the integration will be halted). * ----------------------------------------------------------------- */ typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data); /* * ----------------------------------------------------------------- * Type : IDAEwtFn * ----------------------------------------------------------------- * A function e, which sets the error weight vector ewt, must have * type IDAEwtFn. * The function e takes as input the current dependent variable y. * It must set the vector of error weights used in the WRMS norm: * * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] * * Typically, the vector ewt has components: * * ewt_i = 1 / (reltol * |y_i| + abstol_i) * * The user_data parameter is the same as that passed by the user * to the IDASetRdata routine. This user-supplied pointer is * passed to the user's e function every time it is called. * An IDAEwtFn e must return 0 if the error weight vector has been * successfuly set and a non-zero value otherwise. * ----------------------------------------------------------------- */ typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); /* * ----------------------------------------------------------------- * Type : IDAErrHandlerFn * ----------------------------------------------------------------- * A function eh, which handles error messages, must have type * IDAErrHandlerFn. * The function eh takes as input the error code, the name of the * module reporting the error, the error message, and a pointer to * user data, the same as that passed to IDASetRdata. * * All error codes are negative, except IDA_WARNING which indicates * a warning (the solver continues). * * An IDAErrHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*IDAErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); /* * ================================================================ * U S E R - C A L L A B L E R O U T I N E S * ================================================================ */ /* * ---------------------------------------------------------------- * Function : IDACreate * ---------------------------------------------------------------- * IDACreate creates an internal memory block for a problem to * be solved by IDA. * * If successful, IDACreate returns a pointer to initialized * problem memory. This pointer should be passed to IDAInit. * If an initialization error occurs, IDACreate prints an error * message to standard err and returns NULL. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT void *IDACreate(void); /* * ---------------------------------------------------------------- * Integrator optional input specification functions * ---------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * | * Function | Optional input / [ default value ] * | * ---------------------------------------------------------------- * | * IDASetErrHandlerFn | user-provided ErrHandler function. * | [internal] * | * IDASetErrFile | the file pointer for an error file * | where all IDA warning and error * | messages will be written if the default * | internal error handling function is used. * | This parameter can be stdout (standard * | output), stderr (standard error), or a * | file pointer (corresponding to a user * | error file opened for writing) returned * | by fopen. * | If not called, then all messages will * | be written to the standard error stream. * | [stderr] * | * IDASetUserData | a pointer to user data that will be * | passed to the user's res function every * | time a user-supplied function is called. * | [NULL] * | * IDASetMaxOrd | maximum lmm order to be used by the * | solver. * | [5] * | * IDASetMaxNumSteps | maximum number of internal steps to be * | taken by the solver in its attempt to * | reach tout. * | [500] * | * IDASetInitStep | initial step size. * | [estimated by IDA] * | * IDASetMaxStep | maximum absolute value of step size * | allowed. * | [infinity] * | * IDASetStopTime | the independent variable value past * | which the solution is not to proceed. * | [infinity] * | * IDASetNonlinConvCoef | Newton convergence test constant * | for use during integration. * | [0.33] * | * IDASetMaxErrTestFails| Maximum number of error test failures * | in attempting one step. * | [10] * | * IDASetMaxNonlinIters | Maximum number of nonlinear solver * | iterations at one solution. * | [4] * | * IDASetMaxConvFails | Maximum number of allowable conv. * | failures in attempting one step. * | [10] * | * IDASetSuppressAlg | flag to indicate whether or not to * | suppress algebraic variables in the * | local error tests: * | FALSE = do not suppress; * | TRUE = do suppress; * | [FALSE] * | NOTE: if suppressed algebraic variables * | is selected, the nvector 'id' must be * | supplied for identification of those * | algebraic components (see IDASetId). * | * IDASetId | an N_Vector, which states a given * | element to be either algebraic or * | differential. * | A value of 1.0 indicates a differential * | variable while a 0.0 indicates an * | algebraic variable. 'id' is required * | if optional input SUPPRESSALG is set, * | or if IDACalcIC is to be called with * | icopt = IDA_YA_YDP_INIT. * | * IDASetConstraints | an N_Vector defining inequality * | constraints for each component of the * | solution vector y. If a given element * | of this vector has values +2 or -2, * | then the corresponding component of y * | will be constrained to be > 0.0 or * | <0.0, respectively, while if it is +1 * | or -1, the y component is constrained * | to be >= 0.0 or <= 0.0, respectively. * | If a component of constraints is 0.0, * | then no constraint is imposed on the * | corresponding component of y. * | The presence of a non-NULL constraints * | vector that is not 0.0 (ZERO) in all * | components will cause constraint * | checking to be performed. * | * ----------------------------------------------------------------- * | * IDASetRootDirection | Specifies the direction of zero * | crossings to be monitored * | [both directions] * | * IDASetNoInactiveRootWarn | disable warning about possible * | g==0 at beginning of integration * | * ----------------------------------------------------------------- * Return flag: * IDA_SUCCESS if successful * IDA_MEM_NULL if the ida memory is NULL * IDA_ILL_INPUT if an argument has an illegal value * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); /* * ---------------------------------------------------------------- * Function : IDAInit * ---------------------------------------------------------------- * IDAInit allocates and initializes memory for a problem to * to be solved by IDA. * * res is the residual function F in F(t,y,y') = 0. * * t0 is the initial value of t, the independent variable. * * yy0 is the initial condition vector y(t0). * * yp0 is the initial condition vector y'(t0) * * IDA_SUCCESS if successful * IDA_MEM_NULL if the ida memory was NULL * IDA_MEM_FAIL if a memory allocation failed * IDA_ILL_INPUT f an argument has an illegal value. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0); /* * ---------------------------------------------------------------- * Function : IDAReInit * ---------------------------------------------------------------- * IDAReInit re-initializes IDA for the solution of a problem, * where a prior call to IDAInit has been made. * IDAReInit performs the same input checking and initializations * that IDAInit does. * But it does no memory allocation, assuming that the existing * internal memory is sufficient for the new problem. * * The use of IDAReInit requires that the maximum method order, * maxord, is no larger for the new problem than for the problem * specified in the last call to IDAInit. This condition is * automatically fulfilled if the default value for maxord is * specified. * * Following the call to IDAReInit, a call to the linear solver * specification routine is necessary if a different linear solver * is chosen, but may not be otherwise. If the same linear solver * is chosen, and there are no changes in its input parameters, * then no call to that routine is needed. * * The first argument to IDAReInit is: * * ida_mem = pointer to IDA memory returned by IDACreate. * * All the remaining arguments to IDAReInit have names and * meanings identical to those of IDAInit. * * The return value of IDAReInit is equal to SUCCESS = 0 if there * were no errors; otherwise it is a negative int equal to: * IDA_MEM_NULL indicating ida_mem was NULL, or * IDA_NO_MALLOC indicating that ida_mem was not allocated. * IDA_ILL_INPUT indicating an input argument was illegal * (including an attempt to increase maxord). * In case of an error return, an error message is also printed. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0); /* * ----------------------------------------------------------------- * Functions : IDASStolerances * IDASVtolerances * IDAWFtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances. One of them * MUST be called before the first call to IDA. * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) * which will be called to set the error weight vector. * * The tolerances reltol and abstol define a vector of error weights, * ewt, with components * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). * This vector is used in all error and convergence tests, which * use a weighted RMS norm on all error-like vectors v: * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), * where N is the problem dimension. * * The return value of these functions is equal to IDA_SUCCESS = 0 if * there were no errors; otherwise it is a negative int equal to: * IDa_MEM_NULL indicating ida_mem was NULL (i.e., * IDACreate has not been called). * IDA_NO_MALLOC indicating that ida_mem has not been * allocated (i.e., IDAInit has not been * called). * IDA_ILL_INPUT indicating an input argument was illegal * (e.g. a negative tolerance) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); /* ---------------------------------------------------------------- * Initial Conditions optional input specification functions * ---------------------------------------------------------------- * The following functions can be called to set optional inputs * to control the initial conditions calculations. * * | * Function | Optional input / [ default value ] * | * -------------------------------------------------------------- * | * IDASetNonlinConvCoefIC | positive coeficient in the Newton * | convergence test. This test uses a * | weighted RMS norm (with weights * | defined by the tolerances, as in * | IDASolve). For new initial value * | vectors y and y' to be accepted, the * | norm of J-inverse F(t0,y,y') is * | required to be less than epiccon, * | where J is the system Jacobian. * | [0.01 * 0.33] * | * IDASetMaxNumStepsIC | maximum number of values of h allowed * | when icopt = IDA_YA_YDP_INIT, where * | h appears in the system Jacobian, * | J = dF/dy + (1/h)dF/dy'. * | [5] * | * IDASetMaxNumJacsIC | maximum number of values of the * | approximate Jacobian or preconditioner * | allowed, when the Newton iterations * | appear to be slowly converging. * | [4] * | * IDASetMaxNumItersIC | maximum number of Newton iterations * | allowed in any one attempt to solve * | the IC problem. * | [10] * | * IDASetLineSearchOffIC | a boolean flag to turn off the * | linesearch algorithm. * | [FALSE] * | * IDASetStepToleranceIC | positive lower bound on the norm of * | a Newton step. * | [(unit roundoff)^(2/3) * * ---------------------------------------------------------------- * Return flag: * IDA_SUCCESS if successful * IDA_MEM_NULL if the ida memory is NULL * IDA_ILL_INPUT if an argument has an illegal value * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); /* * ----------------------------------------------------------------- * Function : IDARootInit * ----------------------------------------------------------------- * IDARootInit initializes a rootfinding problem to be solved * during the integration of the DAE system. It must be called * after IDACreate, and before IDASolve. The arguments are: * * ida_mem = pointer to IDA memory returned by IDACreate. * * nrtfn = number of functions g_i, an int >= 0. * * g = name of user-supplied function, of type IDARootFn, * defining the functions g_i whose roots are sought. * * If a new problem is to be solved with a call to IDAReInit, * where the new problem has no root functions but the prior one * did, then call IDARootInit with nrtfn = 0. * * The return value of IDARootInit is IDA_SUCCESS = 0 if there were * no errors; otherwise it is a negative int equal to: * IDA_MEM_NULL indicating ida_mem was NULL, or * IDA_MEM_FAIL indicating a memory allocation failed. * (including an attempt to increase maxord). * IDA_ILL_INPUT indicating nrtfn > 0 but g = NULL. * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); /* * ---------------------------------------------------------------- * Function : IDACalcIC * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for the DAE * system for a class of index-one problems of semi-implicit form. * It uses Newton iteration combined with a Linesearch algorithm. * Calling IDACalcIC is optional. It is only necessary when the * initial conditions do not solve the given system. I.e., if * y0 and yp0 are known to satisfy F(t0, y0, yp0) = 0, then * a call to IDACalcIC is NOT necessary (for index-one problems). * * A call to IDACalcIC must be preceded by a successful call to * IDAInit or IDAReInit for the given DAE problem, and by a * successful call to the linear system solver specification * routine. * * The call to IDACalcIC should precede the call(s) to IDASolve * for the given problem. * * The arguments to IDACalcIC are as follows: * * ida_mem is the pointer to IDA memory returned by IDACreate. * * icopt is the option of IDACalcIC to be used. * icopt = IDA_YA_YDP_INIT directs IDACalcIC to compute * the algebraic components of y and differential * components of y', given the differential * components of y. This option requires that the * N_Vector id was set through a call to IDASetId * specifying the differential and algebraic * components. * icopt = IDA_Y_INIT directs IDACalcIC to compute all * components of y, given y'. id is not required. * * tout1 is the first value of t at which a soluton will be * requested (from IDASolve). (This is needed here to * determine the direction of integration and rough scale * in the independent variable t.) * * * IDACalcIC returns an int flag. Its symbolic values and their * meanings are as follows. (The numerical return values are set * above in this file.) All unsuccessful returns give a negative * return value. If IFACalcIC failed, y0 and yp0 contain * (possibly) altered values, computed during the attempt. * * IDA_SUCCESS IDACalcIC was successful. The corrected * initial value vectors were stored internally. * * IDA_MEM_NULL The argument ida_mem was NULL. * * IDA_ILL_INPUT One of the input arguments was illegal. * See printed message. * * IDA_LINIT_FAIL The linear solver's init routine failed. * * IDA_BAD_EWT Some component of the error weight vector * is zero (illegal), either for the input * value of y0 or a corrected value. * * IDA_RES_FAIL The user's residual routine returned * a non-recoverable error flag. * * IDA_FIRST_RES_FAIL The user's residual routine returned * a recoverable error flag on the first call, * but IDACalcIC was unable to recover. * * IDA_LSETUP_FAIL The linear solver's setup routine had a * non-recoverable error. * * IDA_LSOLVE_FAIL The linear solver's solve routine had a * non-recoverable error. * * IDA_NO_RECOVERY The user's residual routine, or the linear * solver's setup or solve routine had a * recoverable error, but IDACalcIC was * unable to recover. * * IDA_CONSTR_FAIL IDACalcIC was unable to find a solution * satisfying the inequality constraints. * * IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a * solution with a step larger than steptol * in weighted RMS norm. * * IDA_CONV_FAIL IDACalcIC failed to get convergence of the * Newton iterations. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); /* * ---------------------------------------------------------------- * Function : IDASolve * ---------------------------------------------------------------- * IDASolve integrates the DAE over an interval in t, the * independent variable. If itask is IDA_NORMAL, then the solver * integrates from its current internal t value to a point at or * beyond tout, then interpolates to t = tout and returns y(tret) * in the user-allocated vector yret. In general, tret = tout. * If itask is IDA_ONE_STEP, then the solver takes one internal * step of the independent variable and returns in yret the value * of y at the new internal independent variable value. In this * case, tout is used only during the first call to IDASolve to * determine the direction of integration and the rough scale of * the problem. If tstop is enabled (through a call to IDASetStopTime), * then IDASolve returns the solution at tstop. Once the integrator * returns at a tstop time, any future testing for tstop is disabled * (and can be reenabled only though a new call to IDASetStopTime). * The time reached by the solver is placed in (*tret). The * user is responsible for allocating the memory for this value. * * ida_mem is the pointer (void) to IDA memory returned by * IDACreate. * * tout is the next independent variable value at which a * computed solution is desired. * * tret is a pointer to a real location. IDASolve sets (*tret) * to the actual t value reached, corresponding to the * solution vector yret. In IDA_NORMAL mode, with no * errors and no roots found, (*tret) = tout. * * yret is the computed solution vector. With no errors, * yret = y(tret). * * ypret is the derivative of the computed solution at t = tret. * * Note: yret and ypret may be the same N_Vectors as y0 and yp0 * in the call to IDAInit or IDAReInit. * * itask is IDA_NORMAL or IDA_ONE_STEP. These two modes are described above. * * * The return values for IDASolve are described below. * (The numerical return values are defined above in this file.) * All unsuccessful returns give a negative return value. * * IDA_SUCCESS * IDASolve succeeded and no roots were found. * * IDA_ROOT_RETURN: IDASolve succeeded, and found one or more roots. * If nrtfn > 1, call IDAGetRootInfo to see which g_i were found * to have a root at (*tret). * * IDA_TSTOP_RETURN: * IDASolve returns computed results for the independent variable * value tstop. That is, tstop was reached. * * IDA_MEM_NULL: * The IDA_mem argument was NULL. * * IDA_ILL_INPUT: * One of the inputs to IDASolve is illegal. This includes the * situation when a component of the error weight vectors * becomes < 0 during internal stepping. It also includes the * situation where a root of one of the root functions was found * both at t0 and very near t0. The ILL_INPUT flag * will also be returned if the linear solver function IDA--- * (called by the user after calling IDACreate) failed to set one * of the linear solver-related fields in ida_mem or if the linear * solver's init routine failed. In any case, the user should see * the printed error message for more details. * * IDA_TOO_MUCH_WORK: * The solver took mxstep internal steps but could not reach tout. * The default value for mxstep is MXSTEP_DEFAULT = 500. * * IDA_TOO_MUCH_ACC: * The solver could not satisfy the accuracy demanded by the user * for some internal step. * * IDA_ERR_FAIL: * Error test failures occurred too many times (=MXETF = 10) during * one internal step. * * IDA_CONV_FAIL: * Convergence test failures occurred too many times (= MXNCF = 10) * during one internal step. * * IDA_LSETUP_FAIL: * The linear solver's setup routine failed * in an unrecoverable manner. * * IDA_LSOLVE_FAIL: * The linear solver's solve routine failed * in an unrecoverable manner. * * IDA_CONSTR_FAIL: * The inequality constraints were violated, * and the solver was unable to recover. * * IDA_REP_RES_ERR: * The user's residual function repeatedly returned a recoverable * error flag, but the solver was unable to recover. * * IDA_RES_FAIL: * The user's residual function returned a nonrecoverable error * flag. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); /* * ---------------------------------------------------------------- * Function: IDAGetDky * ---------------------------------------------------------------- * * This routine computes the k-th derivative of the interpolating * polynomial at the time t and stores the result in the vector dky. * * The return values are: * IDA_SUCCESS: succeess. * IDA_BAD_T: t is not in the interval [tn-hu,tn]. * IDA_MEM_NULL: The ida_mem argument was NULL. * IDA_BAD_DKY if the dky vector is NULL. * IDA_BAD_K if the requested k is not in the range 0,1,...,order used * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky); /* ---------------------------------------------------------------- * Integrator optional output extraction functions * ---------------------------------------------------------------- * * The following functions can be called to get optional outputs * and statistics related to the main integrator. * ---------------------------------------------------------------- * * IDAGetWorkSpace returns the IDA real and integer workspace sizes * IDAGetNumSteps returns the cumulative number of internal * steps taken by the solver * IDAGetNumRhsEvals returns the number of calls to the user's * res function * IDAGetNumLinSolvSetups returns the number of calls made to * the linear solver's setup routine * IDAGetNumErrTestFails returns the number of local error test * failures that have occured * IDAGetNumBacktrackOps returns the number of backtrack * operations done in the linesearch algorithm in IDACalcIC * IDAGetConsistentIC returns the consistent initial conditions * computed by IDACalcIC * IDAGetLastOrder returns the order used during the last * internal step * IDAGetCurentOrder returns the order to be used on the next * internal step * IDAGetActualInitStep returns the actual initial step size * used by IDA * IDAGetLAstStep returns the step size for the last internal * step (if from IDASolve), or the last value of the * artificial step size h (if from IDACalcIC) * IDAGetCurrentStep returns the step size to be attempted on the * next internal step * IDAGetCurrentTime returns the current internal time reached * by the solver * IDAGetTolScaleFactor returns a suggested factor by which the * user's tolerances should be scaled when too much * accuracy has been requested for some internal step * IDAGetErrWeights returns the current state error weight vector. * The user must allocate space for eweight. * IDAGetEstLocalErrors returns the estimated local errors. The user * must allocate space for the vector ele. * IDAGetNumGEvals returns the number of calls to the user's * g function (for rootfinding) * IDAGetRootInfo returns the indices for which g_i was found to * have a root. The user must allocate space for rootsfound. * For i = 0 ... nrtfn-1, rootsfound[i] = 1 if g_i has a root, * and rootsfound[i]= 0 if not. * * IDAGet* return values: * IDA_SUCCESS if succesful * IDA_MEM_NULL if the ida memory was NULL * IDA_ILL_INPUT if some input is illegal * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, N_Vector yp0_mod); SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); /* * ---------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in a group. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); /* * ---------------------------------------------------------------- * Nonlinear solver optional output extraction functions * ---------------------------------------------------------------- * * The following functions can be called to get optional outputs * and statistics related to the nonlinear solver. * -------------------------------------------------------------- * * IDAGetNumNonlinSolvIters returns the number of nonlinear * solver iterations performed. * IDAGetNumNonlinSolvConvFails returns the number of nonlinear * convergence failures. * * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); /* * ---------------------------------------------------------------- * As a convenience, the following function provides the * nonlinear solver optional outputs in a group. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with an IDA return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDAGetReturnFlagName(long int flag); /* * ---------------------------------------------------------------- * Function : IDAFree * ---------------------------------------------------------------- * IDAFree frees the problem memory IDA_mem allocated by * IDAInit. Its only argument is the pointer idamem * returned by IDAInit. * ---------------------------------------------------------------- */ SUNDIALS_EXPORT void IDAFree(void **ida_mem); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_lapack.h0000600000175000017500000000535011741421215020614 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2008/04/18 19:42:37 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the IDA dense linear solver IDALAPACK. * ----------------------------------------------------------------- */ #ifndef _IDALAPACK_H #define _IDALAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDALapackDense * ----------------------------------------------------------------- * A call to the IDALapackDense function links the main integrator * with the IDALAPACK linear solver using dense Jacobians. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * N is the size of the ODE system. * * The return value of IDALapackDense is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_MEM_FAIL if there was a memory allocation failure * IDADLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackDense(void *ida_mem, int N); /* * ----------------------------------------------------------------- * Function : IDALapackBand * ----------------------------------------------------------------- * A call to the IDALapackBand function links the main integrator * with the IDALAPACK linear solver using banded Jacobians. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian approximation. * * mlower is the lower bandwidth of the band Jacobian approximation. * * The return value of IDALapackBand is one of: * IDADLS_SUCCESS if successful * IDADLS_MEM_NULL if the IDA memory was NULL * IDADLS_MEM_FAIL if there was a memory allocation failure * IDADLS_ILL_INPUT if a required vector operation is missing * or if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDALapackBand(void *ida_mem, int N, int mupper, int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_spbcgs.h0000600000175000017500000000363311741421215020644 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the IDA scaled preconditioned * Bi-CGSTAB linear solver module, IDASPBCG. * ----------------------------------------------------------------- */ #ifndef _IDASPBCG_H #define _IDASPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDASpbcg * ----------------------------------------------------------------- * A call to the IDASpbcg function links the main integrator with * the IDASPBCG linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value. * Otherwise pass a positive integer. * * The return values of IDASpbcg are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the ida memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in ida_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpbcg(void *ida_mem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_dense.h0000600000175000017500000000456011741421215020461 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:14:09 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDADENSE linear solver module. * ----------------------------------------------------------------- */ #ifndef _IDADENSE_H #define _IDADENSE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDADense * ----------------------------------------------------------------- * A call to the IDADense function links the main integrator * with the IDADENSE linear solver module. * * ida_mem is the pointer to integrator memory returned by * IDACreate. * * Neq is the problem size * * IDADense returns: * IDADLS_SUCCESS = 0 if successful * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure * IDADLS_ILL_INPUT = -2 if NVECTOR found incompatible * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDADense will first * test for a compatible N_Vector internal representation * by checking that the functions N_VGetArrayPointer and * N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDADense(void *ida_mem, long int Neq); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_sptfqmr.h0000600000175000017500000000364411741421215021061 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the IDA scaled preconditioned * TFQMR linear solver module, IDASPTFQMR. * ----------------------------------------------------------------- */ #ifndef _IDASPTFQMR_H #define _IDASPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDASptfqmr * ----------------------------------------------------------------- * A call to the IDASptfqmr function links the main integrator with * the IDASPTFQMR linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value. * Otherwise pass a positive integer. * * The return values of IDASptfqmr are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the ida memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in ida_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASptfqmr(void *ida_mem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_band.h0000600000175000017500000000476411741421215020275 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:14:08 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the IDABAND linear solver module. * ----------------------------------------------------------------- */ #ifndef _IDABAND_H #define _IDABAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : IDABand * ----------------------------------------------------------------- * A call to the IDABand function links the main integrator * with the IDABAND linear solver module. * * ida_mem is the pointer to the integrator memory returned by * IDACreate. * * mupper is the upper bandwidth of the banded Jacobian matrix. * * mlower is the lower bandwidth of the banded Jacobian matrix. * * The return values of IDABand are: * IDADLS_SUCCESS = 0 if successful * IDADLS_LMEM_FAIL = -1 if there was a memory allocation failure * IDADLS_ILL_INPUT = -2 if the input was illegal or NVECTOR bad. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDABand will first * test for a compatible N_Vector internal representation * by checking that the N_VGetArrayPointer function exists. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDABand(void *ida_mem, long int Neq, long int mupper, long int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_spils.h0000600000175000017500000003320211741421215020510 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:14:09 $ * ----------------------------------------------------------------- * Programmers: Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the common header file for the Scaled and Preconditioned * Iterative Linear Solvers in IDA. * ----------------------------------------------------------------- */ #ifndef _IDASPILS_H #define _IDASPILS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * IDASPILS return values * ----------------------------------------------------------------- */ #define IDASPILS_SUCCESS 0 #define IDASPILS_MEM_NULL -1 #define IDASPILS_LMEM_NULL -2 #define IDASPILS_ILL_INPUT -3 #define IDASPILS_MEM_FAIL -4 #define IDASPILS_PMEM_NULL -5 /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSetupFn * ----------------------------------------------------------------- * The optional user-supplied functions PrecSetup and PrecSolve * together must define the left preconditoner matrix P * approximating the system Jacobian matrix * J = dF/dy + c_j*dF/dy' * (where the DAE system is F(t,y,y') = 0), and solve the linear * systems P z = r. PrecSetup is to do any necessary setup * operations, and PrecSolve is to compute the solution of * P z = r. * * The preconditioner setup function PrecSetup is to evaluate and * preprocess any Jacobian-related data needed by the * preconditioner solve function PrecSolve. This might include * forming a crude approximate Jacobian, and performing an LU * factorization on it. This function will not be called in * advance of every call to PrecSolve, but instead will be called * only as often as necessary to achieve convergence within the * Newton iteration. If the PrecSolve function needs no * preparation, the PrecSetup function can be NULL. * * Each call to the PrecSetup function is preceded by a call to * the system function res with the same (t,y,y') arguments. * Thus the PrecSetup function can use any auxiliary data that is * computed and saved by the res function and made accessible * to PrecSetup. * * A preconditioner setup function PrecSetup must have the * prototype given below. Its parameters are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the current value of the residual vector F(t,y,y'). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * user_data is a pointer to user data, the same as the user_data * parameter passed to IDASetUserData. * * tmp1, tmp2, tmp3 are pointers to vectors of type N_Vector * which can be used by an IDASpilsPrecSetupFn routine * as temporary storage or work space. * * NOTE: If the user's preconditioner needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * IDAGetCurrentStep and IDAGetErrWeights, respectively (see * ida.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * The IDASpilsPrecSetupFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * In the case of a recoverable error return, the integrator will * attempt to recover by reducing the stepsize (which changes cj). * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSetupFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type : IDASpilsPrecSolveFn * ----------------------------------------------------------------- * The optional user-supplied function PrecSolve must compute a * solution to the linear system P z = r, where P is the left * preconditioner defined by the user. If no preconditioning * is desired, pass NULL for PrecSolve to IDASp*. * * A preconditioner solve function PrecSolve must have the * prototype given below. Its parameters are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector y. * * yp is the current value of the derivative vector y'. * * rr is the current value of the residual vector F(t,y,y'). * * rvec is the input right-hand side vector r. * * zvec is the computed solution vector z. * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * delta is an input tolerance for use by PrecSolve if it uses an * iterative method in its solution. In that case, the * the residual vector r - P z of the system should be * made less than delta in weighted L2 norm, i.e., * sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta . * Note: the error weight vector ewt can be obtained * through a call to the routine IDAGetErrWeights. * * user_data is a pointer to user data, the same as the user_data * parameter passed to IDASetUserData. * * tmp is an N_Vector which can be used by the PrecSolve * routine as temporary storage or work space. * * The IDASpilsPrecSolveFn should return * 0 if successful, * a positive int if a recoverable error occurred, or * a negative int if a nonrecoverable error occurred. * Following a recoverable error, the integrator will attempt to * recover by updating the preconditioner and/or reducing the * stepsize. * ----------------------------------------------------------------- */ typedef int (*IDASpilsPrecSolveFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Type : IDASpilsJacTimesVecFn * ----------------------------------------------------------------- * The user-supplied function jtimes is to generate the product * J*v for given v, where J is the Jacobian matrix * J = dF/dy + c_j*dF/dy' * or an approximation to it, and v is a given vector. * It should return 0 if successful and a nonzero int otherwise. * * A function jtimes must have the prototype given below. Its * parameters are as follows: * * tt is the current value of the independent variable. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * rr is the current value of the residual vector F(t,y,y'). * * v is the N_Vector to be multiplied by J. * * Jv is the output N_Vector containing J*v. * * c_j is the scalar in the system Jacobian, proportional * to 1/hh. * * user_data is a pointer to user data, the same as the * pointer passed to IDASetUserData. * * tmp1, tmp2 are two N_Vectors which can be used by Jtimes for * work space. * ----------------------------------------------------------------- */ typedef int (*IDASpilsJacTimesVecFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Optional inputs to the IDASPILS linear solver * ----------------------------------------------------------------- * * IDASpilsSetPreconditioner specifies the PrecSetup and PrecSolve * functions. * Default is NULL for both arguments. * IDASpilsSetJacTimesVecFn specifies the jtimes function. * Default is to use an internal finite difference * approximation routine. * IDASpilsSetGSType specifies the type of Gram-Schmidt * orthogonalization to be used. This must be one of * the two enumeration constants MODIFIED_GS or * CLASSICAL_GS defined in iterativ.h. These correspond * to using modified Gram-Schmidt and classical * Gram-Schmidt, respectively. * Default value is MODIFIED_GS. * Only for IDASPGMR. * IDASpilsSetMaxRestarts specifies the maximum number of restarts * to be used in the GMRES algorithm. maxrs must be a * non-negative integer. Pass 0 to specify no restarts. * Default is 5. * Only for IDASPGMR. * IDASpbcgSetMaxl specifies the maximum Krylov subspace size. * Default is 5. * Only for IDASPBCG and IDASPTFQMR. * IDASpilsSetEpsLin specifies the factor in the linear iteration * convergence test constant. * Default is 0.05 * IDASpilsSetIncrementFactor specifies a factor in the increments * to yy used in the difference quotient approximations * to matrix-vector products Jv. * Default is 1.0 * * The return value of IDASpilsSet* is one of: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the ida memory was NULL * IDASPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve); SUNDIALS_EXPORT int IDASpilsSetJacTimesVecFn(void *ida_mem, IDASpilsJacTimesVecFn jtv); SUNDIALS_EXPORT int IDASpilsSetGSType(void *ida_mem, int gstype); SUNDIALS_EXPORT int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs); SUNDIALS_EXPORT int IDASpilsSetMaxl(void *ida_mem, int maxl); SUNDIALS_EXPORT int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); SUNDIALS_EXPORT int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); /* * ----------------------------------------------------------------- * Optional outputs from the IDASPILS linear solver *---------------------------------------------------------------- * * IDASpilsGetWorkSpace returns the real and integer workspace used * by IDASPILS. * IDASpilsGetNumPrecEvals returns the number of preconditioner * evaluations, i.e. the number of calls made to PrecSetup * with jok==FALSE. * IDASpilsGetNumPrecSolves returns the number of calls made to * PrecSolve. * IDASpilsGetNumLinIters returns the number of linear iterations. * IDASpilsGetNumConvFails returns the number of linear * convergence failures. * IDASpilsGetNumJtimesEvals returns the number of calls to jtimes * IDASpilsGetNumResEvals returns the number of calls to the user * res routine due to finite difference Jacobian times vector * evaluation. * IDASpilsGetLastFlag returns the last error flag set by any of * the IDASPILS interface functions. * * The return value of IDASpilsGet* is one of: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the ida memory was NULL * IDASPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); SUNDIALS_EXPORT int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); SUNDIALS_EXPORT int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); SUNDIALS_EXPORT int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); SUNDIALS_EXPORT int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); SUNDIALS_EXPORT int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); SUNDIALS_EXPORT int IDASpilsGetLastFlag(void *ida_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with an IDASPILS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *IDASpilsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/ida/ida_spgmr.h0000600000175000017500000000503711741421215020513 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:06 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the header file for the IDA Scaled Preconditioned GMRES * linear solver module, IDASPGMR. * ----------------------------------------------------------------- */ #ifndef _IDASPGMR_H #define _IDASPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * * Function : IDASpgmr * ----------------------------------------------------------------- * A call to the IDASpgmr function links the main integrator with * the IDASPGMR linear solver module. Its parameters are as * follows: * * IDA_mem is the pointer to memory block returned by IDACreate. * * maxl is the maximum Krylov subspace dimension, an * optional input. Pass 0 to use the default value, * MIN(Neq, 5). Otherwise pass a positive integer. * * The return values of IDASpgmr are: * IDASPILS_SUCCESS if successful * IDASPILS_MEM_NULL if the ida memory was NULL * IDASPILS_MEM_FAIL if there was a memory allocation failure * IDASPILS_ILL_INPUT if there was illegal input. * The above constants are defined in ida_spils.h * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDASpgmr(void *ida_mem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/0000755000175000017500000000000011767174700017142 5ustar sylvestresylvestresundials-2.5.0/include/cvodes/cvodes_bbdpre.h0000600000175000017500000003171311741421150022073 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVBBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with CVSPGMR/CVSPBCG/CVSPTFQMR, * and the parallel implementation of the NVECTOR module. * * * Part I contains type definitions and function prototypes for using * CVBBDPRE on forward problems (IVP integration and/or FSA) * * Part II contains type definitions and function prototypes for using * CVBBDPRE on adjopint (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSBBDPRE_H #define _CVSBBDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * PART I - forward problems * ================================================================= */ /* * ----------------------------------------------------------------- * * SUMMARY * * These routines provide a preconditioner matrix that is * block-diagonal with banded blocks. The blocking corresponds * to the distribution of the dependent variable vector y among * the processors. Each preconditioner block is generated from * the Jacobian of the local part (on the current processor) of a * given function g(t,y) approximating f(t,y). The blocks are * generated by a difference quotient scheme on each processor * independently. This scheme utilizes an assumed banded * structure with given half-bandwidths, mudq and mldq. * However, the banded Jacobian block kept by the scheme has * half-bandwiths mukeep and mlkeep, which may be smaller. * * The user's calling program should have the following form: * * #include * #include * ... * void *cvode_mem; * ... * Set y0 * ... * cvode_mem = CVodeCreate(...); * ier = CVodeMalloc(...); * ... * flag = CVSpgmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpbcg(cvode_mem, pretype, maxl); * -or- * flag = CVSptfqmr(cvode_mem, pretype, maxl); * ... * flag = CVBBDPrecInit(cvode_mem, Nlocal, mudq ,mldq, * mukeep, mlkeep, dqrely, gloc, cfn); * ... * ier = CVode(...); * ... * CVodeFree(&cvode_mem); * * Free y0 * * The user-supplied routines required are: * * f = function defining the ODE right-hand side f(t,y). * * gloc = function defining the approximation g(t,y). * * cfn = function to perform communication need for gloc. * * Notes: * * 1) This header file is included by the user for the definition * of the CVBBDData type and for needed function prototypes. * * 2) The CVBBDPrecInit call includes half-bandwiths mudq and mldq * to be used in the difference quotient calculation of the * approximate Jacobian. They need not be the true * half-bandwidths of the Jacobian of the local block of g, * when smaller values may provide a greater efficiency. * Also, the half-bandwidths mukeep and mlkeep of the retained * banded approximate Jacobian block may be even smaller, * to reduce storage and computation costs further. * For all four half-bandwidths, the values need not be the * same on every processor. * * 3) The actual name of the user's f function is passed to * CVodeInit, and the names of the user's gloc and cfn * functions are passed to CVBBDPrecInit. * * 4) The pointer to the user-defined data block user_data, which is * set through CVodeSetUserData is also available to the user in * gloc and cfn. * * 5) Optional outputs specific to this module are available by * way of routines listed below. These include work space sizes * and the cumulative number of gloc calls. The costs * associated with this module also include nsetups banded LU * factorizations, nlinsetups cfn calls, and npsolves banded * backsolve calls, where nlinsetups and npsolves are * integrator/CVSPGMR/CVSPBCG/CVSPTFQMR optional outputs. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : CVLocalFn * ----------------------------------------------------------------- * The user must supply a function g(t,y) which approximates the * right-hand side function f for the system y'=f(t,y), and which * is computed locally (without interprocess communication). * (The case where g is mathematically identical to f is allowed.) * The implementation of this function must have type CVLocalFn. * * This function takes as input the local vector size Nlocal, the * independent variable value t, the local real dependent * variable vector y, and a pointer to the user-defined data * block user_data. It is to compute the local part of g(t,y) and * store this in the vector g. * (Allocation of memory for y and g is handled within the * preconditioner module.) * The user_data parameter is the same as that specified by the user * through the CVodeSetFdata routine. * * A CVLocalFn should return 0 if successful, a positive value if * a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVLocalFn)(long int Nlocal, realtype t, N_Vector y, N_Vector g, void *user_data); /* * ----------------------------------------------------------------- * Type : CVCommFn * ----------------------------------------------------------------- * The user may supply a function of type CVCommFn which performs * all interprocess communication necessary to evaluate the * approximate right-hand side function described above. * * This function takes as input the local vector size Nlocal, * the independent variable value t, the dependent variable * vector y, and a pointer to the user-defined data block user_data. * The user_data parameter is the same as that specified by the user * through the CVodeSetUserData routine. The CVCommFn cfn is * expected to save communicated data in space defined within the * structure user_data. Note: A CVCommFn cfn does not have a return value. * * Each call to the CVCommFn cfn is preceded by a call to the * CVRhsFn f with the same (t,y) arguments. Thus cfn can omit any * communications done by f if relevant to the evaluation of g. * If all necessary communication was done by f, the user can * pass NULL for cfn in CVBBDPrecInit (see below). * * A CVCommFn should return 0 if successful, a positive value if * a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVCommFn)(long int Nlocal, realtype t, N_Vector y, void *user_data); /* * ----------------------------------------------------------------- * Function : CVBBDPrecInit * ----------------------------------------------------------------- * CVBBDPrecInit allocates and initializes the BBD preconditioner. * * The parameters of CVBBDPrecInit are as follows: * * cvode_mem is the pointer to the integrator memory. * * Nlocal is the length of the local block of the vectors y etc. * on the current processor. * * mudq, mldq are the upper and lower half-bandwidths to be used * in the difference quotient computation of the local * Jacobian block. * * mukeep, mlkeep are the upper and lower half-bandwidths of the * retained banded approximation to the local Jacobian * block. * * dqrely is an optional input. It is the relative increment * in components of y used in the difference quotient * approximations. To specify the default, pass 0. * The default is dqrely = sqrt(unit roundoff). * * gloc is the name of the user-supplied function g(t,y) that * approximates f and whose local Jacobian blocks are * to form the preconditioner. * * cfn is the name of the user-defined function that performs * necessary interprocess communication for the * execution of gloc. * * The return value of CVBBDPrecInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_ILL_INPUT if an input has an illegal value * CVSPILS_MEM_FAIL if a memory allocation request failed * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecInit(void *cvode_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn); /* * ----------------------------------------------------------------- * Function : CVBBDPrecReInit * ----------------------------------------------------------------- * CVBBDPrecReInit re-initializes the BBDPRE module when solving a * sequence of problems of the same size with CVSPGMR/CVBBDPRE, * CVSPBCG/CVBBDPRE, or CVSPTFQMR/CVBBDPRE provided there is no change * in Nlocal, mukeep, or mlkeep. After solving one problem, and after * calling CVodeReInit to re-initialize the integrator for a subsequent * problem, call CVBBDPrecReInit. * * All arguments have the same names and meanings as those * of CVBBDPrecInit. * * The return value of CVBBDPrecReInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecReInit(void *cvode_mem, long int mudq, long int mldq, realtype dqrely); /* * ----------------------------------------------------------------- * CVBBDPRE optional output extraction routines * ----------------------------------------------------------------- * CVBBDPrecGetWorkSpace returns the BBDPRE real and integer work space * sizes. * CVBBDPrecGetNumGfnEvals returns the number of calls to gfn. * * The return value of CVBBDPrecGet* is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP); /* * ================================================================= * PART II - backward problems * ================================================================= */ /* * ----------------------------------------------------------------- * Types: CVLocalFnB and CVCommFnB * ----------------------------------------------------------------- * Local approximation function and inter-process communication * function for the BBD preconditioner on the backward phase. * ----------------------------------------------------------------- */ typedef int (*CVLocalFnB)(long int NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector gB, void *user_dataB); typedef int (*CVCommFnB)(long int NlocalB, realtype t, N_Vector y, N_Vector yB, void *user_dataB); /* * ----------------------------------------------------------------- * Functions: CVBBDPrecInitB, CVBBDSp*B, CVBBDPrecReInit * ----------------------------------------------------------------- * Interface functions for the CVBBDPRE preconditioner to be used on * the backward phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBBDPrecInitB(void *cvode_mem, int which, long int NlocalB, long int mudqB, long int mldqB, long int mukeepB, long int mlkeepB, realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB); SUNDIALS_EXPORT int CVBBDPrecReInitB(void *cvode_mem, int which, long int mudqB, long int mldqB, realtype dqrelyB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_dense.h0000600000175000017500000000411211741421150021724 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the dense linear solver CVSDENSE. * ----------------------------------------------------------------- */ #ifndef _CVSDENSE_H #define _CVSDENSE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function: CVDense * ----------------------------------------------------------------- * A call to the CVDense function links the main integrator with * the CVSDENSE linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * The return value of CVDense is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the cvode memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDense(void *cvode_mem, long int N); /* * ----------------------------------------------------------------- * Function: CVDenseB * ----------------------------------------------------------------- * CVDenseB links the main CVODE integrator with the CVSDENSE * linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDenseB(void *cvode_mem, int which, long int nB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_direct.h0000600000175000017500000003331711741421150022111 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common header file for the direct linear solvers in CVODES. * * Part I contains type definitions and function prototypes for * using a CVDLS linear solver on forward problems (IVP * integration and/or FSA) * * Part II contains type definitions and function prototypes for * using a CVDLS linear solver on adjoint (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSDLS_H #define _CVSDLS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * C V S D I R E C T C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * CVSDIRECT return values * ----------------------------------------------------------------- */ #define CVDLS_SUCCESS 0 #define CVDLS_MEM_NULL -1 #define CVDLS_LMEM_NULL -2 #define CVDLS_ILL_INPUT -3 #define CVDLS_MEM_FAIL -4 /* Additional last_flag values */ #define CVDLS_JACFUNC_UNRECVR -5 #define CVDLS_JACFUNC_RECVR -6 /* Return values for the adjoint module */ #define CVDLS_NO_ADJ -101 #define CVDLS_LMEMB_NULL -102 /* * ================================================================= * PART I: F O R W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * FUNCTION TYPES * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type: CVDlsDenseJacFn * ----------------------------------------------------------------- * * A dense Jacobian approximation function Jac must be of type * CVDlsDenseJacFn. Its parameters are: * * N is the problem size. * * Jac is the dense matrix (of type DlsMat) that will be loaded * by a CVDlsDenseJacFn with an approximation to the Jacobian * matrix J = (df_i/dy_j) at the point (t,y). * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * user_data is a pointer to user data - the same as the user_data * parameter passed to CVodeSetFdata. * * tmp1, tmp2, and tmp3 are pointers to memory allocated for * vectors of length N which can be used by a CVDlsDenseJacFn * as temporary storage or work space. * * A CVDlsDenseJacFn should return 0 if successful, a positive * value if a recoverable error occurred, and a negative value if * an unrecoverable error occurred. * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load a dense Jac: * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = DENSE_COL(Jac,j); * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * (2) (without macros - explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = (Jac->data)[j]; * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * A third way, using the DENSE_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively * (see cvode.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h. * * ----------------------------------------------------------------- */ typedef int (*CVDlsDenseJacFn)(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type: CVDlsBandJacFn * ----------------------------------------------------------------- * * A band Jacobian approximation function Jac must have the * prototype given below. Its parameters are: * * N is the length of all vector arguments. * * mupper is the upper half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mupper parameter * passed by the user to the linear solver initialization function. * * mlower is the lower half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mlower parameter * passed by the user to the linear solver initialization function. * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * Jac is the band matrix (of type DlsMat) that will be loaded * by a CVDlsBandJacFn with an approximation to the Jacobian matrix * Jac = (df_i/dy_j) at the point (t,y). * Three efficient ways to load J are: * * (1) (with macros - no explicit data structure references) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (i=j-mupper; i <= j+mlower; i++) { * generate J_ij = the (i,j)th Jacobian element * BAND_COL_ELEM(col_j,i,j) = J_ij; * } * } * * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * * (3) (without macros - explicit data structure references) * offset = Jac->smu; * for (j=0; j < n; j++) { * col_j = ((Jac->data)[j])+offset; * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * Caution: Jac->smu is generally NOT the same as mupper. * * The BAND_ELEM(A,i,j) macro is appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * user_data is a pointer to user data - the same as the user_data * parameter passed to CVodeSetFdata. * * NOTE: If the user's Jacobian routine needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively * (see cvode.h). The unit roundoff is available as * UNIT_ROUNDOFF defined in sundials_types.h * * tmp1, tmp2, and tmp3 are pointers to memory allocated for * vectors of length N which can be used by a CVDlsBandJacFn * as temporary storage or work space. * * A CVDlsBandJacFn should return 0 if successful, a positive value * if a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * ----------------------------------------------------------------- */ typedef int (*CVDlsBandJacFn)(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * EXPORTED FUNCTIONS * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Optional inputs to the CVDLS linear solver * ----------------------------------------------------------------- * * CVDlsSetDenseJacFn specifies the dense Jacobian approximation * routine to be used for a direct dense linear solver. * * CVDlsSetBandJacFn specifies the band Jacobian approximation * routine to be used for a direct band linear solver. * * By default, a difference quotient approximation, supplied with * the solver is used. * * The return value is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODE memory was NULL * CVDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac); SUNDIALS_EXPORT int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac); /* * ----------------------------------------------------------------- * Optional outputs from the CVSDIRECT linear solver * ----------------------------------------------------------------- * * CVDlsGetWorkSpace returns the real and integer workspace used * by the direct linear solver. * CVDlsGetNumJacEvals returns the number of calls made to the * Jacobian evaluation routine jac. * CVDlsGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * CVDlsGetLastFlag returns the last error flag set by any of * the CVSDIRECT interface functions. * * The return value of CVDlsGet* is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODES memory was NULL * CVDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals); SUNDIALS_EXPORT int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVDlsGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVSDIRECT return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVDlsGetReturnFlagName(long int flag); /* * ================================================================= * PART II: B A C K W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * FUNCTION TYPES * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type: CVDlsDenseJacFnB * ----------------------------------------------------------------- * A dense Jacobian approximation function jacB for the adjoint * (backward) problem must have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*CVDlsDenseJacFnB)(long int nB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * Type : CVDlsBandJacFnB * ----------------------------------------------------------------- * A band Jacobian approximation function jacB for the adjoint * (backward) problem must have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*CVDlsBandJacFnB)(long int nB, long int mupperB, long int mlowerB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * EXPORTED FUNCTIONS * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Functions: CVDlsSetJacFnB * ----------------------------------------------------------------- * CVDlsSetDenseJacFnB and CVDlsSetBandJacFnB specify the dense and * band, respectively, Jacobian functions to be used by a * CVSDIRECT linear solver for the bacward integration phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDlsSetDenseJacFnB(void *cvode_mem, int which, CVDlsDenseJacFnB jacB); SUNDIALS_EXPORT int CVDlsSetBandJacFnB(void *cvode_mem, int which, CVDlsBandJacFnB jacB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_diag.h0000600000175000017500000001135511741421150021541 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the diagonal linear solver CVSDIAG. * * * Part I contains type definitions and function prototypes for using * CVDIAG on forward problems (IVP integration and/or FSA) * * Part II contains type definitions and function prototypes for using * CVDIAG on adjoint (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSDIAG_H #define _CVSDIAG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * CVDIAG return values * ----------------------------------------------------------------- */ #define CVDIAG_SUCCESS 0 #define CVDIAG_MEM_NULL -1 #define CVDIAG_LMEM_NULL -2 #define CVDIAG_ILL_INPUT -3 #define CVDIAG_MEM_FAIL -4 /* Additional last_flag values */ #define CVDIAG_INV_FAIL -5 #define CVDIAG_RHSFUNC_UNRECVR -6 #define CVDIAG_RHSFUNC_RECVR -7 /* Return values for adjoint module */ #define CVDIAG_NO_ADJ -101 /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : CVDiag * ----------------------------------------------------------------- * A call to the CVDiag function links the main integrator with * the CVDIAG linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * The return value of CVDiag is one of: * CVDIAG_SUCCESS if successful * CVDIAG_MEM_NULL if the cvode memory was NULL * CVDIAG_MEM_FAIL if there was a memory allocation failure * CVDIAG_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDiag(void *cvode_mem); /* * ----------------------------------------------------------------- * Optional outputs from the CVDIAG linear solver * ----------------------------------------------------------------- * * CVDiagGetWorkSpace returns the real and integer workspace used * by CVDIAG. * CVDiagGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * evaluation. * Note: The number of diagonal approximate * Jacobians formed is equal to the number of * CVDiagSetup calls. This number is available * through CVodeGetNumLinSolvSetups. * CVDiagGetLastFlag returns the last error flag set by any of * the CVDIAG interface functions. * * The return value of CVDiagGet* is one of: * CVDIAG_SUCCESS if successful * CVDIAG_MEM_NULL if the cvode memory was NULL * CVDIAG_LMEM_NULL if the cvdiag memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVDiagGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVDIAG return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVDiagGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function: CVDiagB * ----------------------------------------------------------------- * CVDiagB links the main CVODE integrator with the CVDIAG * linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVDiagB(void *cvode_mem, int which); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_lapack.h0000600000175000017500000000722411741421150022070 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2008/04/18 19:42:37 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the CVODES dense linear solver CVSLAPACK. * ----------------------------------------------------------------- */ #ifndef _CVSLAPACK_H #define _CVSLAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function: CVLapackDense * ----------------------------------------------------------------- * A call to the CVLapackDense function links the main integrator * with the CVSLAPACK linear solver using dense Jacobians. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * The return value of CVLapackDense is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODES memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackDense(void *cvode_mem, int N); /* * ----------------------------------------------------------------- * Function: CVLapackBand * ----------------------------------------------------------------- * A call to the CVLapackBand function links the main integrator * with the CVSLAPACK linear solver using banded Jacobians. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian approximation. * * mlower is the lower bandwidth of the band Jacobian approximation. * * The return value of CVLapackBand is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the CVODES memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing or * if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower); /* * ----------------------------------------------------------------- * Function: CVLapackDenseB * ----------------------------------------------------------------- * CVLapackDenseB links the main CVODE integrator with the dense * CVSLAPACK linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackDenseB(void *cvode_mem, int which, int nB); /* * ----------------------------------------------------------------- * Function: CVLapackBandB * ----------------------------------------------------------------- * CVLapackBandB links the main CVODE integrator with the band * CVSLAPACK linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVLapackBandB(void *cvode_mem, int which, int nB, int mupperB, int mlowerB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_bandpre.h0000600000175000017500000001462311741421150022251 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVSBANDPRE module, which * provides a banded difference quotient Jacobian-based * preconditioner and solver routines for use with CVSPGMR, * CVSPBCG, or CVSPTFQMR. * * Part I contains type definitions and function prototypes for using * CVSBANDPRE on forward problems (IVP integration and/or FSA) * * Part II contains type definitions and function prototypes for using * CVSBANDPRE on adjopint (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSBANDPRE_H #define _CVSBANDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * PART I - forward problems * ================================================================= */ /* * ----------------------------------------------------------------- * * SUMMARY * * These routines provide a band matrix preconditioner based on * difference quotients of the ODE right-hand side function f. * The user supplies parameters * mu = upper half-bandwidth (number of super-diagonals) * ml = lower half-bandwidth (number of sub-diagonals) * The routines generate a band matrix of bandwidth ml + mu + 1 * and use this to form a preconditioner for use with the Krylov * linear solver in CVSP*. Although this matrix is intended to * approximate the Jacobian df/dy, it may be a very crude * approximation. The true Jacobian need not be banded, or its * true bandwith may be larger than ml + mu + 1, as long as the * banded approximation generated here is sufficiently accurate * to speed convergence as a preconditioner. * * Usage: * The following is a summary of the usage of this module. * Details of the calls to CVodeCreate, CVodeMalloc, CVSp*, * and CVode are available in the User Guide. * To use these routines, the sequence of calls in the user * main program should be as follows: * * #include * #include * ... * Set y0 * ... * cvode_mem = CVodeCreate(...); * ier = CVodeMalloc(...); * ... * flag = CVSptfqmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpgmr(cvode_mem, pretype, maxl); * -or- * flag = CVSpbcg(cvode_mem, pretype, maxl); * ... * flag = CVBandPrecInit(cvode_mem, N, mu, ml); * ... * flag = CVode(...); * ... * Free y0 * ... * CVodeFree(&cvode_mem); * * Notes: * (1) Include this file for the CVBandPrecData type definition. * (2) In the CVBandPrecInit call, the arguments N is the * problem dimension. * (3) In the CVBPSp* call, the user is free to specify * the input pretype and the optional input maxl. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : CVBandPrecInit * ----------------------------------------------------------------- * CVBandPrecInit allocates and initializes the BANDPRE preconditioner * module. This functino must be called AFTER one of the SPILS linear * solver modules has been attached to the CVODE integrator. * * The parameters of CVBandPrecInit are as follows: * * cvode_mem is the pointer to CVODE memory returned by CVodeCreate. * * N is the problem size. * * mu is the upper half bandwidth. * * ml is the lower half bandwidth. * * The return value of CVBandPrecInit is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_ILL_INPUT if an input has an illegal value * CVSPILS_MEM_FAIL if a memory allocation request failed * * NOTE: The band preconditioner assumes a serial implementation * of the NVECTOR package. Therefore, CVBandPrecInit will * first test for a compatible N_Vector internal * representation by checking for required functions. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandPrecInit(void *cvode_mem, long int N, long int mu, long int ml); /* * ----------------------------------------------------------------- * Optional output functions : CVBandPrecGet* * ----------------------------------------------------------------- * CVBandPrecGetWorkSpace returns the real and integer work space used * by CVBANDPRE. * CVBandPrecGetNumRhsEvals returns the number of calls made from * CVBANDPRE to the user's right-hand side * routine f. * * The return value of CVBandPrecGet* is one of: * CVSPILS_SUCCESS if no errors occurred * CVSPILS_MEM_NULL if the integrator memory is NULL * CVSPILS_LMEM_NULL if the linear solver memory is NULL * CVSPILS_PMEM_NULL if the preconditioner memory is NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP); /* * ================================================================= * PART II - backward problems * ================================================================= */ /* * ----------------------------------------------------------------- * Functions: CVBandPrecInitB, CVBPSp*B * ----------------------------------------------------------------- * Interface functions for the CVBANDPRE preconditioner to be used * on the backward phase. * * CVBandPrecInitB interfaces to the CVBANDPRE preconditioner * for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandPrecInitB(void *cvode_mem, int which, long int nB, long int muB, long int mlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_band.h0000600000175000017500000000461211741421150021537 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the band linear solver CSVBAND. * ----------------------------------------------------------------- */ #ifndef _CVSBAND_H #define _CVSBAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : CVBand * ----------------------------------------------------------------- * A call to the CVBand function links the main CVODE integrator * with the CVSBAND linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian * approximation. * * mlower is the lower bandwidth of the band Jacobian * approximation. * * The return value of CVBand is one of: * CVDLS_SUCCESS if successful * CVDLS_MEM_NULL if the cvode memory was NULL * CVDLS_MEM_FAIL if there was a memory allocation failure * CVDLS_ILL_INPUT if a required vector operation is missing or * if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBand(void *cvode_mem, long int N, long int mupper, long int mlower); /* * ----------------------------------------------------------------- * Function: CVBandB * ----------------------------------------------------------------- * CVBandB links the main CVODE integrator with the CVSBAND * linear solver for the backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVBandB(void *cvode_mem, int which, long int nB, long int mupperB, long int mlowerB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes.h0000600000175000017500000024575311741421150020570 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.23 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the interface file for the main CVODES integrator. * ----------------------------------------------------------------- * * CVODES is used to solve numerically the ordinary initial value * problem: * * y' = f(t,y), * y(t0) = y0, * * where t0, y0 in R^N, and f: R x R^N -> R^N are given. * * Optionally, CVODES can perform forward or adjoint sensitivity * analysis to find sensitivities of the solution y with respect * to parameters in the right hand side f and/or in the initial * conditions y0. * * ----------------------------------------------------------------- * * 1: CONSTANTS * input constants * return flags * * 2: FUNCTION TYPES * CVRhsFn CVQuadRhsFn CVSensRhsFn CVSensRhs1Fn CVQuadSensRhsFn * CVRootFn * CVEwtFn * CVErrHandlerFn * CVRhsFnB CVRhsFnBS * CVQuadRhsFnB CVQuadRhsFnBS * * 3: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS * CVodeCreate * CVodeInit CVodeReInit * CVodeQuadInit CVodeQuadReInit * CVodeSensInit CVodeSensReInit * CVodeRootInit * CVodeFree CVodeQuadFree CVodeSensFree * * 4: OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS * * 5: MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS * CVode * * 6: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS * CVodeGetDky * CVodeGetQuad * CVodeGetQuadDky * CVodeGetSens CVodeGetSens1 * CVodeGetSensDky CVodeGetSensDky1 * CVodeGetQuadSens CVodeGetQuadSens1 * CVodeGetQuadSensDky CVodeGetQuadSensDky1 * * 7: OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS * * 8: INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS * CVodeAdjInit CVodeAdjReInit * CVodeAdjFree * CVodeInitB CVodeInitBS CVodeReInitB * CVodeQuadInitB CVodeQuadInitBS CVodeQuadReInitB * * 9 MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS * CVodeF * CVodeB * * 10: OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS * * 11: EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * CVodeGetB * CVodeGetQuadB * * 12: OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ----------------------------------------------------------------- */ #ifndef _CVODES_H #define _CVODES_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * * CVODES CONSTANTS * * ================================================================= */ /* * ----------------------------------------------------------------- * Enumerations for inputs to: * CVodeCreate (lmm, iter), * CVodeSensInit, CvodeSensinit1, CVodeSensReInit (ism), * CVodeAdjInit (interp), * CVode (itask) * ----------------------------------------------------------------- * Symbolic constants for the lmm and iter parameters to CVodeCreate * the input parameter itask to CVode, and the input parameter interp * to CVodeAdjInit, are given below. * * lmm: The user of the CVODES package specifies whether to use * the CV_ADAMS or CV_BDF (backward differentiation formula) * linear multistep method. The BDF method is recommended * for stiff problems, and the CV_ADAMS method is recommended * for nonstiff problems. * * iter: At each internal time step, a nonlinear equation must * be solved. The user can specify either CV_FUNCTIONAL * iteration, which does not require linear algebra, or a * CV_NEWTON iteration, which requires the solution of linear * systems. In the CV_NEWTON case, the user also specifies a * CVODE linear solver. CV_NEWTON is recommended in case of * stiff problems. * * ism: This parameter specifies the sensitivity corrector type * to be used. In the CV_SIMULTANEOUS case, the nonlinear * systems for states and all sensitivities are solved * simultaneously. In the CV_STAGGERED case, the nonlinear * system for states is solved first and then, the * nonlinear systems for all sensitivities are solved * at the same time. Finally, in the CV_STAGGERED1 approach * all nonlinear systems are solved in a sequence. * * itask: The itask input parameter to CVode indicates the job * of the solver for the next user step. The CV_NORMAL * itask is to have the solver take internal steps until * it has reached or just passed the user specified tout * parameter. The solver then interpolates in order to * return an approximate value of y(tout). The CV_ONE_STEP * option tells the solver to just take one internal step * and return the solution at the point reached by that step. * * interp: Specifies the interpolation type used to evaluate the * forward solution during the backward integration phase. * CV_HERMITE specifies cubic Hermite interpolation. * CV_POYNOMIAL specifies the polynomial interpolation * ----------------------------------------------------------------- */ /* lmm */ #define CV_ADAMS 1 #define CV_BDF 2 /* iter */ #define CV_FUNCTIONAL 1 #define CV_NEWTON 2 /* itask */ #define CV_NORMAL 1 #define CV_ONE_STEP 2 /* ism */ #define CV_SIMULTANEOUS 1 #define CV_STAGGERED 2 #define CV_STAGGERED1 3 /* DQtype */ #define CV_CENTERED 1 #define CV_FORWARD 2 /* interp */ #define CV_HERMITE 1 #define CV_POLYNOMIAL 2 /* * ---------------------------------------- * CVODES return flags * ---------------------------------------- */ #define CV_SUCCESS 0 #define CV_TSTOP_RETURN 1 #define CV_ROOT_RETURN 2 #define CV_WARNING 99 #define CV_TOO_MUCH_WORK -1 #define CV_TOO_MUCH_ACC -2 #define CV_ERR_FAILURE -3 #define CV_CONV_FAILURE -4 #define CV_LINIT_FAIL -5 #define CV_LSETUP_FAIL -6 #define CV_LSOLVE_FAIL -7 #define CV_RHSFUNC_FAIL -8 #define CV_FIRST_RHSFUNC_ERR -9 #define CV_REPTD_RHSFUNC_ERR -10 #define CV_UNREC_RHSFUNC_ERR -11 #define CV_RTFUNC_FAIL -12 #define CV_MEM_FAIL -20 #define CV_MEM_NULL -21 #define CV_ILL_INPUT -22 #define CV_NO_MALLOC -23 #define CV_BAD_K -24 #define CV_BAD_T -25 #define CV_BAD_DKY -26 #define CV_TOO_CLOSE -27 #define CV_NO_QUAD -30 #define CV_QRHSFUNC_FAIL -31 #define CV_FIRST_QRHSFUNC_ERR -32 #define CV_REPTD_QRHSFUNC_ERR -33 #define CV_UNREC_QRHSFUNC_ERR -34 #define CV_NO_SENS -40 #define CV_SRHSFUNC_FAIL -41 #define CV_FIRST_SRHSFUNC_ERR -42 #define CV_REPTD_SRHSFUNC_ERR -43 #define CV_UNREC_SRHSFUNC_ERR -44 #define CV_BAD_IS -45 #define CV_NO_QUADSENS -50 #define CV_QSRHSFUNC_FAIL -51 #define CV_FIRST_QSRHSFUNC_ERR -52 #define CV_REPTD_QSRHSFUNC_ERR -53 #define CV_UNREC_QSRHSFUNC_ERR -54 /* * ---------------------------------------- * CVODEA return flags * ---------------------------------------- */ #define CV_NO_ADJ -101 #define CV_NO_FWD -102 #define CV_NO_BCK -103 #define CV_BAD_TB0 -104 #define CV_REIFWD_FAIL -105 #define CV_FWD_FAIL -106 #define CV_GETY_BADT -107 /* * ================================================================= * * FUNCTION TYPES * * ================================================================= */ /* * ----------------------------------------------------------------- * Type : CVRhsFn * ----------------------------------------------------------------- * The f function which defines the right hand side of the ODE * system y' = f(t,y) must have type CVRhsFn. * f takes as input the independent variable value t, and the * dependent variable vector y. It stores the result of f(t,y) * in the vector ydot. The y and ydot arguments are of type * N_Vector. * (Allocation of memory for ydot is handled within CVODES) * The user_data parameter is the same as the user_data * parameter set by the user through the CVodeSetUserData routine. * This user-supplied pointer is passed to the user's f function * every time it is called. * * A CVRhsFn should return 0 if successful, a negative value if * an unrecoverable error occured, and a positive value if a * recoverable error (e.g. invalid y values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODES * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVRhsFn)(realtype t, N_Vector y, N_Vector ydot, void *user_data); /* * ----------------------------------------------------------------- * Type : CVRootFn * ----------------------------------------------------------------- * A function g, which defines a set of functions g_i(t,y) whose * roots are sought during the integration, must have type CVRootFn. * The function g takes as input the independent variable value * t, and the dependent variable vector y. It stores the nrtfn * values g_i(t,y) in the realtype array gout. * (Allocation of memory for gout is handled within CVODE.) * The user_data parameter is the same as that passed by the user * to the CVodeSetUserData routine. This user-supplied pointer is * passed to the user's g function every time it is called. * * A CVRootFn should return 0 if successful or a non-zero value * if an error occured (in which case the integration will be halted). * ----------------------------------------------------------------- */ typedef int (*CVRootFn)(realtype t, N_Vector y, realtype *gout, void *user_data); /* * ----------------------------------------------------------------- * Type : CVEwtFn * ----------------------------------------------------------------- * A function e, which sets the error weight vector ewt, must have * type CVEwtFn. * The function e takes as input the current dependent variable y. * It must set the vector of error weights used in the WRMS norm: * * ||y||_WRMS = sqrt [ 1/N * sum ( ewt_i * y_i)^2 ] * * Typically, the vector ewt has components: * * ewt_i = 1 / (reltol * |y_i| + abstol_i) * * The user_data parameter is the same as that passed by the user * to the CVodeSetUserData routine. This user-supplied pointer is * passed to the user's e function every time it is called. * A CVEwtFn e must return 0 if the error weight vector has been * successfuly set and a non-zero value otherwise. * ----------------------------------------------------------------- */ typedef int (*CVEwtFn)(N_Vector y, N_Vector ewt, void *user_data); /* * ----------------------------------------------------------------- * Type : CVErrHandlerFn * ----------------------------------------------------------------- * A function eh, which handles error messages, must have type * CVErrHandlerFn. * The function eh takes as input the error code, the name of the * module reporting the error, the error message, and a pointer to * user data, the same as that passed to CVodeSetUserData. * * All error codes are negative, except CV_WARNING which indicates * a warning (the solver continues). * * A CVErrHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*CVErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); /* * ----------------------------------------------------------------- * Type : CVQuadRhsFn * ----------------------------------------------------------------- * The fQ function which defines the right hand side of the * quadrature equations yQ' = fQ(t,y) must have type CVQuadRhsFn. * fQ takes as input the value of the independent variable t, * the vector of states y and must store the result of fQ in * yQdot. (Allocation of memory for yQdot is handled by CVODES). * The user_data parameter is the same as the user_data parameter * set by the user through the CVodeSetUserData routine and is * passed to the fQ function every time it is called. * * If the quadrature RHS also depends on the sensitivity variables, * i.e., yQ' = fQs(t,y,yS), then fQ must be of type CVodeQuadRhsFnS. * * A CVQuadRhsFn or CVodeQuadRhsFnS should return 0 if successful, * a negative value if an unrecoverable error occured, and a positive * value if a recoverable error (e.g. invalid y values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODES * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVQuadRhsFn)(realtype t, N_Vector y, N_Vector yQdot, void *user_data); /* * ----------------------------------------------------------------- * Type : CVSensRhsFn * ----------------------------------------------------------------- * The fS function which defines the right hand side of the * sensitivity ODE systems s' = f_y * s + f_p must have type * CVSensRhsFn. * fS takes as input the number of sensitivities Ns, the * independent variable value t, the states y and the * corresponding value of f(t,y) in ydot, and the dependent * sensitivity vectors yS. It stores the result of fS in ySdot. * (Allocation of memory for ySdot is handled within CVODES) * The user_data parameter is the same as the user_data parameter * set by the user through the CVodeSetUserData routine and is * passed to the fS function every time it is called. * * A CVSensRhsFn should return 0 if successful, a negative value if * an unrecoverable error occured, and a positive value if a * recoverable error (e.g. invalid y or yS values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODES * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVSensRhsFn)(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Type : CVSensRhs1Fn * ----------------------------------------------------------------- * The fS1 function which defines the right hand side of the i-th * sensitivity ODE system s_i' = f_y * s_i + f_p must have type * CVSensRhs1Fn. * fS1 takes as input the number of sensitivities Ns, the current * sensitivity iS, the independent variable value t, the states y * and the corresponding value of f(t,y) in ydot, and the * dependent sensitivity vector yS. It stores the result of fS in * ySdot. * (Allocation of memory for ySdot is handled within CVODES) * The user_data parameter is the same as the user_data parameter * set by the user through the CVodeSetUserData routine and is * passed to the fS1 function every time it is called. * * A CVSensRhs1Fn should return 0 if successful, a negative value if * an unrecoverable error occured, and a positive value if a * recoverable error (e.g. invalid y or yS values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODES * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVSensRhs1Fn)(int Ns, realtype t, N_Vector y, N_Vector ydot, int iS, N_Vector yS, N_Vector ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Type : CVQuadSensRhsFn * ----------------------------------------------------------------- * The fQS function which defines the right hand side of the * sensitivity ODE systems for quadratures, yQS' = fQ_y * yS + fQ_p * must have type CVQuadSensRhsFn. * * fQS takes as input the number of sensitivities Ns (the same as * that passed to CVodeQuadSensInit), the independent variable * value t, the states y and the dependent sensitivity vectors yS, * as well as the current value of the quadrature RHS yQdot. * It stores the result of fQS in yQSdot. * (Allocation of memory for yQSdot is handled within CVODES) * * A CVQuadSensRhsFn should return 0 if successful, a negative * value if an unrecoverable error occured, and a positive value * if a recoverable error (e.g. invalid y or yS values) occured. * If an unrecoverable occured, the integration is halted. * If a recoverable error occured, then (in most cases) CVODES * will try to correct and retry. * ----------------------------------------------------------------- */ typedef int (*CVQuadSensRhsFn)(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *user_data, N_Vector tmp, N_Vector tmpQ); /* * ----------------------------------------------------------------- * CVRhsFnB and CVRhsFnBS * The fB function which defines the right hand side of the * ODE systems to be integrated backwards must have type CVRhsFnB. * If the backward problem depends on forward sensitivities, its * RHS function must have type CVRhsFnBS. * ----------------------------------------------------------------- * CVQuadRhsFnB and CVQuadRhsFnBS * The fQB function which defines the quadratures to be integrated * backwards must have type CVQuadRhsFnB. * If the backward problem depends on forward sensitivities, its * quadrature RHS function must have type CVQuadRhsFnBS. * ----------------------------------------------------------------- */ typedef int (*CVRhsFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB); typedef int (*CVRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB); typedef int (*CVQuadRhsFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector qBdot, void *user_dataB); typedef int (*CVQuadRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB); /* * ================================================================= * * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * Function : CVodeCreate * ----------------------------------------------------------------- * CVodeCreate creates an internal memory block for a problem to * be solved by CVODES. * * lmm is the type of linear multistep method to be used. * The legal values are CV_ADAMS and CV_BDF (see previous * description). * * iter is the type of iteration used to solve the nonlinear * system that arises during each internal time step. * The legal values are CV_FUNCTIONAL and CV_NEWTON. * * If successful, CVodeCreate returns a pointer to initialized * problem memory. This pointer should be passed to CVodeInit. * If an initialization error occurs, CVodeCreate prints an error * message to standard err and returns NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void *CVodeCreate(int lmm, int iter); /* * ----------------------------------------------------------------- * Functions : CVodeInit and CVodeReInit * ----------------------------------------------------------------- * CVodeInit allocates and initializes memory for a problem to * to be solved by CVODE. * * CVodeReInit re-initializes CVode for the solution of a problem, * where a prior call to CVodeInit has been made with the same * problem size N. CVodeReInit performs the same input checking * and initializations that CVodeInit does. * But it does no memory allocation, assuming that the existing * internal memory is sufficient for the new problem. * * The use of CVodeReInit requires that the maximum method order, * maxord, is no larger for the new problem than for the problem * specified in the last call to CVodeInit. This condition is * automatically fulfilled if the multistep method parameter lmm * is unchanged (or changed from CV_ADAMS to CV_BDF) and the default * value for maxord is specified. * * cvode_mem is pointer to CVODE memory returned by CVodeCreate. * * f is the name of the C function defining the right-hand * side function in y' = f(t,y). * * t0 is the initial value of t. * * y0 is the initial condition vector y(t0). * * Return flag: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory was NULL * CV_MEM_FAIL if a memory allocation failed * CV_NO_MALLOC if cvode_mem has not been allocated * (i.e., CVodeInit has not been called). * CV_ILL_INPUT if an argument has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0); SUNDIALS_EXPORT int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0); /* * ----------------------------------------------------------------- * Functions : CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances. One of them * MUST be called before the first call to CVode. * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) * which will be called to set the error weight vector. * * The tolerances reltol and abstol define a vector of error weights, * ewt, with components * ewt[i] = 1/(reltol*abs(y[i]) + abstol) (in the SS case), or * ewt[i] = 1/(reltol*abs(y[i]) + abstol[i]) (in the SV case). * This vector is used in all error and convergence tests, which * use a weighted RMS norm on all error-like vectors v: * WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v[i]*ewt[i])^2 ), * where N is the problem dimension. * * The return value of these functions is equal to CV_SUCCESS = 0 if * there were no errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL (i.e., * CVodeCreate has not been called). * CV_NO_MALLOC indicating that cvode_mem has not been * allocated (i.e., CVodeInit has not been * called). * CV_ILL_INPUT indicating an input argument was illegal * (e.g. a negative tolerance) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun); /* * ----------------------------------------------------------------- * Function : CVodeQuadInit and CVodeQuadReInit * ----------------------------------------------------------------- * CVodeQuadInit allocates and initializes memory related to * quadrature integration. * * CVodeQuadReInit re-initializes CVODES's quadrature related * memory for a problem, assuming it has already been allocated * in prior calls to CVodeInit and CVodeQuadInit. * The number of quadratures Nq is assumed to be unchanged * since the previous call to CVodeQuadInit. * * cvode_mem is a pointer to CVODES memory returned by CVodeCreate * * fQ is the user-provided integrand routine. * * yQ0 is an N_Vector with initial values for quadratures * (typically yQ0 has all zero components). * * Return values: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory was NULL * CV_MEM_FAIL if a memory allocation failed * CV_NO_QUAD if quadratures were not initialized * (i.e. CVodeQuadInit has not been called) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); SUNDIALS_EXPORT int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0); /* * ----------------------------------------------------------------- * Functions : CVodeQuadSStolerances * CVodeQuadSVtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for quadrature * variables. One of them MUST be called before the first call to * CVode IF error control on the quadrature variables is enabled * (see CVodeSetQuadErrCon). * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * * Return values: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory was NULL * CV_NO_QUAD if quadratures were not initialized * CV_ILL_INPUT if an input argument was illegal * (e.g. a negative tolerance) * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ); SUNDIALS_EXPORT int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ); /* * ----------------------------------------------------------------- * Function : CVodeSensInit, CVSensInit1, and CVodeSensReInit * ----------------------------------------------------------------- * CVodeSensInit and CVSensInit1 allocate and initialize memory * related to sensitivity computations. They only differ in the * type of the sensitivity RHS function: CVodeSensInit specifies * fS of type CVSensRhsFn (i.e. a function that evaluates all * sensitivity RHS simultaneously), while CVodeSensInit1 specifies * fS of type CVSensRhs1Fn (i.e. a function that evaluates one * sensitivity RHS at a time). Recall that ism=CV_STAGGERED1 is * compatible ONLY with a CVSensRhs1Fn. As such, this value for * ism cannot be passed to CVodeSensInit. * * CVodeSensReInit re-initializes CVODES's sensitivity related * memory for a problem, assuming it has already been allocated * in prior calls to CVodeInit and CVodeSensInit. * The number of sensitivities Ns is assumed to be unchanged * since the previous call to CVodeSensInit. * If any error occurs during initialization, it is reported to * the file whose file pointer is errfp. * CVodeSensReInit potentially does some minimal memory allocation * (for the sensitivity absolute tolerance and for arrays of * counters used by the CV_STAGGERED1 method). * cvode_mem is pointer to CVODES memory returned by CVodeCreate * * Ns is the number of sensitivities to be computed. * * ism is the type of corrector used in sensitivity * analysis. The legal values are: CV_SIMULTANEOUS, * CV_STAGGERED, and CV_STAGGERED1. * * fS is the sensitivity righ-hand side function * (pass NULL to use the internal DQ approximation) * * yS0 is the array of initial condition vectors for * sensitivity variables. * * Return values: * CV_SUCCESS * CV_MEM_NULL * CV_ILL_INPUT * CV_MEM_FAIL * CV_NO_SENS * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSensInit(void *cvode_mem, int Ns, int ism, CVSensRhsFn fS, N_Vector *yS0); SUNDIALS_EXPORT int CVodeSensInit1(void *cvode_mem, int Ns, int ism, CVSensRhs1Fn fS1, N_Vector *yS0); SUNDIALS_EXPORT int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0); /* * ----------------------------------------------------------------- * Functions : CVodeSensSStolerances * CVodeSensSVtolerances * CVodeSensEEtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to CVode. * * CVodeSensSStolerances specifies scalar relative and absolute tolerances. * CVodeSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * CVodeSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. * * The return value is equal to CV_SUCCESS = 0 if there were no * errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL, or * CV_NO_SENS indicating there was not a prior call to * CVodeSensInit. * CV_ILL_INPUT indicating an input argument was illegal * (e.g. negative tolerances) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS); SUNDIALS_EXPORT int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS); SUNDIALS_EXPORT int CVodeSensEEtolerances(void *cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeQuadSensInit and CVodeQuadSensReInit * ----------------------------------------------------------------- * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0); SUNDIALS_EXPORT int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0); /* * ----------------------------------------------------------------- * Functions : CVodeQuadSensSStolerances * CVodeQuadSensSVtolerances * CVodeQuadSensEEtolerances * ----------------------------------------------------------------- * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to CVode IF these variables are included in the error test. * * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of CVodeQuad**tolerances. * * The return value is equal to CV_SUCCESS = 0 if there were no * errors; otherwise it is a negative int equal to: * CV_MEM_NULL if cvode_mem was NULL, or * CV_NO_QuadSENS if there was not a prior call to * CVodeQuadSensInit. * CV_ILL_INPUT if an input argument was illegal * (e.g. negative tolerances) * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS); SUNDIALS_EXPORT int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS); SUNDIALS_EXPORT int CVodeQuadSensEEtolerances(void *cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeRootInit * ----------------------------------------------------------------- * CVodeRootInit initializes a rootfinding problem to be solved * during the integration of the ODE system. It must be called * after CVodeCreate, and before CVode. The arguments are: * * cvode_mem = pointer to CVODE memory returned by CVodeCreate. * * nrtfn = number of functions g_i, an int >= 0. * * g = name of user-supplied function, of type CVRootFn, * defining the functions g_i whose roots are sought. * * If a new problem is to be solved with a call to CVodeReInit, * where the new problem has no root functions but the prior one * did, then call CVodeRootInit with nrtfn = 0. * * The return value of CVodeRootInit is CV_SUCCESS = 0 if there were * no errors; otherwise it is a negative int equal to: * CV_MEM_NULL indicating cvode_mem was NULL, or * CV_MEM_FAIL indicating a memory allocation failed. * (including an attempt to increase maxord). * CV_ILL_INPUT indicating nrtfn > 0 but g = NULL. * In case of an error return, an error message is also printed. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g); /* * ----------------------------------------------------------------- * Function : CVodeFree * ----------------------------------------------------------------- * CVodeFree frees the problem memory cvode_mem allocated by * CVodeInit. Its only argument is the pointer cvode_mem * returned by CVodeCreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeFree(void **cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeQuadFree * ----------------------------------------------------------------- * CVodeQuadFree frees the problem memory in cvode_mem allocated * for quadrature integration. Its only argument is the pointer * cvode_mem returned by CVodeCreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeQuadFree(void *cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeSensFree * ----------------------------------------------------------------- * CVodeSensFree frees the problem memory in cvode_mem allocated * for sensitivity analysis. Its only argument is the pointer * cvode_mem returned by CVodeCreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeSensFree(void *cvode_mem); /* * ----------------------------------------------------------------- * Function : CVodeQuadSensFree * ----------------------------------------------------------------- * CVodeQuadSensFree frees the problem memory in cvode_mem allocated * for quadrature sensitivity analysis. Its only argument is the * pointer cvode_mem returned by CVodeCreate. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeQuadSensFree(void *cvode_mem); /* * ================================================================= * * OPTIONAL INPUT FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * Integrator optional input specification functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * Function | Optional input / [ default value ] * ----------------------------------------------------------------- * | * CVodeSetErrHandlerFn | user-provided ErrHandler function. * | [internal] * | * CVodeSetErrFile | the file pointer for an error file * | where all CVODE warning and error * | messages will be written if the default * | internal error handling function is used. * | This parameter can be stdout (standard * | output), stderr (standard error), or a * | file pointer (corresponding to a user * | error file opened for writing) returned * | by fopen. * | If not called, then all messages will * | be written to the standard error stream. * | [stderr] * | * CVodeSetUserData | a pointer to user data that will be * | passed to the user's f function every * | time f is called. * | [NULL] * | * CVodeSetMaxOrd | maximum lmm order to be used by the * | solver. * | [12 for Adams , 5 for BDF] * | * CVodeSetMaxNumSteps | maximum number of internal steps to be * | taken by the solver in its attempt to * | reach tout. * | [500] * | * CVodeSetMaxHnilWarns | maximum number of warning messages * | issued by the solver that t+h==t on the * | next internal step. A value of -1 means * | no such messages are issued. * | [10] * | * CVodeSetStabLimDet | flag to turn on/off stability limit * | detection (TRUE = on, FALSE = off). * | When BDF is used and order is 3 or * | greater, CVsldet is called to detect * | stability limit. If limit is detected, * | the order is reduced. * | [FALSE] * | * CVodeSetInitStep | initial step size. * | [estimated by CVODES] * | * CVodeSetMinStep | minimum absolute value of step size * | allowed. * | [0.0] * | * CVodeSetMaxStep | maximum absolute value of step size * | allowed. * | [infinity] * | * CVodeSetStopTime | the independent variable value past * | which the solution is not to proceed. * | [infinity] * | * CVodeSetMaxErrTestFails | Maximum number of error test failures * | in attempting one step. * | [7] * | * CVodeSetMaxNonlinIters | Maximum number of nonlinear solver * | iterations at one solution. * | [3] * | * CVodeSetMaxConvFails | Maximum number of allowable conv. * | failures in attempting one step. * | [10] * | * CVodeSetNonlinConvCoef | Coeficient in the nonlinear conv. * | test. * | [0.1] * | * ----------------------------------------------------------------- * | * CVodeSetIterType | Changes the current nonlinear iteration * | type. * | [set by CVodecreate] * | * ----------------------------------------------------------------- * | * CVodeSetRootDirection | Specifies the direction of zero * | crossings to be monitored * | [both directions] * | * CVodeSetNoInactiveRootWarn | disable warning about possible * | g==0 at beginning of integration * | * ----------------------------------------------------------------- * Return flag: * CV_SUCCESS if successful * CV_MEM_NULL if the cvode memory is NULL * CV_ILL_INPUT if an argument has an illegal value * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int CVodeSetErrFile(void *cvode_mem, FILE *errfp); SUNDIALS_EXPORT int CVodeSetUserData(void *cvode_mem, void *user_data); SUNDIALS_EXPORT int CVodeSetMaxOrd(void *cvode_mem, int maxord); SUNDIALS_EXPORT int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); SUNDIALS_EXPORT int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); SUNDIALS_EXPORT int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); SUNDIALS_EXPORT int CVodeSetInitStep(void *cvode_mem, realtype hin); SUNDIALS_EXPORT int CVodeSetMinStep(void *cvode_mem, realtype hmin); SUNDIALS_EXPORT int CVodeSetMaxStep(void *cvode_mem, realtype hmax); SUNDIALS_EXPORT int CVodeSetStopTime(void *cvode_mem, realtype tstop); SUNDIALS_EXPORT int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); SUNDIALS_EXPORT int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); SUNDIALS_EXPORT int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); SUNDIALS_EXPORT int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); SUNDIALS_EXPORT int CVodeSetIterType(void *cvode_mem, int iter); SUNDIALS_EXPORT int CVodeSetRootDirection(void *cvode_mem, int *rootdir); SUNDIALS_EXPORT int CVodeSetNoInactiveRootWarn(void *cvode_mem); /* * ----------------------------------------------------------------- * Quadrature optional input specification functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * Function | Optional input / [ default value ] * -------------------------------------------------------------- * | * CVodeSetQuadErrCon | are quadrature variables considered in * | the error control? * | If yes, tolerances for quadrature are * | required (see CVodeQuad**tolerances) * | [errconQ = FALSE] * | * ----------------------------------------------------------------- * If successful, these functions return CV_SUCCESS. If an argument * has an illegal value, they return one of the error flags * defined for the CVodeSet* routines. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ); /* * ----------------------------------------------------------------- * Forward sensitivity optional input specification functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs * to other values than the defaults given below: * * Function | Optional input / [ default value ] * ----------------------------------------------------------------- * | * CVodeSetSensDQMethod | controls the selection of finite * | difference schemes used in evaluating * | the sensitivity right hand sides: * | (centered vs. forward and * | simultaneous vs. separate) * | [DQtype=CV_CENTERED] * | [DQrhomax=0.0] * | * CVodeSetSensParams | parameter information: * | p: pointer to problem parameters * | plist: list of parameters with respect * | to which sensitivities are to be * | computed. * | pbar: order of magnitude info. * | Typically, if p[plist[i]] is nonzero, * | pbar[i]=p[plist[i]]. * | [p=NULL] * | [plist=NULL] * | [pbar=NULL] * | * CVodeSetSensErrCon | are sensitivity variables considered in * | the error control? * | [FALSE] * | * CVodeSetSensMaxNonlinIters | Maximum number of nonlinear solver * | iterations at one solution. * | [3] * | * ----------------------------------------------------------------- * The return values are the same as for CVodeSet* * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax); SUNDIALS_EXPORT int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS); SUNDIALS_EXPORT int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS); SUNDIALS_EXPORT int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist); /* * ----------------------------------------------------------------- * Quadrature sensitivity optional input specification functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs * to values other than the defaults given below: * * Function | Optional input / [ default value ] * -------------------------------------------------------------- * | * CVodeSetQuadSensErrCon | are quadrature sensitivity variables * | considered in the error control? * | If yes, tolerances for quadrature * | sensitivity variables are required. * | [errconQS = FALSE] * | * ----------------------------------------------------------------- * If successful, these functions return CV_SUCCESS. If an argument * has an illegal value, they return one of the error flags * defined for the CVodeSet* routines. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS); /* * ----------------------------------------------------------------- * Function : CVodeSensToggleOff * ----------------------------------------------------------------- * CVodeSensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory so that * sensitivity computations can be later toggled ON (through * CVodeSensReInit). * * The return value is equal to CV_SUCCESS = 0 if there were no * errors or CV_MEM_NULL if cvode_mem was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSensToggleOff(void *cvode_mem); /* * ================================================================= * * MAIN SOLVER FUNCTION FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * Function : CVode * ----------------------------------------------------------------- * CVode integrates the ODE over an interval in t. * If itask is CV_NORMAL, then the solver integrates from its * current internal t value to a point at or beyond tout, then * interpolates to t = tout and returns y(tout) in the user- * allocated vector yout. If itask is CV_ONE_STEP, then the solver * takes one internal time step and returns in yout the value of * y at the new internal time. In this case, tout is used only * during the first call to CVode to determine the direction of * integration and the rough scale of the problem. If tstop is * enabled (through a call to CVodeSetStopTime), then CVode returns * the solution at tstop. Once the integrator returns at a tstop * time, any future testing for tstop is disabled (and can be * reenabled only though a new call to CVodeSetStopTime). * The time reached by the solver is placed in (*tret). The * user is responsible for allocating the memory for this value. * * cvode_mem is the pointer to CVODES memory returned by * CVodeCreate. * * tout is the next time at which a computed solution is desired. * * yout is the computed solution vector. In CV_NORMAL mode with no * errors and no roots found, yout=y(tout). * * tret is a pointer to a real location. CVode sets (*tret) to * the time reached by the solver and returns yout=y(*tret). * * itask is CV_NORMAL or CV_ONE_STEP. These two modes are described above. * * Here is a brief description of each return value: * * CV_SUCCESS: CVode succeeded and no roots were found. * * CV_ROOT_RETURN: CVode succeeded, and found one or more roots. * If nrtfn > 1, call CVodeGetRootInfo to see * which g_i were found to have a root at (*tret). * * CV_TSTOP_RETURN: CVode succeded and returned at tstop. * * CV_MEM_NULL: The cvode_mem argument was NULL. * * CV_NO_MALLOC: cvode_mem was not allocated. * * CV_ILL_INPUT: One of the inputs to CVode is illegal. This * includes the situation when a component of the * error weight vectors becomes < 0 during * internal time-stepping. The ILL_INPUT flag * will also be returned if the linear solver * routine CV--- (called by the user after * calling CVodeCreate) failed to set one of the * linear solver-related fields in cvode_mem or * if the linear solver's init routine failed. In * any case, the user should see the printed * error message for more details. * * CV_TOO_MUCH_WORK: The solver took mxstep internal steps but * could not reach tout. The default value for * mxstep is MXSTEP_DEFAULT = 500. * * CV_TOO_MUCH_ACC: The solver could not satisfy the accuracy * demanded by the user for some internal step. * * CV_ERR_FAILURE: Error test failures occurred too many times * (= MXNEF = 7) during one internal time step or * occurred with |h| = hmin. * * CV_CONV_FAILURE: Convergence test failures occurred too many * times (= MXNCF = 10) during one internal time * step or occurred with |h| = hmin. * * CV_LINIT_FAIL: The linear solver's initialization function * failed. * * CV_LSETUP_FAIL: The linear solver's setup routine failed in an * unrecoverable manner. * * CV_LSOLVE_FAIL: The linear solver's solve routine failed in an * unrecoverable manner. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask); /* * ================================================================= * * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * Function : CVodeGetDky * ----------------------------------------------------------------- * CVodeGetDky computes the kth derivative of the y function at * time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * k=0, 1, ..., qu, where qu is the current order. The * derivative vector is returned in dky. This vector must be * allocated by the caller. It is only legal to call this * function after a successful return from CVode. * * cvode_mem is the pointer to CVODES memory returned by * CVodeCreate. * * t is the time at which the kth derivative of y is evaluated. * The legal range for t is [tn-hu,tn] as described above. * * k is the order of the derivative of y to be computed. The * legal range for k is [0,qu] as described above. * * dky is the output derivative vector [(D_k)y](t). * * The return values for CVodeGetDky are defined below. * Here is a brief description of each return value: * * CV_SUCCESS: CVodeGetDky succeeded. * * CV_BAD_K : k is not in the range 0, 1, ..., qu. * * CV_BAD_T : t is not in the interval [tn-hu,tn]. * * CV_BAD_DKY : The dky argument was NULL. * * CV_MEM_NULL : The cvode_mem argument was NULL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); /* * ----------------------------------------------------------------- * Quadrature integration solution extraction routines * ----------------------------------------------------------------- * The following functions can be called to obtain the quadrature * variables after a successful integration step. * If quadratures were not computed, they return CV_NO_QUAD. * * CVodeGetQuad returns the quadrature variables at the same time * as that at which CVode returned the solution. * * CVodeGetQuadDky returns the quadrature variables (or their * derivatives up to the current method order) at any time within * the last integration step (dense output). See CVodeGetQuad for * more information. * * The output vectors yQout and dky must be allocated by the user. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout); SUNDIALS_EXPORT int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dky); /* * ----------------------------------------------------------------- * Forward sensitivity solution extraction routines * ----------------------------------------------------------------- * The following functions can be called to obtain the sensitivity * variables after a successful integration step. * * CVodeGetSens and CVodeGetSens1 return all the sensitivity vectors * or only one of them, respectively, at the same time as that at * which CVode returned the solution. * The array of output vectors or output vector ySout must be * allocated by the user. * * CVodeGetSensDky1 computes the kth derivative of the is-th * sensitivity (is=1, 2, ..., Ns) of the y function at time t, * where tn-hu <= t <= tn, tn denotes the current internal time * reached, and hu is the last internal step size successfully * used by the solver. The user may request k=0, 1, ..., qu, * where qu is the current order. * The is-th sensitivity derivative vector is returned in dky. * This vector must be allocated by the caller. It is only legal * to call this function after a successful return from CVode * with sensitivty computations enabled. * Arguments have the same meaning as in CVodeDky. * * CVodeGetSensDky computes the k-th derivative of all * sensitivities of the y function at time t. It repeatedly calls * CVodeGetSensDky. The argument dkyA must be a pointer to * N_Vector and must be allocated by the user to hold at least Ns * vectors. * * Return values are similar to those of CVodeDky. Additionally, * CVodeSensDky can return CV_NO_SENS if sensitivities were * not computed and CV_BAD_IS if is < 0 or is >= Ns. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout); SUNDIALS_EXPORT int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout); SUNDIALS_EXPORT int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyA); SUNDIALS_EXPORT int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dky); /* * ----------------------------------------------------------------- * Quadrature sensitivity solution extraction routines * ----------------------------------------------------------------- * The following functions can be called to obtain the quadrature * sensitivity variables after a successful integration step. * * CVodeGetQuadSens and CVodeGetQuadSens1 return all the quadrature * sensitivity vectors or only one of them, respectively, at the * same time as that at which CVode returned the solution. * The array of output vectors or output vector yQSout must be * allocated by the user. * * CVodeGetQuadSensDky1 computes the kth derivative of the is-th * quadrature sensitivity (is=1, 2, ..., Ns) at time t, where * tn-hu <= t <= tn, tn denotes the current internal time * reached, and hu is the last internal step size successfully * used by the solver. The user may request k=0, 1, ..., qu, * where qu is the current order. * The is-th sensitivity derivative vector is returned in dkyQS. * This vector must be allocated by the caller. It is only legal * to call this function after a successful return from CVode * with quadrature sensitivty computations enabled. * Arguments have the same meaning as in CVodeDky. * * CVodeGetQuadSensDky computes the k-th derivative of all * quadrature sensitivities at time t. It repeatedly calls * CVodeGetSensDky. The argument dkyQS_all must be a pointer to * N_Vector and must be allocated by the user to hold at least Ns * vectors. * * Return values are similar to those of CVodeDky. Additionally, * CVodeQuadSensDky can return CV_NO_QUADSENS if quadrature * sensitivities were not computed and CV_BAD_IS if is < 0 or is >= Ns. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout); SUNDIALS_EXPORT int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout); SUNDIALS_EXPORT int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all); SUNDIALS_EXPORT int CVodeGetQuadSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyQS); /* * ================================================================= * * OPTIONAL OUTPUT FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * Integrator optional output extraction functions * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the main integrator. * ----------------------------------------------------------------- * CVodeGetWorkSpace returns the CVODES real and integer workspaces * CVodeGetNumSteps returns the cumulative number of internal * steps taken by the solver * CVodeGetNumRhsEvals returns the number of calls to the user's * f function * CVodeGetNumLinSolvSetups returns the number of calls made to * the linear solver's setup routine * CVodeGetNumErrTestFails returns the number of local error test * failures that have occured * CVodeGetLastOrder returns the order used during the last * internal step * CVodeGetCurrentOrder returns the order to be used on the next * internal step * CVodeGetNumStabLimOrderReds returns the number of order * reductions due to stability limit detection * CVodeGetActualInitStep returns the actual initial step size * used by CVODES * CVodeGetLastStep returns the step size for the last internal * step * CVodeGetCurrentStep returns the step size to be attempted on * the next internal step * CVodeGetCurrentTime returns the current internal time reached * by the solver * CVodeGetTolScaleFactor returns a suggested factor by which the * user's tolerances should be scaled when too * much accuracy has been requested for some * internal step * CVodeGetErrWeights returns the current error weight vector. * The user must allocate space for eweight. * CVodeGetEstLocalErrors returns the vector of estimated local * errors. The user must allocate space for ele. * CVodeGetNumGEvals returns the number of calls to the user's * g function (for rootfinding) * CVodeGetRootInfo returns the indices for which g_i was found to * have a root. The user must allocate space for * rootsfound. For i = 0 ... nrtfn-1, * rootsfound[i] = 1 if g_i has a root, and = 0 if not. * * CVodeGet* return values: * CV_SUCCESS if succesful * CV_MEM_NULL if the cvode memory was NULL * CV_NO_SLDET if stability limit was not turned on * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); SUNDIALS_EXPORT int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); SUNDIALS_EXPORT int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); SUNDIALS_EXPORT int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); SUNDIALS_EXPORT int CVodeGetLastOrder(void *cvode_mem, int *qlast); SUNDIALS_EXPORT int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); SUNDIALS_EXPORT int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); SUNDIALS_EXPORT int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); SUNDIALS_EXPORT int CVodeGetLastStep(void *cvode_mem, realtype *hlast); SUNDIALS_EXPORT int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); SUNDIALS_EXPORT int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); SUNDIALS_EXPORT int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); SUNDIALS_EXPORT int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight); SUNDIALS_EXPORT int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele); SUNDIALS_EXPORT int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); SUNDIALS_EXPORT int CVodeGetRootInfo(void *cvode_mem, int *rootsfound); /* * ----------------------------------------------------------------- * As a convenience, the following functions provides the * optional outputs in one group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); /* * ----------------------------------------------------------------- * Nonlinear solver optional output extraction functions * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the nonlinear solver. * ----------------------------------------------------------------- * CVodeGetNumNonlinSolvIters returns the number of nonlinear * solver iterations performed. * CVodeGetNumNonlinSolvConvFails returns the number of nonlinear * convergence failures. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); SUNDIALS_EXPORT int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * nonlinear solver optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, long int *nncfails); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVODES return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVodeGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * Quadrature integration optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the integration of quadratures. * ----------------------------------------------------------------- * CVodeGetQuadNumRhsEvals returns the number of calls to the * user function fQ defining the right hand * side of the quadrature variables. * CVodeGetQuadNumErrTestFails returns the number of local error * test failures for quadrature variables. * CVodeGetQuadErrWeights returns the vector of error weights for * the quadrature variables. The user must * allocate space for ewtQ. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals); SUNDIALS_EXPORT int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails); SUNDIALS_EXPORT int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the above * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails); /* * ----------------------------------------------------------------- * Forward sensitivity optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the integration of sensitivities. * ----------------------------------------------------------------- * CVodeGetSensNumRhsEvals returns the number of calls to the * sensitivity right hand side routine. * CVodeGetNumRhsEvalsSens returns the number of calls to the * user f routine due to finite difference evaluations of the * sensitivity equations. * CVodeGetSensNumErrTestFails returns the number of local error * test failures for sensitivity variables. * CVodeGetSensNumLinSolvSetups returns the number of calls made * to the linear solver's setup routine due to sensitivity computations. * CVodeGetSensErrWeights returns the sensitivity error weight * vectors. The user need not allocate space for ewtS. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals); SUNDIALS_EXPORT int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS); SUNDIALS_EXPORT int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails); SUNDIALS_EXPORT int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS); SUNDIALS_EXPORT int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, long int *nSetfails, long int *nlinsetupsS); /* * ----------------------------------------------------------------- * Sensitivity nonlinear solver optional output extraction * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistics related to the sensitivity nonlinear solver. * ----------------------------------------------------------------- * CVodeGetSensNumNonlinSolvIters returns the total number of * nonlinear iterations for sensitivity variables. * CVodeGetSensNumNonlinSolvConvFails returns the total number * of nonlinear convergence failures for sensitivity variables * CVodeGetStgrSensNumNonlinSolvIters returns a vector of Ns * nonlinear iteration counters for sensitivity variables in * the CV_STAGGERED1 method. * CVodeGetStgrSensNumNonlinSolvConvFails returns a vector of Ns * nonlinear solver convergence failure counters for sensitivity * variables in the CV_STAGGERED1 method. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvIters(void *cvode_mem, long int *nSniters); SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSncfails); SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters); SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSTGR1ncfails); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the * optional outputs in groups. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, long int *nSncfails); /* * ----------------------------------------------------------------- * Quadrature sensitivity optional output extraction routines * ----------------------------------------------------------------- * The following functions can be called to get optional outputs and * statistics related to the integration of quadrature sensitivitiess. * ----------------------------------------------------------------- * CVodeGetQuadSensNumRhsEvals returns the number of calls to the * user function fQS defining the right hand side of the * quadrature sensitivity equations. * CVodeGetQuadSensNumErrTestFails returns the number of local error * test failures for quadrature sensitivity variables. * CVodeGetQuadSensErrWeights returns the vector of error weights * for the quadrature sensitivity variables. The user must * allocate space for ewtQS. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals); SUNDIALS_EXPORT int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails); SUNDIALS_EXPORT int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight); /* * ----------------------------------------------------------------- * As a convenience, the following function provides the above * optional outputs in a group. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetQuadSensStats(void *cvode_mem, long int *nfQSevals, long int *nQSetfails); /* * ================================================================= * * INITIALIZATION AND DEALLOCATION FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * CVodeAdjInit * ----------------------------------------------------------------- * CVodeAdjInit specifies some parameters for ASA, initializes ASA * and allocates space for the adjoint memory structure. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeAdjInit(void *cvode_mem, long int steps, int interp); /* * ----------------------------------------------------------------- * CVodeAdjReInit * ----------------------------------------------------------------- * CVodeAdjReInit reinitializes the CVODES memory structure for ASA, * assuming that the number of steps between check points and the * type of interpolation remained unchanged. The list of check points * (and associated memory) is deleted. The list of backward problems * is kept (however, new backward problems can be added to this list * by calling CVodeCreateB). The CVODES memory for the forward and * backward problems can be reinitialized separately by calling * CVodeReInit and CVodeReInitB, respectively. * NOTE: if a entirely new list of backward problems is desired, * then simply free the adjoint memory (by calling CVodeAdjFree) * and reinitialize ASA with CVodeAdjInit. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeAdjReInit(void *cvode_mem); /* * ----------------------------------------------------------------- * CVodeAdjFree * ----------------------------------------------------------------- * CVodeAdjFree frees the memory allocated by CVodeAdjInit. * It is typically called by CVodeFree. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void CVodeAdjFree(void *cvode_mem); /* * ----------------------------------------------------------------- * Interfaces to CVODES functions for setting-up backward problems. * ----------------------------------------------------------------- * CVodeCreateB, * * CVodeInitB, CVodeInitBS, CVodeReInitB * * CVodeQuadInitB, CVodeQuadInitBS, CVodeQuadReInitB * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeCreateB(void *cvode_mem, int lmmB, int iterB, int *which); SUNDIALS_EXPORT int CVodeInitB(void *cvode_mem, int which, CVRhsFnB fB, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeInitBS(void *cvode_mem, int which, CVRhsFnBS fBs, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeReInitB(void *cvode_mem, int which, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeSStolerancesB(void *cvode_mem, int which, realtype reltolB, realtype abstolB); SUNDIALS_EXPORT int CVodeSVtolerancesB(void *cvode_mem, int which, realtype reltolB, N_Vector abstolB); SUNDIALS_EXPORT int CVodeQuadInitB(void *cvode_mem, int which, CVQuadRhsFnB fQB, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadInitBS(void *cvode_mem, int which, CVQuadRhsFnBS fQBs, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadSStolerancesB(void *cvode_mem, int which, realtype reltolQB, realtype abstolQB); SUNDIALS_EXPORT int CVodeQuadSVtolerancesB(void *cvode_mem, int which, realtype reltolQB, N_Vector abstolQB); /* * ================================================================= * * MAIN SOLVER FUNCTIONS FOR FORWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * CVodeF * ----------------------------------------------------------------- * CVodeF integrates towards tout and returns solution into yout. * In the same time, it stores check point data every 'steps'. * * CVodeF can be called repeatedly by the user. * * ncheckPtr points to the number of check points stored so far. * * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask, int *ncheckPtr); /* * ----------------------------------------------------------------- * CVodeB * ----------------------------------------------------------------- * CVodeB performs the integration of all backward problems specified * through calls to CVodeCreateB through a sequence of forward-backward * runs in between consecutive check points. CVodeB can be called * either in CV_NORMAL or CV_ONE_STEP mode. After a successful return * from CVodeB, the solution and quadrature variables at the current * return time for any given backward problem can be obtained by * calling CVodeGetB and CVodeGetQuadB, respectively. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeB(void *cvode_mem, realtype tBout, int itaskB); /* * ================================================================= * * OPTIONAL INPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * CVodeSetAdjNoSensi * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetAdjNoSensi(void *cvode_mem); /* * ----------------------------------------------------------------- * Optional input functions for backward problems * ----------------------------------------------------------------- * These functions are just wrappers around the corresponding * functions in cvodes.h, with some particularizations for the * backward integration. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeSetIterTypeB(void *cvode_mem, int which, int iterB); SUNDIALS_EXPORT int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB); SUNDIALS_EXPORT int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB); SUNDIALS_EXPORT int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB); SUNDIALS_EXPORT int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB); SUNDIALS_EXPORT int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB); SUNDIALS_EXPORT int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB); SUNDIALS_EXPORT int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB); SUNDIALS_EXPORT int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB); /* * ================================================================= * * EXTRACTION AND DENSE OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * CVodeGetB and CVodeGetQuadB * ----------------------------------------------------------------- * Extraction functions for the solution and quadratures for a given * backward problem. They return their corresponding output vector * at the current time reached by the integration of the backward * problem. To obtain the solution or quadratures associated with * a given backward problem at some other time within the last * integration step (dense output), first obtain a pointer to the * proper CVODES memory by calling CVodeGetAdjCVodeBmem and then use it * to call CVodeGetDky and CVodeGetQuadDky. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetB(void *cvode_mem, int which, realtype *tBret, N_Vector yB); SUNDIALS_EXPORT int CVodeGetQuadB(void *cvode_mem, int which, realtype *tBret, N_Vector qB); /* * ================================================================= * * OPTIONAL OUTPUT FUNCTIONS FOR BACKWARD PROBLEMS * * ================================================================= */ /* * ----------------------------------------------------------------- * CVodeGetAdjCVodeBmem * ----------------------------------------------------------------- * CVodeGetAdjCVodeBmem returns a (void *) pointer to the CVODES * memory allocated for the backward problem. This pointer can * then be used to call any of the CVodeGet* CVODES routines to * extract optional output for the backward integration phase. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which); /* * ----------------------------------------------------------------- * CVodeGetAdjY * Returns the interpolated forward solution at time t. This * function is a wrapper around the interpType-dependent internal * function. * The calling function must allocate space for y. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y); /* * ----------------------------------------------------------------- * CVodeGetAdjCheckPointsInfo * Loads an array of nckpnts structures of type CVadjCheckPointRec. * The user must allocate space for ckpnt (ncheck+1). * ----------------------------------------------------------------- */ typedef struct { void *my_addr; void *next_addr; realtype t0; realtype t1; long int nstep; int order; realtype step; } CVadjCheckPointRec; SUNDIALS_EXPORT int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt); /* * ----------------------------------------------------------------- * CVodeGetAdjDataPointHermite * Returns the 2 vectors stored for cubic Hermite interpolation * at the data point 'which'. The user must allocate space for * y and yd. Returns CV_MEM_NULL if cvode_mem is NULL. * Returns CV_ILL_INPUT if interpType != CV_HERMITE. * CVodeGetAdjDataPointPolynomial * Returns the vector stored for polynomial interpolation * at the data point 'which'. The user must allocate space for * y. Returns CV_MEM_NULL if cvode_mem is NULL. * Returns CV_ILL_INPUT if interpType != CV_POLYNOMIAL. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetAdjDataPointHermite(void *cvode_mem, int which, realtype *t, N_Vector y, N_Vector yd); SUNDIALS_EXPORT int CVodeGetAdjDataPointPolynomial(void *cvode_mem, int which, realtype *t, int *order, N_Vector y); /* * ----------------------------------------------------------------- * CVodeGetAdjCurrentCheckPoint * Returns the address of the 'active' check point. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_spbcgs.h0000600000175000017500000000576511741421150022126 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2007/03/22 18:05:50 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODES scaled preconditioned * Bi-CGSTAB linear solver, CVSPBCG. * * Part I contains function prototypes for using CVSPBCG on forward * problems (IVP integration and/or FSA) * * Part II contains function prototypes for using CVSPBCG on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSSPBCG_H #define _CVSSPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : CVSpbcg * ----------------------------------------------------------------- * A call to the CVSpbcg function links the main CVODE integrator * with the CVSPBCG linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined * in iterative.h. These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPBCG solver. Pass 0 to * use the default value CVSPILS_MAXL=5. * * The return value of CVSpbcg is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvodes_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpbcg(void *cvode_mem, int pretype, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpbcgB(void *cvode_mem, int which, int pretypeB, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_spgmr.h0000600000175000017500000000571511741421150021770 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2007/03/22 18:05:50 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODES scaled preconditioned * GMRES linear solver, CVSPGMR. * * Part I contains function prototypes for using CVSPGMR on forward * problems (IVP integration and/or FSA) * * Part II contains function prototypes for using CVSPGMR on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSSPGMR_H #define _CVSSPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : CVSpgmr * ----------------------------------------------------------------- * A call to the CVSpgmr function links the main CVODE integrator * with the CVSPGMR linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * NONE, LEFT, RIGHT, or BOTH defined in iterative.h. * These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPGMR solver. Pass 0 to * use the default value CVSPILS_MAXL=5. * * The return value of CVSpgmr is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvodes_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpgmr(void *cvode_mem, int pretype, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpgmrB(void *cvode_mem, int which, int pretypeB, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_spils.h0000600000175000017500000004353611741421150021775 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2010/12/01 22:13:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the common header file for the Scaled, Preconditioned * Iterative Linear Solvers in CVODES. * * Part I contains type definitions and functions for using the * iterative linear solvers on forward problems * (IVP integration and/or FSA) * * Part II contains type definitions and functions for using the * iterative linear solvers on adjoint (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSSPILS_H #define _CVSSPILS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * CVSPILS return values * ----------------------------------------------------------------- */ #define CVSPILS_SUCCESS 0 #define CVSPILS_MEM_NULL -1 #define CVSPILS_LMEM_NULL -2 #define CVSPILS_ILL_INPUT -3 #define CVSPILS_MEM_FAIL -4 #define CVSPILS_PMEM_NULL -5 /* Return values for the adjoint module */ #define CVSPILS_NO_ADJ -101 #define CVSPILS_LMEMB_NULL -102 /* * ----------------------------------------------------------------- * CVSPILS solver constants * ----------------------------------------------------------------- * CVSPILS_MAXL : default value for the maximum Krylov * dimension * * CVSPILS_MSBPRE : maximum number of steps between * preconditioner evaluations * * CVSPILS_DGMAX : maximum change in gamma between * preconditioner evaluations * * CVSPILS_EPLIN : default value for factor by which the * tolerance on the nonlinear iteration is * multiplied to get a tolerance on the linear * iteration * ----------------------------------------------------------------- */ #define CVSPILS_MAXL 5 #define CVSPILS_MSBPRE 50 #define CVSPILS_DGMAX RCONST(0.2) #define CVSPILS_EPLIN RCONST(0.05) /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSetupFn * ----------------------------------------------------------------- * The user-supplied preconditioner setup function PrecSetup and * the user-supplied preconditioner solve function PrecSolve * together must define left and right preconditoner matrices * P1 and P2 (either of which may be trivial), such that the * product P1*P2 is an approximation to the Newton matrix * M = I - gamma*J. Here J is the system Jacobian J = df/dy, * and gamma is a scalar proportional to the integration step * size h. The solution of systems P z = r, with P = P1 or P2, * is to be carried out by the PrecSolve function, and PrecSetup * is to do any necessary setup operations. * * The user-supplied preconditioner setup function PrecSetup * is to evaluate and preprocess any Jacobian-related data * needed by the preconditioner solve function PrecSolve. * This might include forming a crude approximate Jacobian, * and performing an LU factorization on the resulting * approximation to M. This function will not be called in * advance of every call to PrecSolve, but instead will be called * only as often as necessary to achieve convergence within the * Newton iteration. If the PrecSolve function needs no * preparation, the PrecSetup function can be NULL. * * For greater efficiency, the PrecSetup function may save * Jacobian-related data and reuse it, rather than generating it * from scratch. In this case, it should use the input flag jok * to decide whether to recompute the data, and set the output * flag *jcurPtr accordingly. * * Each call to the PrecSetup function is preceded by a call to * the RhsFn f with the same (t,y) arguments. Thus the PrecSetup * function can use any auxiliary data that is computed and * saved by the f function and made accessible to PrecSetup. * * A function PrecSetup must have the prototype given below. * Its parameters are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data, if saved from * the previous PrecSetup call, can be reused * (with the current value of gamma). * A Precset call with jok == TRUE can only occur after * a call with jok == FALSE. * * jcurPtr is a pointer to an output integer flag which is * to be set by PrecSetup as follows: * Set *jcurPtr = TRUE if Jacobian data was recomputed. * Set *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * user_data is a pointer to user data - the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for N_Vectors which can be used by * CVSpilsPrecSetupFn as temporary storage or * work space. * * NOTE: If the user's preconditioner needs other quantities, * they are accessible as follows: hcur (the current stepsize) * and ewt (the error weight vector) are accessible through * CVodeGetCurrentStep and CVodeGetErrWeights, respectively). * The unit roundoff is available as UNIT_ROUNDOFF defined in * sundials_types.h. * * Returned value: * The value to be returned by the PrecSetup function is a flag * indicating whether it was successful. This value should be * 0 if successful, * > 0 for a recoverable error (step will be retried), * < 0 for an unrecoverable error (integration is halted). * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSolveFn * ----------------------------------------------------------------- * The user-supplied preconditioner solve function PrecSolve * is to solve a linear system P z = r in which the matrix P is * one of the preconditioner matrices P1 or P2, depending on the * type of preconditioning chosen. * * A function PrecSolve must have the prototype given below. * Its parameters are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector. * * fy is the vector f(t,y). * * r is the right-hand side vector of the linear system. * * z is the output vector computed by PrecSolve. * * gamma is the scalar appearing in the Newton matrix. * * delta is an input tolerance for use by PSolve if it uses * an iterative method in its solution. In that case, * the residual vector Res = r - P z of the system * should be made less than delta in weighted L2 norm, * i.e., sqrt [ Sum (Res[i]*ewt[i])^2 ] < delta. * Note: the error weight vector ewt can be obtained * through a call to the routine CVodeGetErrWeights. * * lr is an input flag indicating whether PrecSolve is to use * the left preconditioner P1 or right preconditioner * P2: lr = 1 means use P1, and lr = 2 means use P2. * * user_data is a pointer to user data - the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp is a pointer to memory allocated for an N_Vector * which can be used by PSolve for work space. * * Returned value: * The value to be returned by the PrecSolve function is a flag * indicating whether it was successful. This value should be * 0 if successful, * positive for a recoverable error (step will be retried), * negative for an unrecoverable error (integration is halted). * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Type : CVSpilsJacTimesVecFn * ----------------------------------------------------------------- * The user-supplied function jtimes is to generate the product * J*v for given v, where J is the Jacobian df/dy, or an * approximation to it, and v is a given vector. It should return * 0 if successful a positive value for a recoverable error or * a negative value for an unrecoverable failure. * * A function jtimes must have the prototype given below. Its * parameters are as follows: * * v is the N_Vector to be multiplied by J. * * Jv is the output N_Vector containing J*v. * * t is the current value of the independent variable. * * y is the current value of the dependent variable * vector. * * fy is the vector f(t,y). * * user_data is a pointer to user data, the same as the user_data * parameter passed to the CVodeSetUserData function. * * tmp is a pointer to memory allocated for an N_Vector * which can be used by Jtimes for work space. * ----------------------------------------------------------------- */ typedef int (*CVSpilsJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); /* * ----------------------------------------------------------------- * Optional inputs to the CVSPILS linear solver * ----------------------------------------------------------------- * * CVSpilsSetPrecType resets the type of preconditioner, pretype, * from the value previously set. * This must be one of PREC_NONE, PREC_LEFT, * PREC_RIGHT, or PREC_BOTH. * * CVSpilsSetGSType specifies the type of Gram-Schmidt * orthogonalization to be used. This must be one of * the two enumeration constants MODIFIED_GS or * CLASSICAL_GS defined in iterative.h. These correspond * to using modified Gram-Schmidt and classical * Gram-Schmidt, respectively. * Default value is MODIFIED_GS. * * CVSpilsSetMaxl resets the maximum Krylov subspace size, maxl, * from the value previously set. * An input value <= 0, gives the default value. * * CVSpilsSetEpsLin specifies the factor by which the tolerance on * the nonlinear iteration is multiplied to get a * tolerance on the linear iteration. * Default value is 0.05. * * CVSpilsSetPreconditioner specifies the PrecSetup and PrecSolve functions. * Default is NULL for both arguments (no preconditioning). * * CVSpilsSetJacTimesVecFn specifies the jtimes function. Default is to use * an internal finite difference approximation routine. * * The return value of CVSpilsSet* is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_LMEM_NULL if the linear solver memory was NULL * CVSPILS_ILL_INPUT if an input has an illegal value * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpilsSetPrecType(void *cvode_mem, int pretype); SUNDIALS_EXPORT int CVSpilsSetGSType(void *cvode_mem, int gstype); SUNDIALS_EXPORT int CVSpilsSetMaxl(void *cvode_mem, int maxl); SUNDIALS_EXPORT int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac); SUNDIALS_EXPORT int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve); SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFn(void *cvode_mem, CVSpilsJacTimesVecFn jtv); /* * ----------------------------------------------------------------- * Optional outputs from the CVSPILS linear solver * ----------------------------------------------------------------- * CVSpilsGetWorkSpace returns the real and integer workspace used * by the SPILS module. * * CVSpilsGetNumPrecEvals returns the number of preconditioner * evaluations, i.e. the number of calls made * to PrecSetup with jok==FALSE. * * CVSpilsGetNumPrecSolves returns the number of calls made to * PrecSolve. * * CVSpilsGetNumLinIters returns the number of linear iterations. * * CVSpilsGetNumConvFails returns the number of linear * convergence failures. * * CVSpilsGetNumJtimesEvals returns the number of calls to jtimes. * * CVSpilsGetNumRhsEvals returns the number of calls to the user * f routine due to finite difference Jacobian * times vector evaluation. * * CVSpilsGetLastFlag returns the last error flag set by any of * the CVSPILS interface functions. * * The return value of CVSpilsGet* is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals); SUNDIALS_EXPORT int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves); SUNDIALS_EXPORT int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters); SUNDIALS_EXPORT int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails); SUNDIALS_EXPORT int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals); SUNDIALS_EXPORT int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVSpilsGetLastFlag(void *cvode_mem, long int *flag); /* * ----------------------------------------------------------------- * The following function returns the name of the constant * associated with a CVSPILS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT char *CVSpilsGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSetupFnB * ----------------------------------------------------------------- * A function PrecSetupB for the adjoint (backward) problem must have * the prototype given below. * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSetupFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ----------------------------------------------------------------- * Type : CVSpilsPrecSolveFnB * ----------------------------------------------------------------- * A function PrecSolveB for the adjoint (backward) problem must * have the prototype given below. * ----------------------------------------------------------------- */ typedef int (*CVSpilsPrecSolveFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *user_dataB, N_Vector tmpB); /* * ----------------------------------------------------------------- * Type : CVSpilsJacTimesVecFnB * ----------------------------------------------------------------- * A function jtimesB for the adjoint (backward) problem must have * the prototype given below. * ----------------------------------------------------------------- */ typedef int (*CVSpilsJacTimesVecFnB)(N_Vector vB, N_Vector JvB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, void *jac_dataB, N_Vector tmpB); /* * ----------------------------------------------------------------- * Functions * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSpilsSetPrecTypeB(void *cvode_mem, int which, int pretypeB); SUNDIALS_EXPORT int CVSpilsSetGSTypeB(void *cvode_mem, int which, int gstypeB); SUNDIALS_EXPORT int CVSpilsSetEpslinB(void *cvode_mem, int which, realtype eplifacB); SUNDIALS_EXPORT int CVSpilsSetMaxlB(void *cvode_mem, int which, int maxlB); SUNDIALS_EXPORT int CVSpilsSetPreconditionerB(void *cvode_mem, int which, CVSpilsPrecSetupFnB psetB, CVSpilsPrecSolveFnB psolveB); SUNDIALS_EXPORT int CVSpilsSetJacTimesVecFnB(void *cvode_mem, int which, CVSpilsJacTimesVecFnB jtvB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/cvodes/cvodes_sptfqmr.h0000600000175000017500000000601511741421150022326 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2007/03/22 18:05:50 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the CVODES scaled preconditioned TFQMR * linear solver, CVSPTFQMR. * * Part I contains function prototypes for using CVSPTFQMR on forward * problems (IVP integration and/or FSA) * * Part II contains function prototypes for using CVSPTFQMR on adjoint * (backward) problems * ----------------------------------------------------------------- */ #ifndef _CVSSPTFQMR_H #define _CVSSPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I - forward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : CVSptfqmr * ----------------------------------------------------------------- * A call to the CVSptfqmr function links the main CVODE integrator * with the CVSPTFQMR linear solver. * * cvode_mem is the pointer to the integrator memory returned by * CVodeCreate. * * pretype is the type of user preconditioning to be done. * This must be one of the four enumeration constants * PREC_NONE, PREC_LEFT, PREC_RIGHT, or PREC_BOTH defined * in iterative.h. These correspond to no preconditioning, * left preconditioning only, right preconditioning * only, and both left and right preconditioning, * respectively. * * maxl is the maximum Krylov dimension. This is an * optional input to the CVSPTFQMR solver. Pass 0 to * use the default value CVSPILS_MAXL=5. * * The return value of CVSptfqmr is one of: * CVSPILS_SUCCESS if successful * CVSPILS_MEM_NULL if the cvode memory was NULL * CVSPILS_MEM_FAIL if there was a memory allocation failure * CVSPILS_ILL_INPUT if a required vector operation is missing * The above constants are defined in cvodes_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSptfqmr(void *cvode_mem, int pretype, int maxl); /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVSptfqmrB(void *cvode_mem, int which, int pretypeB, int maxlB); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/nvector/0000755000175000017500000000000011767174700017337 5ustar sylvestresylvestresundials-2.5.0/include/nvector/nvector_serial.h0000600000175000017500000002350611741421110022503 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the serial implementation of the * NVECTOR module. * * Part I contains declarations specific to the serial * implementation of the supplied NVECTOR module. * * Part II defines accessor macros that allow the user to * efficiently use the type N_Vector without making explicit * references to the underlying data structure. * * Part III contains the prototype for the constructor N_VNew_Serial * as well as implementation-specific prototypes for various useful * vector operations. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Serial(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * ----------------------------------------------------------------- */ #ifndef _NVECTOR_SERIAL_H #define _NVECTOR_SERIAL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * PART I: SERIAL implementation of N_Vector * ----------------------------------------------------------------- */ /* serial implementation of the N_Vector 'content' structure contains the length of the vector, a pointer to an array of 'realtype' components, and a flag indicating ownership of the data */ struct _N_VectorContent_Serial { long int length; booleantype own_data; realtype *data; }; typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; /* * ----------------------------------------------------------------- * PART II: macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, * NV_LENGTH_S, and NV_Ith_S * ----------------------------------------------------------------- * In the descriptions below, the following user declarations * are assumed: * * N_Vector v; * long int i; * * (1) NV_CONTENT_S * * This routines gives access to the contents of the serial * vector N_Vector. * * The assignment v_cont = NV_CONTENT_S(v) sets v_cont to be * a pointer to the serial N_Vector content structure. * * (2) NV_DATA_S NV_OWN_DATA_S and NV_LENGTH_S * * These routines give access to the individual parts of * the content structure of a serial N_Vector. * * The assignment v_data = NV_DATA_S(v) sets v_data to be * a pointer to the first component of v. The assignment * NV_DATA_S(v) = data_V sets the component array of v to * be data_v by storing the pointer data_v. * * The assignment v_len = NV_LENGTH_S(v) sets v_len to be * the length of v. The call NV_LENGTH_S(v) = len_v sets * the length of v to be len_v. * * (3) NV_Ith_S * * In the following description, the components of an * N_Vector are numbered 0..n-1, where n is the length of v. * * The assignment r = NV_Ith_S(v,i) sets r to be the value of * the ith component of v. The assignment NV_Ith_S(v,i) = r * sets the value of the ith component of v to be r. * * Note: When looping over the components of an N_Vector v, it is * more efficient to first obtain the component array via * v_data = NV_DATA_S(v) and then access v_data[i] within the * loop than it is to use NV_Ith_S(v,i) within the loop. * ----------------------------------------------------------------- */ #define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) #define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) #define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) #define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) #define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) /* * ----------------------------------------------------------------- * PART III: functions exported by nvector_serial * * CONSTRUCTORS: * N_VNew_Serial * N_VNewEmpty_Serial * N_VMake_Serial * N_VCloneVectorArray_Serial * N_VCloneVectorArrayEmpty_Serial * DESTRUCTORS: * N_VDestroy_Serial * N_VDestroyVectorArray_Serial * OTHER: * N_VPrint_Serial * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : N_VNew_Serial * ----------------------------------------------------------------- * This function creates and allocates memory for a serial vector. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Serial(long int vec_length); /* * ----------------------------------------------------------------- * Function : N_VNewEmpty_Serial * ----------------------------------------------------------------- * This function creates a new serial N_Vector with an empty (NULL) * data array. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(long int vec_length); /* * ----------------------------------------------------------------- * Function : N_VMake_Serial * ----------------------------------------------------------------- * This function creates and allocates memory for a serial vector * with a user-supplied data array. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VMake_Serial(long int vec_length, realtype *v_data); /* * ----------------------------------------------------------------- * Function : N_VCloneVectorArray_Serial * ----------------------------------------------------------------- * This function creates an array of 'count' SERIAL vectors by * cloning a given vector w. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w); /* * ----------------------------------------------------------------- * Function : N_VCloneVectorArrayEmpty_Serial * ----------------------------------------------------------------- * This function creates an array of 'count' SERIAL vectors each * with an empty (NULL) data array by cloning w. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); /* * ----------------------------------------------------------------- * Function : N_VDestroyVectorArray_Serial * ----------------------------------------------------------------- * This function frees an array of SERIAL vectors created with * N_VCloneVectorArray_Serial or N_VCloneVectorArrayEmpty_Serial. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); /* * ----------------------------------------------------------------- * Function : N_VPrint_Serial * ----------------------------------------------------------------- * This function prints the content of a serial vector to stdout. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); /* * ----------------------------------------------------------------- * serial implementations of various useful vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/nvector/nvector_parallel.h0000600000175000017500000002705511741421110023023 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the main header file for the MPI-enabled implementation * of the NVECTOR module. * * Part I contains declarations specific to the parallel * implementation of the supplied NVECTOR module. * * Part II defines accessor macros that allow the user to efficiently * use the type N_Vector without making explicit references to the * underlying data structure. * * Part III contains the prototype for the constructor * N_VNew_Parallel as well as implementation-specific prototypes * for various useful vector operations. * * Notes: * * - The definition of the generic N_Vector structure can be * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Parallel(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * ----------------------------------------------------------------- */ #ifndef _NVECTOR_PARALLEL_H #define _NVECTOR_PARALLEL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * PART I: PARALLEL implementation of N_Vector * ----------------------------------------------------------------- */ /* define MPI data types */ #if defined(SUNDIALS_SINGLE_PRECISION) #define PVEC_REAL_MPI_TYPE MPI_FLOAT #elif defined(SUNDIALS_DOUBLE_PRECISION) #define PVEC_REAL_MPI_TYPE MPI_DOUBLE #elif defined(SUNDIALS_EXTENDED_PRECISION) #define PVEC_REAL_MPI_TYPE MPI_LONG_DOUBLE #endif #define PVEC_INTEGER_MPI_TYPE MPI_LONG /* parallel implementation of the N_Vector 'content' structure contains the global and local lengths of the vector, a pointer to an array of 'realtype components', the MPI communicator, and a flag indicating ownership of the data */ struct _N_VectorContent_Parallel { long int local_length; /* local vector length */ long int global_length; /* global vector length */ booleantype own_data; /* ownership of data */ realtype *data; /* local data array */ MPI_Comm comm; /* pointer to MPI communicator */ }; typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; /* * ----------------------------------------------------------------- * PART II: macros NV_CONTENT_P, NV_DATA_P, NV_OWN_DATA_P, * NV_LOCLENGTH_P, NV_GLOBLENGTH_P,NV_COMM_P, and NV_Ith_P * ----------------------------------------------------------------- * In the descriptions below, the following user declarations * are assumed: * * N_Vector v; * long int v_len, s_len, i; * * (1) NV_CONTENT_P * * This routines gives access to the contents of the parallel * vector N_Vector. * * The assignment v_cont = NV_CONTENT_P(v) sets v_cont to be * a pointer to the parallel N_Vector content structure. * * (2) NV_DATA_P, NV_OWN_DATA_P, NV_LOCLENGTH_P, NV_GLOBLENGTH_P, * and NV_COMM_P * * These routines give access to the individual parts of * the content structure of a parallel N_Vector. * * The assignment v_data = NV_DATA_P(v) sets v_data to be * a pointer to the first component of the local data for * the vector v. The assignment NV_DATA_P(v) = data_v sets * the component array of v to be data_V by storing the * pointer data_v. * * The assignment v_llen = NV_LOCLENGTH_P(v) sets v_llen to * be the length of the local part of the vector v. The call * NV_LOCLENGTH_P(v) = llen_v sets the local length * of v to be llen_v. * * The assignment v_glen = NV_GLOBLENGTH_P(v) sets v_glen to * be the global length of the vector v. The call * NV_GLOBLENGTH_P(v) = glen_v sets the global length of v to * be glen_v. * * The assignment v_comm = NV_COMM_P(v) sets v_comm to be the * MPI communicator of the vector v. The assignment * NV_COMM_C(v) = comm_v sets the MPI communicator of v to be * comm_v. * * (3) NV_Ith_P * * In the following description, the components of the * local part of an N_Vector are numbered 0..n-1, where n * is the local length of (the local part of) v. * * The assignment r = NV_Ith_P(v,i) sets r to be the value * of the ith component of the local part of the vector v. * The assignment NV_Ith_P(v,i) = r sets the value of the * ith local component of v to be r. * * Note: When looping over the components of an N_Vector v, it is * more efficient to first obtain the component array via * v_data = NV_DATA_P(v) and then access v_data[i] within the * loop than it is to use NV_Ith_P(v,i) within the loop. * ----------------------------------------------------------------- */ #define NV_CONTENT_P(v) ( (N_VectorContent_Parallel)(v->content) ) #define NV_LOCLENGTH_P(v) ( NV_CONTENT_P(v)->local_length ) #define NV_GLOBLENGTH_P(v) ( NV_CONTENT_P(v)->global_length ) #define NV_OWN_DATA_P(v) ( NV_CONTENT_P(v)->own_data ) #define NV_DATA_P(v) ( NV_CONTENT_P(v)->data ) #define NV_COMM_P(v) ( NV_CONTENT_P(v)->comm ) #define NV_Ith_P(v,i) ( NV_DATA_P(v)[i] ) /* * ----------------------------------------------------------------- * PART III: functions exported by nvector_parallel * * CONSTRUCTORS: * N_VNew_Parallel * N_VNewEmpty_Parallel * N_VMake_Parallel * N_VCloneVectorArray_Parallel * N_VCloneVectorArrayEmpty_Parallel * DESTRUCTORS: * N_VDestroy_Parallel * N_VDestroyVectorArray_Parallel * OTHER: * N_VPrint_Parallel * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : N_VNew_Parallel * ----------------------------------------------------------------- * This function creates and allocates memory for a parallel vector. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Parallel(MPI_Comm comm, long int local_length, long int global_length); /* * ----------------------------------------------------------------- * Function : N_VNewEmpty_Parallel * ----------------------------------------------------------------- * This function creates a new parallel N_Vector with an empty * (NULL) data array. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, long int local_length, long int global_length); /* * ----------------------------------------------------------------- * Function : N_VMake_Parallel * ----------------------------------------------------------------- * This function creates and allocates memory for a parallel vector * with a user-supplied data array. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VMake_Parallel(MPI_Comm comm, long int local_length, long int global_length, realtype *v_data); /* * ----------------------------------------------------------------- * Function : N_VCloneVectorArray_Parallel * ----------------------------------------------------------------- * This function creates an array of 'count' PARALLEL vectors by * cloning a given vector w. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w); /* * ----------------------------------------------------------------- * Function : N_VCloneVectorArrayEmpty_Parallel * ----------------------------------------------------------------- * This function creates an array of 'count' PARALLEL vectors each * with an empty (NULL) data array by cloning w. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w); /* * ----------------------------------------------------------------- * Function : N_VDestroyVectorArray_Parallel * ----------------------------------------------------------------- * This function frees an array of N_Vector created with * N_VCloneVectorArray_Parallel or N_VCloneVectorArrayEmpty_Parallel. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); /* * ----------------------------------------------------------------- * Function : N_VPrint_Parallel * ----------------------------------------------------------------- * This function prints the content of a parallel vector to stdout. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void N_VPrint_Parallel(N_Vector v); /* * ----------------------------------------------------------------- * parallel implementations of the vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Parallel(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Parallel(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); SUNDIALS_EXPORT void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Parallel(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Parallel(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Parallel(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Parallel(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/0000755000175000017500000000000011767174700017156 5ustar sylvestresylvestresundials-2.5.0/include/kinsol/kinsol_spgmr.h0000600000175000017500000000641611741421272022024 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the KINSOL Scaled Preconditioned GMRES * linear solver module, KINSPGMR. * ----------------------------------------------------------------- */ #ifndef _KINSPGMR_H #define _KINSPGMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : KINSpgmr * ----------------------------------------------------------------- * KINSpgmr links the main KINSOL solver module with the SPGMR * linear solver module. The routine establishes the inter-module * interface by setting the generic KINSOL pointers linit, lsetup, * lsolve, and lfree to KINSpgmrInit, KINSpgmrSetup, KINSpgmrSolve, * and KINSpgmrFree, respectively. * * kinmem pointer to an internal memory block allocated during a * prior call to KINCreate * * maxl maximum allowable dimension of Krylov subspace (passing * a value of 0 (zero) will cause the default value * KINSPILS_MAXL (predefined constant) to be used) * * ----------------------------------------------------------------- * KINSpgmr Return Values * ----------------------------------------------------------------- * * The possible return values for the KINSpgmr subroutine are the * following: * * KINSPILS_SUCCESS : means the KINSPGMR linear solver module * (implementation of the GMRES method) was * successfully initialized - allocated system * memory and set shared variables to default * values [0] * * KINSPILS_MEM_NULL : means a NULL KINSOL memory block pointer was * given (must call the KINCreate and KINMalloc * memory allocation subroutines prior to * calling KINSpgmr) [-1] * * KINSPILS_MEM_FAIL : means either insufficient system resources * were available to allocate memory for the main * KINSPGMR data structure (type KINSpgmrMemRec), * or the SpgmrMalloc subroutine failed (unable * to allocate enough system memory for vector * storage and/or the main SPGMR data structure * (type SpgmrMemRec)) [-4] * * KINSPILS_ILL_INPUT : means a supplied parameter was invalid * (check error message) [-3] * * The above constants are defined in kinsol_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSpgmr(void *kinmem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_direct.h0000600000175000017500000002355111741421272022145 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common header file for the direct linear solvers in KINSOL. * ----------------------------------------------------------------- */ #ifndef _KINDLS_H #define _KINDLS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * K I N D I R E C T C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * KINDLS return values * ----------------------------------------------------------------- */ #define KINDLS_SUCCESS 0 #define KINDLS_MEM_NULL -1 #define KINDLS_LMEM_NULL -2 #define KINDLS_ILL_INPUT -3 #define KINDLS_MEM_FAIL -4 /* Additional last_flag values */ #define KINDLS_JACFUNC_UNRECVR -5 #define KINDLS_JACFUNC_RECVR -6 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ----------------------------------------------------------------- * Type: KINDlsDenseJacFn * ----------------------------------------------------------------- * * A dense Jacobian approximation function Jac must be of type * KINDlsDenseJacFn. Its parameters are: * * N - problem size. * * u - current iterate (unscaled) [input] * * fu - vector (type N_Vector) containing result of nonlinear * system function evaluated at current iterate: * fu = F(u) [input] * * J - dense matrix (of type DlsMat) that will be loaded * by a KINDlsDenseJacFn with an approximation to the * Jacobian matrix J = (dF_i/dy_j). * * user_data - pointer to user data - the same as the user_data * parameter passed to KINSetFdata. * * tmp1, tmp2 - available scratch vectors (volatile storage) * * A KINDlsDenseJacFn should return 0 if successful, a positive * value if a recoverable error occurred, and a negative value if * an unrecoverable error occurred. * * ----------------------------------------------------------------- * * NOTE: The following are two efficient ways to load a dense Jac: * (1) (with macros - no explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = DENSE_COL(Jac,j); * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * (2) (without macros - explicit data structure references) * for (j=0; j < Neq; j++) { * col_j = (Jac->data)[j]; * for (i=0; i < Neq; i++) { * generate J_ij = the (i,j)th Jacobian element * col_j[i] = J_ij; * } * } * A third way, using the DENSE_ELEM(A,i,j) macro, is much less * efficient in general. It is only appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * ----------------------------------------------------------------- */ typedef int (*KINDlsDenseJacFn)(long int N, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Type: KINDlsBandJacFn * ----------------------------------------------------------------- * * A band Jacobian approximation function Jac must have the * prototype given below. Its parameters are: * * N is the problem size * * mupper is the upper half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mupper parameter * passed by the user to the linear solver initialization function. * * mlower is the lower half-bandwidth of the approximate banded * Jacobian. This parameter is the same as the mlower parameter * passed by the user to the linear solver initialization function. * * u - current iterate (unscaled) [input] * * fu - vector (type N_Vector) containing result of nonlinear * system function evaluated at current iterate: * fu = F(uu) [input] * * J - band matrix (of type DlsMat) that will be loaded by a * KINDlsBandJacFn with an approximation to the Jacobian * matrix Jac = (dF_i/dy_j). * * user_data - pointer to user data - the same as the user_data * parameter passed to KINSetFdata. * * tmp1, tmp2 - available scratch vectors (volatile storage) * * A KINDlsBandJacFn should return 0 if successful, a positive value * if a recoverable error occurred, and a negative value if an * unrecoverable error occurred. * * ----------------------------------------------------------------- * * NOTE. Three efficient ways to load J are: * * (1) (with macros - no explicit data structure references) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (i=j-mupper; i <= j+mlower; i++) { * generate J_ij = the (i,j)th Jacobian element * BAND_COL_ELEM(col_j,i,j) = J_ij; * } * } * * (2) (with BAND_COL macro, but without BAND_COL_ELEM macro) * for (j=0; j < n; j++) { * col_j = BAND_COL(Jac,j); * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * * (3) (without macros - explicit data structure references) * offset = Jac->smu; * for (j=0; j < n; j++) { * col_j = ((Jac->data)[j])+offset; * for (k=-mupper; k <= mlower; k++) { * generate J_ij = the (i,j)th Jacobian element, i=j+k * col_j[k] = J_ij; * } * } * Caution: Jac->smu is generally NOT the same as mupper. * * The BAND_ELEM(A,i,j) macro is appropriate for use in small * problems in which efficiency of access is NOT a major concern. * * ----------------------------------------------------------------- */ typedef int (*KINDlsBandJacFn)(long int N, long int mupper, long int mlower, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2); /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Optional inputs to the KINDLS linear solver * ----------------------------------------------------------------- * * KINDlsSetDenseJacFn specifies the dense Jacobian approximation * routine to be used for a direct dense linear solver. * * KINDlsSetBandJacFn specifies the band Jacobian approximation * routine to be used for a direct band linear solver. * * By default, a difference quotient approximation, supplied with * the solver is used. * * The return value is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the KINSOL memory was NULL * KINDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINDlsSetDenseJacFn(void *kinmem, KINDlsDenseJacFn jac); SUNDIALS_EXPORT int KINDlsSetBandJacFn(void *kinmem, KINDlsBandJacFn jac); /* * ----------------------------------------------------------------- * Optional outputs from a KINDLS linear solver * ----------------------------------------------------------------- * * KINDlsGetWorkSpace returns the real and integer workspace used * by the KINDLS linear solver. * KINDlsGetNumJacEvals returns the number of calls made to the * Jacobian evaluation routine. * KINDlsGetNumFuncEvals returns the number of calls to the user's F * routine due to finite difference Jacobian * evaluation. * KINDlsGetLastFlag returns the last error flag set by any of * the KINDLS interface functions. * KINDlsGetReturnFlagName returns the name of the constant * associated with a KINDLS return flag * * The return value of KINDlsGet* is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the KINSOL memory was NULL * KINDLS_LMEM_NULL if the linear solver memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINDlsGetWorkSpace(void *kinmem, long int *lenrwB, long int *leniwB); SUNDIALS_EXPORT int KINDlsGetNumJacEvals(void *kinmem, long int *njevalsB); SUNDIALS_EXPORT int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevalsB); SUNDIALS_EXPORT int KINDlsGetLastFlag(void *kinmem, long int *flag); SUNDIALS_EXPORT char *KINDlsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_spils.h0000600000175000017500000003224211741421272022022 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer(s): Scott Cohen, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the common header file for the Scaled Preconditioned * Iterative Linear Solvers in KINSOL. * ----------------------------------------------------------------- */ #ifndef _KINSPILS_H #define _KINSPILS_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * KINSPILS return values * ----------------------------------------------------------------- */ #define KINSPILS_SUCCESS 0 #define KINSPILS_MEM_NULL -1 #define KINSPILS_LMEM_NULL -2 #define KINSPILS_ILL_INPUT -3 #define KINSPILS_MEM_FAIL -4 #define KINSPILS_PMEM_NULL -5 /* * ----------------------------------------------------------------- * KINSPILS solver constant * ----------------------------------------------------------------- * KINSPILS_MAXL : default maximum dimension of Krylov subspace * ----------------------------------------------------------------- */ #define KINSPILS_MAXL 10 /* * ----------------------------------------------------------------- * Type : KINSpilsPrecSetupFn * ----------------------------------------------------------------- * The user-supplied preconditioner setup subroutine should * compute the right-preconditioner matrix P (stored in memory * block referenced by P_data pointer) used to form the * scaled preconditioned linear system: * * (Df*J(uu)*(P^-1)*(Du^-1)) * (Du*P*x) = Df*(-F(uu)) * * where Du and Df denote the diagonal scaling matrices whose * diagonal elements are stored in the vectors uscale and * fscale, repsectively. * * The preconditioner setup routine (referenced by iterative linear * solver modules via pset (type KINSpilsPrecSetupFn)) will not be * called prior to every call made to the psolve function, but will * instead be called only as often as necessary to achieve convergence * of the Newton iteration. * * Note: If the psolve routine requires no preparation, then a * preconditioner setup function need not be given. * * uu current iterate (unscaled) [input] * * uscale vector (type N_Vector) containing diagonal elements * of scaling matrix for vector uu [input] * * fval vector (type N_Vector) containing result of nonliear * system function evaluated at current iterate: * fval = F(uu) [input] * * fscale vector (type N_Vector) containing diagonal elements * of scaling matrix for fval [input] * * user_data pointer to user-allocated data memory block * * vtemp1/vtemp2 available scratch vectors (temporary storage) * * If successful, the function should return 0 (zero). If an error * occurs, then the routine should return a non-zero integer value. * ----------------------------------------------------------------- */ typedef int (*KINSpilsPrecSetupFn)(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); /* * ----------------------------------------------------------------- * Type : KINSpilsPrecSolveFn * ----------------------------------------------------------------- * The user-supplied preconditioner solve subroutine (referenced * by iterative linear solver modules via psolve (type * KINSpilsPrecSolveFn)) should solve a (scaled) preconditioned * linear system of the generic form P*z = r, where P denotes the * right-preconditioner matrix computed by the pset routine. * * uu current iterate (unscaled) [input] * * uscale vector (type N_Vector) containing diagonal elements * of scaling matrix for vector uu [input] * * fval vector (type N_Vector) containing result of nonliear * system function evaluated at current iterate: * fval = F(uu) [input] * * fscale vector (type N_Vector) containing diagonal elements * of scaling matrix for fval [input] * * vv vector initially set to the right-hand side vector r, but * which upon return contains a solution of the linear system * P*z = r [input/output] * * user_data pointer to user-allocated data memory block * * vtemp available scratch vector (volatile storage) * * If successful, the function should return 0 (zero). If a * recoverable error occurs, then the subroutine should return * a positive integer value (in this case, KINSOL attempts to * correct by calling the preconditioner setup function if the * preconditioner information is out of date). If an unrecoverable * error occurs, then the preconditioner solve function should return * a negative integer value. * ----------------------------------------------------------------- */ typedef int (*KINSpilsPrecSolveFn)(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector vtemp); /* * ----------------------------------------------------------------- * Type : KINSpilsJacTimesVecFn * ----------------------------------------------------------------- * The (optional) user-supplied matrix-vector product subroutine * (referenced internally via jtimes (type KINSpilsJacTimesVecFn)) * is used to compute Jv = J(uu)*v (system Jacobian applied to a * given vector). If a user-defined routine is not given, then the * private routine is used. * * v unscaled variant of vector to be multiplied by J(uu) [input] * * Jv vector containing result of matrix-vector product J(uu)*v * [output] * * uu current iterate (unscaled) [input] * * new_uu flag (reset by user) indicating if the iterate uu * has been updated in the interim - Jacobian needs * to be updated/reevaluated, if appropriate, unless * new_uu = FALSE [input/output] * * user_data pointer to user data, the same as the user_data * parameter passed to the KINSetUserData function. * * If successful, the function should return 0 (zero). If an error * occurs, then the routine should return a non-zero integer value. * ----------------------------------------------------------------- */ typedef int (*KINSpilsJacTimesVecFn)(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *J_data); /* * ----------------------------------------------------------------- * Optional Input Specification Functions * ----------------------------------------------------------------- * The following functions can be called to set optional inputs: * * Function Name | Optional Input [Default Value] * | * ----------------------------------------------------------------- * | * KINSpilsSetMaxRestarts | maximum number of times the SPGMR * | (scaled preconditioned GMRES) linear * | solver can be restarted * | [0] * | * KINSpilsSetPreconditioner | used to set the following: * | (a) name of user-supplied routine * | used to compute a preconditioner * | matrix for the given linear * | system (pset) * | [NULL] * | (b) name of user-supplied routine * | used to apply preconditioner to * | linear system (psolve) * | [NULL] * | * KINSpilsSetJacTimesVecFn | used to set the following the name * | of user-supplied subroutine used to * | compute the matrix-vector product J(u)*v, * | where J denotes the system Jacobian. * | [KINSpilsDQJtimes] * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSpilsSetMaxRestarts(void *kinmem, int maxrs); SUNDIALS_EXPORT int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn pset, KINSpilsPrecSolveFn psolve); SUNDIALS_EXPORT int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv); /* * ----------------------------------------------------------------- * KINSpilsSet* Return Values * ----------------------------------------------------------------- * The possible return values for the KINSpilsSet* subroutines * are the following: * * KINSPILS_SUCCESS : means the associated parameter was successfully * set [0] * * KINSPILS_ILL_INPUT : means the supplied parameter was invalid * (check error message) [-3] * * KINSPILS_MEM_NULL : means a NULL KINSOL memory block pointer * was given [-1] * * KINSPILS_LMEM_NULL : means system memory has not yet been * allocated for the linear solver * (lmem == NULL) [-2] * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Optional Output Extraction Functions * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistical information related to the KINSPILS linear * solvers: * * Function Name | Returned Value * | * ----------------------------------------------------------------- * | * KINSpilsGetWorkSpace | returns both integer workspace size * | (total number of long int-sized blocks * | of memory allocated for * | vector storage), and real workspace * | size (total number of realtype-sized * | blocks of memory allocated * | for vector storage) * | * KINSpilsGetNumPrecEvals | total number of preconditioner * | evaluations (number of calls made * | to the user-defined pset routine) * | * KINSpilsGetNumPrecSolves | total number of times preconditioner * | was applied to linear system (number * | of calls made to the user-supplied * | psolve function) * | * KINSpilsGetNumLinIters | total number of linear iterations * | performed * | * KINSpilsGetNumConvFails | total number of linear convergence * | failures * | * KINSpilsGetNumJtimesEvals | total number of times the matrix- * | vector product J(u)*v was computed * | (number of calls made to the jtimes * | subroutine) * | * KINSpilsGetNumFuncEvals | total number of evaluations of the * | system function F(u) (number of * | calls made to the user-supplied * | func routine by the linear solver * | module member subroutines) * | * KINSpilsGetLastFlag | returns the last flag returned by * | the linear solver * | * KINSpilsGetReturnFlagName | returns the name of the constant * | associated with a KINSPILS return flag * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwSG, long int *leniwSG); SUNDIALS_EXPORT int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals); SUNDIALS_EXPORT int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves); SUNDIALS_EXPORT int KINSpilsGetNumLinIters(void *kinmem, long int *nliters); SUNDIALS_EXPORT int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails); SUNDIALS_EXPORT int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals); SUNDIALS_EXPORT int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevalsS); SUNDIALS_EXPORT int KINSpilsGetLastFlag(void *kinmem, long int *flag); SUNDIALS_EXPORT char *KINSpilsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_sptfqmr.h0000600000175000017500000000700311741421272022361 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the KINSOL scaled preconditioned * TFQMR linear solver module, KINSPTFQMR. * ----------------------------------------------------------------- */ #ifndef _KINSPTFQMR_H #define _KINSPTFQMR_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : KINSptfqmr * ----------------------------------------------------------------- * KINSptfqmr links the main KINSOL solver module with the SPTFQMR * linear solver module. The routine establishes the inter-module * interface by setting the generic KINSOL pointers linit, lsetup, * lsolve, and lfree to KINSptfqmrInit, KINSptfqmrSetup, KINSptfqmrSolve, * and KINSptfqmrFree, respectively. * * kinmem pointer to an internal memory block allocated during a * prior call to KINCreate * * maxl maximum allowable dimension of Krylov subspace (passing * a value of 0 (zero) will cause the default value * KINSPTFQMR_MAXL (predefined constant) to be used) * * If successful, KINSptfqmr returns KINSPTFQMR_SUCCESS. If an error * occurs, then KINSptfqmr returns an error code (negative integer * value). * * ----------------------------------------------------------------- * KINSptfqmr Return Values * ----------------------------------------------------------------- * The possible return values for the KINSptfqmr subroutine are the * following: * * KINSPTFQMR_SUCCESS : means the KINSPTFQMR linear solver module * (implementation of the TFQMR method) was * successfully initialized - allocated system * memory and set shared variables to default * values [0] * * KINSPTFQMR_MEM_NULL : means a NULL KINSOL memory block pointer * was given (must call the KINCreate and * KINMalloc memory allocation subroutines * prior to calling KINSptfqmr) [-1] * * KINSPTFQMR_MEM_FAIL : means either insufficient system resources * were available to allocate memory for the * main KINSPTFQMR data structure (type * KINSptfqmrMemRec), or the SptfqmrMalloc * subroutine failed (unable to allocate enough * system memory for vector storate and/or the * main SPTFQMR data structure * (type SptfqmrMemRec)) [-4] * * KINSPTFQMR_ILL_INPUT : means either a supplied parameter was invalid, * or the NVECTOR implementation is NOT * compatible [-3] * * The above constants are defined in kinsol_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSptfqmr(void *kinmem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_dense.h0000600000175000017500000000333411741421272021766 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the KINSOL dense linear solver module, * KINDENSE. * ----------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #ifndef _KINDENSE_H #define _KINDENSE_H #include #include /* * ----------------------------------------------------------------- * Function : KINDense * ----------------------------------------------------------------- * A call to the KINDense function links the main solver with the * KINDENSE linear solver. Its arguments are as follows: * * kinmem - pointer to an internal memory block allocated during a * prior call to KINCreate * * N - problem size * * The return value of KINDense is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the kinsol memory was NULL * KINDLS_MEM_FAIL if there was a memory allocation failure * KINDLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINDense(void *kinmem, long int N); #endif #ifdef __cplusplus } #endif sundials-2.5.0/include/kinsol/kinsol_lapack.h0000600000175000017500000000561711741421272022131 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2008/04/18 19:42:38 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the KINSOL dense linear solver KINLAPACK. * ----------------------------------------------------------------- */ #ifndef _KINLAPACK_H #define _KINLAPACK_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * E X P O R T E D F U N C T I O N S * ================================================================= */ /* * ----------------------------------------------------------------- * Function : KINLapackDense * ----------------------------------------------------------------- * A call to the KINLapackDense function links the main solver * with the KINLAPACK linear solver using dense Jacobians. * * kinmem is the pointer to the solver memory returned by KINCreate. * * N is the size of the ODE system. * * The return value of KINLapackDense is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the KINSOL memory was NULL * KINDLS_MEM_FAIL if there was a memory allocation failure * KINDLS_ILL_INPUT if a required vector operation is missing * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINLapackDense(void *kinmem, int N); /* * ----------------------------------------------------------------- * Function : KINLapackBand * ----------------------------------------------------------------- * A call to the KINLapackBand function links the main solver * with the KINLAPACK linear solver using banded Jacobians. * * kinmem is the pointer to the solver memory returned by KINCreate. * * N is the size of the ODE system. * * mupper is the upper bandwidth of the band Jacobian approximation. * * mlower is the lower bandwidth of the band Jacobian approximation. * * The return value of KINLapackBand is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the KINSOL memory was NULL * KINDLS_MEM_FAIL if there was a memory allocation failure * KINDLS_ILL_INPUT if a required vector operation is missing * or if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINLapackBand(void *kinmem, int N, int mupper, int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol.h0000600000175000017500000010407311741421272020612 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * KINSOL solver module header file * ----------------------------------------------------------------- */ #ifndef _KINSOL_H #define _KINSOL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * K I N S O L C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * KINSOL return flags * ----------------------------------------------------------------- */ #define KIN_SUCCESS 0 #define KIN_INITIAL_GUESS_OK 1 #define KIN_STEP_LT_STPTOL 2 #define KIN_WARNING 99 #define KIN_MEM_NULL -1 #define KIN_ILL_INPUT -2 #define KIN_NO_MALLOC -3 #define KIN_MEM_FAIL -4 #define KIN_LINESEARCH_NONCONV -5 #define KIN_MAXITER_REACHED -6 #define KIN_MXNEWT_5X_EXCEEDED -7 #define KIN_LINESEARCH_BCFAIL -8 #define KIN_LINSOLV_NO_RECOVERY -9 #define KIN_LINIT_FAIL -10 #define KIN_LSETUP_FAIL -11 #define KIN_LSOLVE_FAIL -12 #define KIN_SYSFUNC_FAIL -13 #define KIN_FIRST_SYSFUNC_ERR -14 #define KIN_REPTD_SYSFUNC_ERR -15 /* * ----------------------------------------------------------------- * Enumeration for inputs to KINSetEtaForm (eta choice) * ----------------------------------------------------------------- * KIN_ETACONSTANT : use constant value for eta (default value is * 0.1 but a different value can be specified via * a call to KINSetEtaConstValue) * * KIN_ETACHOICE1 : use choice #1 as given in Eisenstat and Walker's * paper of SIAM J.Sci.Comput.,17 (1996), pp 16-32, * wherein eta is defined to be: * * eta(k+1) = ABS(||F(u_k+1)||_L2-||F(u_k)+J(u_k)*p_k||_L2) * --------------------------------------------- * ||F(u_k)||_L2 * * 1+sqrt(5) * eta_safe = eta(k)^ealpha where ealpha = --------- * 2 * * KIN_ETACHOICE2 : use choice #2 as given in Eisenstat and Walker's * paper wherein eta is defined to be: * * [ ||F(u_k+1)||_L2 ]^ealpha * eta(k+1) = egamma * [ --------------- ] * [ ||F(u_k)||_L2 ] * * where egamma = [0,1] and ealpha = (1,2] * * eta_safe = egamma*(eta(k)^ealpha) * * Note: The default values of the scalar * coefficients egamma and ealpha (both required) * are egamma = 0.9 and ealpha = 2.0, but the * routine KINSetEtaParams can be used to specify * different values. * * When using either KIN_ETACHOICE1 or KIN_ETACHOICE2, if * eta_safe > 0.1 then the following safeguard is applied: * * eta(k+1) = MAX {eta(k+1), eta_safe} * * The following safeguards are always applied when using either * KIN_ETACHOICE1 or KIN_ETACHOICE2 so that eta_min <= eta <= eta_max: * * eta(k+1) = MAX {eta(k+1), eta_min} * eta(k+1) = MIN {eta(k+1), eta_max} * * where eta_min = 1.0e-4 and eta_max = 0.9 (see KINForcingTerm). * ----------------------------------------------------------------- */ #define KIN_ETACHOICE1 1 #define KIN_ETACHOICE2 2 #define KIN_ETACONSTANT 3 /* * ----------------------------------------------------------------- * Enumeration for global strategy * ----------------------------------------------------------------- * Choices are KIN_NONE and KIN_LINESEARCH. * ----------------------------------------------------------------- */ #define KIN_NONE 0 #define KIN_LINESEARCH 1 /* * ================================================================= * F U N C T I O N T Y P E S * ================================================================= */ /* * ----------------------------------------------------------------- * Type : KINSysFn * ----------------------------------------------------------------- * The user-supplied subroutine implementing the nonlinear system * function (vector-valued function) F must take as input the * dependent variable vector uu (type N_Vector), and set fval (type * N_Vector) equal to F(uu) before returning. Additional workspace * is allocated by the user and referenced by the user_data memory * pointer. * * Note: The user-defined routine (internally referenced by a * a pointer (type KINSysFn) named func) should have an 'int' return * value type. However, the return value is currently ignored. * ----------------------------------------------------------------- */ typedef int (*KINSysFn)(N_Vector uu, N_Vector fval, void *user_data ); /* * ----------------------------------------------------------------- * Type : KINErrHandlerFn * ----------------------------------------------------------------- * A function eh, which handles error messages, must have type * KINErrHandlerFn. * The function eh takes as input the error code, the name of the * module reporting the error, the error message, and a pointer to * user data, the same as that passed to KINSetUserData. * * All error codes are negative, except KIN_WARNING which indicates * a warning (the solver continues). * * A KINErrHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*KINErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); /* * ----------------------------------------------------------------- * Type : KINInfoHandlerFn * ----------------------------------------------------------------- * A function ih, which handles info messages, must have type * KINInfoHandlerFn. * The function ih takes as input the name of the module and of the * function reporting the info message and a pointer to * user data, the same as that passed to KINSetfdata. * * A KINInfoHandlerFn has no return value. * ----------------------------------------------------------------- */ typedef void (*KINInfoHandlerFn)(const char *module, const char *function, char *msg, void *user_data); /* * ================================================================ * U S E R - C A L L A B L E R O U T I N E S * ================================================================ */ /* * ----------------------------------------------------------------- * Function : KINCreate * ----------------------------------------------------------------- * KINCreate allocates and initializes an internal memory block for * the KINSOL solver module. * * If successful, KINCreate returns a pointer to the initialized * memory block which should be passed to KINInit. If an * error occurs, then KINCreate returns a NULL pointer. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void *KINCreate(void); /* * ----------------------------------------------------------------- * Optional Input Specification Functions (KINSOL) * ----------------------------------------------------------------- * The following functions can be called to set optional inputs: * * Function Name | Optional Input [Default Value] * | * ----------------------------------------------------------------- * | * KINSetErrHandlerFn | user-provided ErrHandler function. * | [internal] * | * KINSetErrFile | pointer (type FILE) indicating where all * | warning/error messages should be sent * | if the default internal error handler * | is used * | [stderr] * | * KINSetPrintLevel | level of verbosity of output: * | * | 0 no statistical information is * | displayed (default level) * | * | 1 for each nonlinear iteration display * | the following information: the scaled * | norm (L2) of the system function * | evaluated at the current iterate, the * | scaled norm of the Newton step (only if * | using KIN_NONE), and the * | number of function evaluations performed * | thus far * | * | 2 display level 1 output and the * | following values for each iteration: * | * | fnorm (L2) = ||fscale*func(u)||_L2 * | (only for KIN_NONE) * | * | scaled fnorm (for stopping) = * | ||fscale*ABS(func(u))||_L-infinity * | (for KIN_NONE and * | KIN_LINESEARCH) * | * | 3 display level 2 output plus additional * | values used by the global strategy * | (only if using KIN_LINESEARCH), and * | statistical information for the linear * | solver * | [0] * | * KINSetInfoHandlerFn | user-provided InfoHandler function. * | [internal] * | * KINSetInfoFile | pointer (type FILE) specifying where * | informative (non-error) messages should * | be sent if the default internal info * | handler is used * | [stdout] * | * KINSetUserData | pointer to user-allocated memory that is * | passed to the user-supplied subroutine * | implementing the nonlinear system function * | F(u) * | [NULL] * | * KINSetNumMaxIters | maximum number of nonlinear iterations * | [MXITER_DEFAULT] (defined in kinsol_impl.h) * | * KINSetNoInitSetup | flag controlling whether or not the * | KINSol routine makes an initial call * | to the linear solver setup routine (lsetup) * | (possible values are TRUE and FALSE) * | [FALSE] * | * KINSetNoResMon | flag controlling whether or not the nonlinear * | residual monitoring scheme is used to control * | Jacobian updating (possible values are TRUE * | and FALSE) * | [FALSE if using direct linear solver] * | [TRUE if using inexact linear solver] * | * KINSetMaxSetupCalls | mbset, number of nonlinear iteraions, such * | that a call to the linear solver setup routine * | (lsetup) is forced every mbset iterations. * | If mbset=1, lsetup s called at every iteration. * | [MSBSET_DEFAULT] (defined in kinsol_impl.h) * | * KINSetMaxSubSetupCalls | mbsetsub is the number of nonlinear iterations * | between checks by the nonlinear residual * | monitoring algorithm (specifies length of * | subinterval) * | NOTE: mbset should be a multiple of mbsetsub * | [MSBSET_SUB_DEFAULT] (defined in kinsol_impl.h) * | * KINSetEtaForm | flag indicating which method to use to * | compute the value of the eta coefficient * | used in the calculation of the linear * | solver convergence tolerance: * | * | eps = (eta+uround)*||fscale*func(u)||_L2 * | * | the linear solver tests for convergence by * | checking if the following inequality has * | been satisfied: * | * | ||fscale*(func(u)+J(u)*p)||_L2 <= eps * | * | where J(u) is the system Jacobian * | evaluated at the current iterate, and p * | denotes the Newton step * | * | choices for computing eta are as follows: * | * | KIN_ETACHOICE1 (refer to KINForcingTerm) * | * | eta = ABS(||F(u_k+1)||_L2-||F(u_k)+J(u_k)*p_k||_L2) * | --------------------------------------------- * | ||F(u_k)||_L2 * | * | KIN_ETACHOICE2 (refer to KINForcingTerm) * | * | [ ||F(u_k+1)||_L2 ]^alpha * | eta = gamma * [ --------------- ] * | [ ||F(u_k)||_L2 ] * | * | where gamma = [0,1] and alpha = (1,2] * | * | KIN_ETACONSTANT use a constant value for eta * | [KIN_ETACHOICE1] * | * KINSetEtaConstValue | constant value of eta - use with * | KIN_ETACONSTANT option * | [0.1] * | * KINSetEtaParams | values of eta_gamma (egamma) and eta_alpha * | (ealpha) coefficients - use with KIN_ETACHOICE2 * | option * | [0.9 and 2.0] * | * KINSetResMonParams | values of omega_min and omega_max scalars * | used by nonlinear residual monitoring * | algorithm (see KINStop) * | [0.00001 and 0.9] * | * KINSetResMonConstValue | constant value used by residual monitoring * | algorithm. If omega=0, then it is estimated * | using omega_min and omega_max. * | [0.0] * | * KINSetNoMinEps | flag controlling whether or not the value * | of eps is bounded below by 0.01*fnormtol * | (see KINSetFuncNormTol) * | * | FALSE constrain value of eps by setting * | to the following: * | * | eps = MAX{0.01*fnormtol, eps} * | * | TRUE do not constrain value of eps * | [FALSE] * | * KINSetMaxNewtonStep | maximum scaled length of Newton step * | (reset to value of one if user-supplied * | value is less than one) * | [1000*||uscale*u_0||_L2] * | * KINSetMaxBetaFails | maximum number of beta condition failures * | in the line search algorithm. * | [MXNBCF_DEFAULT] (defined in kinsol_impl.h) * | * KINSetRelErrFunc | real scalar equal to realative error in * | computing F(u) (used in difference- * | quotient approximation of matrix-vector * | product J(u)*v) * | [(uround)^1/2] * | * KINSetFuncNormTol | real scalar used as stopping tolerance on * | ||fscale*ABS(func(u))||_L-infinity (see * | KINStop and KINInitialStop) * | [(uround)^1/3] * | * KINSetScaledStepTol | real scalar used as stopping tolerance on * | the maximum scaled step length: * | * | || u_k+1 - u_k || * | || ----------------- ||_L-infinity * | || ABS(u_k+1)+uscale || * | * | (see KINStop) * | [(uround)^2/3] * | * KINSetConstraints | pointer to an array (type N_Vector) of * | constraints on the solution vector u * | * | if constraints[i] = * | * | 0 u[i] not constrained * | * | +1 u[i] constrained to be >= 0 * | -1 u[i] constrained to be <= 0 * | * | +2 u[i] constrained to be > 0 * | -2 u[i] constrained to be < 0 * | * | if a NULL pointer is given, then no * | constraints are applied to vector u * | [NULL] * | * KINSetSysFunc | set the user-provided routine which * | defines the nonlinear problem to be * | solved * | [none] * ----------------------------------------------------------------- * The possible return values for the KINSet* subroutines are the * following: * * KIN_SUCCESS : means the associated variable was successfully * set [0] * * KIN_MEM_NULL : means a NULL KINSOL memory block pointer was given * (must call the KINCreate and KINInit memory * allocation subroutines prior to calling KINSol) [-1] * * KIN_ILL_INPUT : means the supplied parameter was invalid (check * error message) [-2] * ----------------------------------------------------------------- * Note: If successful, these functions return KIN_SUCCESS. If an * argument has an illegal value, then an error message is printed * to the file specified by errfp and an error code is returned. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int KINSetErrFile(void *kinmem, FILE *errfp); SUNDIALS_EXPORT int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data); SUNDIALS_EXPORT int KINSetInfoFile(void *kinmem, FILE *infofp); SUNDIALS_EXPORT int KINSetUserData(void *kinmem, void *user_data); SUNDIALS_EXPORT int KINSetPrintLevel(void *kinmemm, int printfl); SUNDIALS_EXPORT int KINSetNumMaxIters(void *kinmem, long int mxiter); SUNDIALS_EXPORT int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup); SUNDIALS_EXPORT int KINSetNoResMon(void *kinmem, booleantype noNNIResMon); SUNDIALS_EXPORT int KINSetMaxSetupCalls(void *kinmem, long int msbset); SUNDIALS_EXPORT int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub); SUNDIALS_EXPORT int KINSetEtaForm(void *kinmem, int etachoice); SUNDIALS_EXPORT int KINSetEtaConstValue(void *kinmem, realtype eta); SUNDIALS_EXPORT int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha); SUNDIALS_EXPORT int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax); SUNDIALS_EXPORT int KINSetResMonConstValue(void *kinmem, realtype omegaconst); SUNDIALS_EXPORT int KINSetNoMinEps(void *kinmem, booleantype noMinEps); SUNDIALS_EXPORT int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep); SUNDIALS_EXPORT int KINSetMaxBetaFails(void *kinmem, long int mxnbcf); SUNDIALS_EXPORT int KINSetRelErrFunc(void *kinmem, realtype relfunc); SUNDIALS_EXPORT int KINSetFuncNormTol(void *kinmem, realtype fnormtol); SUNDIALS_EXPORT int KINSetScaledStepTol(void *kinmem, realtype scsteptol); SUNDIALS_EXPORT int KINSetConstraints(void *kinmem, N_Vector constraints); SUNDIALS_EXPORT int KINSetSysFunc(void *kinmem, KINSysFn func); /* * ----------------------------------------------------------------- * Function : KINInit * ----------------------------------------------------------------- * KINInit allocates additional memory for vector storage and * sets a couple problem-specific KINSOL variables. * * Note: Additional vectors must be initialized by the user and * passed to the KINSol routine. * * kinmem pointer to an internal memory block allocated during a * prior call to KINCreate * * func name of user-supplied subroutine implementing the * nonlinear function F(u) * * tmpl implementation-specific template vector (type N_Vector) * (created using either N_VNew_Serial or N_VNew_Parallel) * * KINInit return flags: KIN_SUCCESS, KIN_MEM_NULL, KIN_ILL_INPUT, * and KIN_MEM_FAIL (see below). If an error occurs, then KINInit * prints an error message. * * ----------------------------------------------------------------- * The possible return values for the KINInit subroutine are the * following: * * KIN_SUCCESS : means the necessary system memory was successfully * allocated [0] * * KIN_MEM_NULL : means a NULL KINSOL memory block pointer was given * (must call the KINCreate routine before calling * KINInit) [-1] * * KIN_ILL_INPUT : means the name of a user-supplied subroutine * implementing the nonlinear system function F(u) * was not given [-2] * * KIN_MEM_FAIL : means an error occurred during memory allocation * (either insufficient system resources are available * or the vector kernel has not yet been initialized) * [-4] * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl); /* * ----------------------------------------------------------------- * Function : KINSol * ----------------------------------------------------------------- * KINSol (main KINSOL driver routine) manages the computational * process of computing an approximate solution of the nonlinear * system. If the initial guess (initial value assigned to vector u) * doesn't violate any user-defined constraints, then the subroutine * attempts to solve the system F(u) = 0 using a nonlinear Krylov * subspace projection method. The Newton-Krylov iterations are * stopped if either of the following conditions is satisfied: * * ||F(u)||_L-infinity <= 0.01*fnormtol * * ||u[i+1] - u[i]||_L-infinity <= scsteptol * * However, if the current iterate satisfies the second stopping * criterion, it doesn't necessarily mean an approximate solution * has been found since the algorithm may have stalled, or the * user-specified step tolerance (scsteptol) may be too large. * * kinmem pointer to an internal memory block allocated during a * prior call to KINCreate * * uu vector set to initial guess by user before calling KINSol, * but which upon return contains an approximate solution of * the nonlinear system F(u) = 0 * * strategy global strategy applied to Newton step if unsatisfactory * (KIN_NONE or KIN_LINESEARCH) * * u_scale vector containing diagonal elements of scaling matrix * for vector u chosen so that the components of * u_scale*u (as a matrix multiplication) all have * about the same magnitude when u is close to a root * of F(u) * * f_scale vector containing diagonal elements of scaling matrix * for F(u) chosen so that the components of * f_scale*F(u) (as a matrix multiplication) all have * roughly the same magnitude when u is not too near a * root of F(u) * * Note: The components of vectors u_scale and f_scale should be * positive. * * If successful, KINSol returns a vector uu contains an approximate * solution of the given nonlinear system. If an error occurs, then * an error message is printed and an error code is returned. * * ----------------------------------------------------------------- * KINSol Return Values * ----------------------------------------------------------------- * * The possible return values for the KINSol subroutine are the * following: * * KIN_SUCCESS : means ||fscale*ABS(func(u))||_L-infinity <= 0.01*fnormtol * and the current iterate uu is probably an approximate * solution of the nonlinear system F(u) = 0 [0] * * KIN_INITIAL_GUESS_OK : means the initial user-supplied guess * already satisfies the stopping criterion * given above [1] * * KIN_STEP_LT_STPTOL : means the following inequality has been * satisfied (stopping tolerance on scaled * step length): * * || u_k+1 - u_k || * || ----------------- ||_L-infinity <= scsteptol * || ABS(u_k+1)+uscale || * * so the current iterate (denoted above by u_k+1) * may be an approximate solution of the given * nonlinear system, but it is also quite possible * that the algorithm is "stalled" (making * insufficient progress) near an invalid solution, * or the real scalar scsteptol is too large [2] * * KIN_LINESEARCH_NONCONV : means the line search algorithm was unable * to find an iterate sufficiently distinct * from the current iterate * * failure to satisfy the sufficient decrease * condition could mean the current iterate is * "close" to an approximate solution of the given * nonlinear system, the finite-difference * approximation of the matrix-vector product * J(u)*v is inaccurate, or the real scalar * scsteptol is too large [-5] * * KIN_MAXITER_REACHED : means the maximum number of nonlinear iterations * has been reached [-6] * * KIN_MXNEWT_5X_EXCEEDED : means five consecutive steps have been taken * that satisfy the following inequality: * * ||uscale*p||_L2 > 0.99*mxnewtstep * * where p denotes the current step and * mxnewtstep is a real scalar upper bound * on the scaled step length * * such a failure may mean ||fscale*func(u)||_L2 * asymptotes from above to a finite value, or * the real scalar mxnewtstep is too small [-7] * * KIN_LINESEARCH_BCFAIL : means the line search algorithm (implemented * in KINLineSearch) was unable to satisfy the * beta-condition for MXNBCF + 1 nonlinear * iterations (not necessarily consecutive), * which may indicate the algorithm is making * poor progress [-8] * * KIN_LINSOLV_NO_RECOVERY : means the user-supplied routine psolve * encountered a recoverable error, but * the preconditioner is already current [-9] * * KIN_LINIT_FAIL : means the linear solver initialization routine (linit) * encountered an error [-10] * * KIN_LSETUP_FAIL : means the user-supplied routine pset (used to compute * the preconditioner) encountered an unrecoverable * error [-11] * * KIN_LSOLVE_FAIL : means either the user-supplied routine psolve (used to * to solve the preconditioned linear system) encountered * an unrecoverable error, or the linear solver routine * (lsolve) encountered an error condition [-12] * * KIN_MEM_NULL : means a NULL KINSOL memory block pointer was given * (must call the KINCreate and KINInit memory * allocation subroutines prior to calling KINSol) [-1] * * KIN_NO_MALLOC : means additional system memory has not yet been * allocated for vector storage (forgot to call the * KINInit routine) [-3] * * KIN_ILL_INPUT : means at least one input parameter was invalid * (check error output) [-2] * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSol(void *kinmem, N_Vector uu, int strategy, N_Vector u_scale, N_Vector f_scale); /* * ----------------------------------------------------------------- * Optional Output Extraction Functions (KINSOL) * ----------------------------------------------------------------- * The following functions can be called to get optional outputs * and statistical information related to the KINSOL solver: * * Function Name | Returned Value * | * ----------------------------------------------------------------- * | * KINGetWorkSpace | returns both integer workspace size * | (total number of long int-sized blocks * | of memory allocated by KINSOL for * | vector storage) and real workspace * | size (total number of realtype-sized * | blocks of memory allocated by KINSOL * | for vector storage) * | * KINGetNumFuncEvals | total number evaluations of the * | nonlinear system function F(u) * | (number of direct calls made to the * | user-supplied subroutine by KINSOL * | module member functions) * | * KINGetNumNonlinSolvIters | total number of nonlinear iterations * | performed * | * KINGetNumBetaCondFails | total number of beta-condition * | failures (see KINLineSearch) * | * | KINSOL halts if the number of such * | failures exceeds the value of the * | constant MXNBCF (defined in kinsol.c) * | * KINGetNumBacktrackOps | total number of backtrack operations * | (step length adjustments) performed * | by the line search algorithm (see * | KINLineSearch) * | * KINGetFuncNorm | scaled norm of the nonlinear system * | function F(u) evaluated at the * | current iterate: * | * | ||fscale*func(u)||_L2 * | * KINGetStepLength | scaled norm (or length) of the step * | used during the previous iteration: * | * | ||uscale*p||_L2 * | * KINGetReturnFlagName | returns the name of the constant * | associated with a KINSOL return flag * | * ----------------------------------------------------------------- * * The possible return values for the KINSet* subroutines are the * following: * * KIN_SUCCESS : means the information was successfully retrieved [0] * * KIN_MEM_NULL : means a NULL KINSOL memory block pointer was given * (must call the KINCreate and KINInit memory * allocation subroutines prior to calling KINSol) [-1] * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters); SUNDIALS_EXPORT int KINGetNumFuncEvals(void *kinmem, long int *nfevals); SUNDIALS_EXPORT int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails); SUNDIALS_EXPORT int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr); SUNDIALS_EXPORT int KINGetFuncNorm(void *kinmem, realtype *fnorm); SUNDIALS_EXPORT int KINGetStepLength(void *kinmem, realtype *steplength); SUNDIALS_EXPORT char *KINGetReturnFlagName(long int flag); /* * ----------------------------------------------------------------- * Function : KINFree * ----------------------------------------------------------------- * KINFree frees system memory resources reserved for the KINSOL * solver module. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINInit * ----------------------------------------------------------------- */ SUNDIALS_EXPORT void KINFree(void **kinmem); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_spbcgs.h0000600000175000017500000000663311741421272022156 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2006/11/29 00:05:07 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the public header file for the KINSOL scaled preconditioned * Bi-CGSTAB linear solver module, KINSPBCG. * ----------------------------------------------------------------- */ #ifndef _KINSPBCG_H #define _KINSPBCG_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : KINSpbcg * ----------------------------------------------------------------- * KINSpbcg links the main KINSOL solver module with the SPBCG * linear solver module. The routine establishes the inter-module * interface by setting the generic KINSOL pointers linit, lsetup, * lsolve, and lfree to KINSpbcgInit, KINSpbcgSetup, KINSpbcgSolve, * and KINSpbcgFree, respectively. * * kinmem pointer to an internal memory block allocated during a * prior call to KINCreate * * maxl maximum allowable dimension of Krylov subspace (passing * a value of 0 (zero) will cause the default value * KINSPILS_MAXL (predefined constant) to be used) * * If successful, KINSpbcg returns KINSPILS_SUCCESS. If an error * occurs, then KINSpbcg returns an error code (negative integer * value). * * ----------------------------------------------------------------- * KINSpbcg Return Values * ----------------------------------------------------------------- * The possible return values for the KINSpbcg subroutine are the * following: * * KINSPILS_SUCCESS : means the KINSPBCG linear solver module * (implementation of the Bi-CGSTAB method) was * successfully initialized - allocated system * memory and set shared variables to default * values [0] * * KINSPILS_MEM_NULL : means a NULL KINSOL memory block pointer * was given (must call the KINCreate and * KINMalloc memory allocation subroutines * prior to calling KINSpbcg) [-1] * * KINSPILS_MEM_FAIL : means either insufficient system resources * were available to allocate memory for the * main KINSPBCG data structure (type * KINSpbcgMemRec), or the SpbcgMalloc subroutine * failed (unable to allocate enough system * memory for vector storate and/or the main * SPBCG data structure (type SpbcgMemRec)) [-4] * * KINSPILS_ILL_INPUT : means either a supplied parameter was invalid, * or the NVECTOR implementation is NOT * compatible [-3] * * The above constants are defined in kinsol_spils.h * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINSpbcg(void *kinmem, int maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_bbdpre.h0000600000175000017500000002166711741421272022137 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer(s): Alan Hindmarsh, Radu Serban, and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the KINBBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with KINSol, KINSp*, * and the parallel implementaion of the NVECTOR module. * * Summary: * * These routines provide a preconditioner matrix for KINSol that * is block-diagonal with banded blocks. The blocking corresponds * to the distribution of the dependent variable vector u amongst * the processes. Each preconditioner block is generated from * the Jacobian of the local part (associated with the current * process) of a given function g(u) approximating f(u). The blocks * are generated by each process via a difference quotient scheme, * utilizing the assumed banded structure with given half-bandwidths, * mudq and mldq. However, the banded Jacobian block kept by the * scheme has half-bandwidths mukeep and mlkeep, which may be smaller. * * The user's calling program should have the following form: * * #include * #include * #include * #include * #include * #include * ... * MPI_Init(&argc,&argv); * ... * tmpl = N_VNew_Parallel(...); * ... * kin_mem = KINCreate(); * flag = KINInit(kin_mem,...,tmpl); * ... * flag = KINSptfqmr(kin_mem,...); * -or- * flag = KINSpbcg(kin_mem,...); * -or- * flag = KINSpgmr(kin_mem,...); * ... * flag = KINBBDPrecInit(kin_mem,...); * ... * KINSol(kin_mem,...); * ... * KINFree(&kin_mem); * ... * N_VDestroy_Parallel(tmpl); * ... * MPI_Finalize(); * * The user-supplied routines required are: * * func the function f(u) defining the system to be solved: * f(u) = 0 * * glocal the function defining the approximation g(u) to f(u) * * gcomm the function to do necessary communication for glocal * * Notes: * * 1) This header file (kinsol_bbdpre.h) is included by the user for * the definition of the KBBDData data type and for needed * function prototypes. * * 2) The KINBBDPrecInit call includes half-bandwiths mudq and mldq * to be used in the difference quotient calculation of the * approximate Jacobian. They need not be the true half-bandwidths * of the Jacobian of the local block of g, when smaller values may * provide greater efficiency. Also, the half-bandwidths mukeep and * mlkeep of the retained banded approximate Jacobian block may be * even smaller, to furhter reduce storage and computational costs. * For all four half-bandwidths, the values need not be the same * for every process. * * 3) The actual name of the user's f function is passed to * KINInit, and the names of the user's glocal and gcomm * functions are passed to KINBBDPrecInit. * * 4) Optional outputs specific to this module are available by * way of the functions listed below. These include work space * sizes and the cumulative number of glocal calls. * ----------------------------------------------------------------- */ #ifndef _KINBBDPRE_H #define _KINBBDPRE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* KINBBDPRE return values */ #define KINBBDPRE_SUCCESS 0 #define KINBBDPRE_PDATA_NULL -11 #define KINBBDPRE_FUNC_UNRECVR -12 /* * ----------------------------------------------------------------- * Type : KINCommFn * ----------------------------------------------------------------- * The user must supply a function of type KINCommFn which * performs all inter-process communication necessary to * evaluate the approximate system function described above. * * This function takes as input the local vector size Nlocal, * the solution vector u, and a pointer to the user-defined * data block user_data. * * The KINCommFn gcomm is expected to save communicated data in * space defined with the structure *user_data. * * Each call to the KINCommFn is preceded by a call to the system * function func at the current iterate uu. Thus functions of the * type KINCommFn can omit any communications done by f (func) if * relevant to the evaluation of the KINLocalFn function. If all * necessary communication was done in func, the user can pass * NULL for gcomm in the call to KINBBDPrecInit (see below). * * A KINCommFn function should return 0 if successful or * a non-zero value if an error occured. * ----------------------------------------------------------------- */ typedef int (*KINCommFn)(long int Nlocal, N_Vector u, void *user_data); /* * ----------------------------------------------------------------- * Type : KINLocalFn * ----------------------------------------------------------------- * The user must supply a function g(u) which approximates the * function f for the system f(u) = 0, and which is computed * locally (without inter-process communication). Note: The case * where g is mathematically identical to f is allowed. * * The implementation of this function must have type KINLocalFn * and take as input the local vector size Nlocal, the local * solution vector uu, the returned local g values vector, and a * pointer to the user-defined data block user_data. It is to * compute the local part of g(u) and store the result in the * vector gval. (Note: Memory for uu and gval is handled within the * preconditioner module.) It is expected that this routine will * save communicated data in work space defined by the user and * made available to the preconditioner function for the problem. * * A KINLocalFn function should return 0 if successful or * a non-zero value if an error occured. * ----------------------------------------------------------------- */ typedef int (*KINLocalFn)(long int Nlocal, N_Vector uu, N_Vector gval, void *user_data); /* * ----------------------------------------------------------------- * Function : KINBBDPrecInit * ----------------------------------------------------------------- * KINBBDPrecInit allocates and initializes the BBD preconditioner. * * The parameters of KINBBDPrecInit are as follows: * * kinmem is a pointer to the KINSol memory block. * * Nlocal is the length of the local block of the vectors * on the current process. * * mudq, mldq are the upper and lower half-bandwidths to be used * in the computation of the local Jacobian blocks. * * mukeep, mlkeep are the upper and lower half-bandwidths of the * retained banded approximation to the local * Jacobian block. * * dq_rel_uu is the relative error to be used in the difference * quotient Jacobian calculation in the preconditioner. * The default is sqrt(unit roundoff), obtained by * passing 0. * * gloc is the name of the user-supplied function g(u) that * approximates f and whose local Jacobian blocks are * to form the preconditioner. * * gcomm is the name of the user-defined function that performs * necessary inter-process communication for the * execution of gloc. * * The return value of KINBBDPrecInit is one of: * KINSPILS_SUCCESS if no errors occurred * KINSPILS_MEM_NULL if the integrator memory is NULL * KINSPILS_LMEM_NULL if the linear solver memory is NULL * KINSPILS_ILL_INPUT if an input has an illegal value * KINSPILS_MEM_FAIL if a memory allocation request failed * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINBBDPrecInit(void *kinmem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_uu, KINLocalFn gloc, KINCommFn gcomm); /* * ----------------------------------------------------------------- * Function : KINBBDPrecGet* * * The return value of KINBBDPrecGet* is one of: * KINBBDPRE_SUCCESS if successful * KINBBDPRE_PDATA_NULL if the p_data memory was NULL * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINBBDPrecGetWorkSpace(void *kinmem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int KINBBDPrecGetNumGfnEvals(void *kinmem, long int *ngevalsBBDP); #ifdef __cplusplus } #endif #endif sundials-2.5.0/include/kinsol/kinsol_band.h0000600000175000017500000000356211741421272021577 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:16:17 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the KINSOL band linear solver, KINBAND. * ----------------------------------------------------------------- */ #ifndef _KINBAND_H #define _KINBAND_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Function : KINBand * ----------------------------------------------------------------- * A call to the KINBand function links the main solver with the * KINBAND linear solver. Its arguments are as follows: * * kinmem - pointer to the integrator memory returned by KINCreate. * * N - problem size * * mupper - upper bandwidth of the band Jacobian * * mlower - lower bandwidth of the band Jacobian * * The return value of KINBand is one of: * KINDLS_SUCCESS if successful * KINDLS_MEM_NULL if the kinsol memory was NULL * KINDLS_MEM_FAIL if there was a memory allocation failure * KINDLS_ILL_INPUT if a required vector operation is missing * or if a bandwidth has an illegal value. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int KINBand(void *kinmem, long int N, long int mupper, long int mlower); #ifdef __cplusplus } #endif #endif sundials-2.5.0/doc/0000755000175000017500000000000011767174700015001 5ustar sylvestresylvestresundials-2.5.0/doc/cvode/0000755000175000017500000000000011767174700016101 5ustar sylvestresylvestresundials-2.5.0/doc/idas/0000755000175000017500000000000011767174700015721 5ustar sylvestresylvestresundials-2.5.0/doc/ida/0000755000175000017500000000000011767174700015536 5ustar sylvestresylvestresundials-2.5.0/doc/sundialsTB/0000755000175000017500000000000011767174700017051 5ustar sylvestresylvestresundials-2.5.0/doc/cvodes/0000755000175000017500000000000011767174700016264 5ustar sylvestresylvestresundials-2.5.0/doc/kinsol/0000755000175000017500000000000011767174700016300 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/0000755000175000017500000000000011767174700016304 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/0000755000175000017500000000000011767174700017224 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/IDAReInitB.m0000600000175000017500000000224111741421121021163 0ustar sylvestresylvestrefunction status = IDAReInitB(idxB,tB0,yyB0,ypB0,optionsB) %IDAReInitB allocates and initializes backward memory for IDAS. % where a prior call to IDAInitB has been made with the same % problem size NB. IDAReInitB performs the same input checking % and initializations that IDAInitB does, but it does no % memory allocation, assuming that the existing internal memory % is sufficient for the new problem. % % Usage: IDAReInitB ( IDXB, TB0, YYB0, YPB0 [, OPTIONSB] ) % % IDXB is the index of the backward problem, returned by % IDAInitB. % TB0 is the final value of t. % YYB0 is the final condition vector yB(tB0). % YPB0 is the final condition vector yB'(tB0). % OPTIONSB is an (optional) set of integration options, created with % the IDASetOptions function. % % See also: IDASetOptions, IDAInitB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 15; if nargin < 4 error('Too few input arguments'); end if nargin < 5 optionsB = []; end idxB = idxB-1; status = idm(mode, idxB, tB0, yyB0, ypB0, optionsB); sundials-2.5.0/sundialsTB/idas/IDASensSetOptions.m0000600000175000017500000001331311741421121022631 0ustar sylvestresylvestrefunction options = IDASensSetOptions(varargin) %IDASensSetOptions creates an options structure for FSA with IDAS. % % Usage: OPTIONS = IDASensSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = IDASensSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = IDASensSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % a IDAS options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = IDASensSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % IDASensSetOptions with no input arguments displays all property names % and their possible values. % %IDASensSetOptions properties %(See also the IDAS User Guide) % %method - FSA solution method [ 'Simultaneous' | {'Staggered'} ] % Specifies the FSA method for treating the nonlinear system solution for % sensitivity variables. In the simultaneous case, the nonlinear systems % for states and all sensitivities are solved simultaneously. In the % Staggered case, the nonlinear system for states is solved first and then % the nonlinear systems for all sensitivities are solved at the same time. %ParamField - Problem parameters [ string ] % Specifies the name of the field in the user data structure (specified through % the 'UserData' field with IDASetOptions) in which the nominal values of the problem % parameters are stored. This property is used only if IDAS will use difference % quotient approximations to the sensitivity residuals (see IDASensResFn). %ParamList - Parameters with respect to which FSA is performed [ integer vector ] % Specifies a list of Ns parameters with respect to which sensitivities are to % be computed. This property is used only if IDAS will use difference-quotient % approximations to the sensitivity residuals. Its length must be Ns, % consistent with the number of columns of yS0 (see IDASensInit). %ParamScales - Order of magnitude for problem parameters [ vector ] % Provides order of magnitude information for the parameters with respect to % which sensitivities are computed. This information is used if IDAS % approximates the sensitivity residuals or if IDAS estimates integration % tolerances for the sensitivity variables (see RelTol and AbsTol). %RelTol - Relative tolerance for sensitivity variables [ positive scalar ] % Specifies the scalar relative tolerance for the sensitivity variables. % See also AbsTol. %AbsTol - Absolute tolerance for sensitivity variables [ row-vector or matrix ] % Specifies the absolute tolerance for sensitivity variables. AbsTol must be % either a row vector of dimension Ns, in which case each of its components is % used as a scalar absolute tolerance for the coresponding sensitivity vector, % or a N x Ns matrix, in which case each of its columns is used as a vector % of absolute tolerances for the corresponding sensitivity vector. % By default, IDAS estimates the integration tolerances for sensitivity % variables, based on those for the states and on the order of magnitude % information for the problem parameters specified through ParamScales. %ErrControl - Error control strategy for sensitivity variables [ false | {true} ] % Specifies whether sensitivity variables are included in the error control test. % Note that sensitivity variables are always included in the nonlinear system % convergence test. %DQtype - Type of DQ approx. of the sensi. RHS [{Centered} | Forward ] % Specifies whether to use centered (second-order) or forward (first-order) % difference quotient approximations of the sensitivity eqation residuals. % This property is used only if a user-defined sensitivity residual function % was not provided. %DQparam - Cut-off parameter for the DQ approx. of the sensi. RES [ scalar | {0.0} ] % Specifies the value which controls the selection of the difference-quotient % scheme used in evaluating the sensitivity residuals (switch between % simultaneous or separate evaluations of the two components in the sensitivity % right-hand side). The default value 0.0 indicates the use of simultaenous approximation % exclusively (centered or forward, depending on the value of DQtype. % For DQparam >= 1, IDAS uses a simultaneous approximation if the estimated % DQ perturbations for states and parameters are within a factor of DQparam, % and separate approximations otherwise. Note that a value DQparam < 1 % will inhibit switching! This property is used only if a user-defined sensitivity % residual function was not provided. % % See also % IDASensInit, IDASensReInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:38:43 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) & (nargout == 0) fprintf(' method: [ Simultaneous | {Staggered} ]\n'); fprintf(' ParamField: [ string ]\n'); fprintf(' ParamList: [ integer vector ]\n'); fprintf(' ParamScales: [ vector ]\n'); fprintf(' RelTol: [ positive scalar ]\n'); fprintf(' AbsTol: [ row-vector or matrix ]\n'); fprintf(' ErrControl: [ false | {true} ]\n'); fprintf(' DQtype: [ {Centered} | {Forward} ]\n'); fprintf(' DQparam: [ scalar | {0.0} ]\n'); fprintf('\n'); return; end KeyNames = { 'method' 'ParamField' 'ParamList' 'ParamScales' 'RelTol' 'AbsTol' 'ErrControl' 'DQtype' 'DQparam' }; options = idm_options(KeyNames,varargin{:}); sundials-2.5.0/sundialsTB/idas/idm/0000755000175000017500000000000011767174700017775 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/idm/idm_monitorB.m0000600000175000017500000000047111741421121022547 0ustar sylvestresylvestrefunction [new_mondata] = idm_monitorB(call, idxB, t, y, yQ, fct, mondata) % % Wrapper around the actual user-provided Matlab function % N = length(y); idxB = idxB+1; if isempty(mondata) feval(fct, call, idxB, t, y, yQ); new_mondata = []; else new_mondata = feval(fct, call, idxB, t, y, yQ, mondata); end sundials-2.5.0/sundialsTB/idas/idm/Contents.m0000600000175000017500000000011011741421121021710 0ustar sylvestresylvestre% MEX binding of IDAS functions % %-- Radu Serban @ LLNL -- August 2007 sundials-2.5.0/sundialsTB/idas/idm/idm_pset.m0000600000175000017500000000040511741421121021726 0ustar sylvestresylvestrefunction [flag, new_data] = idm_pset(t, yy, yp, rr, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,yy,yp,rr,cj); new_data = []; else [flag, new_data] = feval(fct,t,yy,yp,rr,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_jtvB.m0000600000175000017500000000050011741421121021654 0ustar sylvestresylvestrefunction [JvB, flag, new_data] = idm_jtvB(t, yy, yp, yyB, ypB, rrB, vB, cjB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [JvB, flag] = feval(fct,t,yy,yp,yyB,ypB,rrB,vB,cjB); new_data = []; else [JvB, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,rrB,vB,cjB,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_djacB.m0000600000175000017500000000046411741421121021763 0ustar sylvestresylvestrefunction [JB, flag, new_data] = idm_djacB(t, yy, yp, yyB, ypB, rrB, cjB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [JB, flag] = feval(fct,t,yy,yp,yyB,ypB,rrB,cjB); new_data = []; else [JB, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,rrB,cjB,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_psetB.m0000600000175000017500000000045011741421121022030 0ustar sylvestresylvestrefunction [flag, new_data] = idm_psetB(t, yy, yp, yyB, ypB, rrB, cjB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,yy,yp,yyB,ypB,rrB,cjB); new_data = []; else [flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,rrB,cjBy,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_rhsQB.m0000600000175000017500000000174511741421121022002 0ustar sylvestresylvestrefunction [qBd, flag, new_data] = idm_rhsQB(type, varargin) % % Wrapper around the actual user-provided Matlab function % switch type case 0 % Not dependent on yS t = varargin{1}; yy = varargin{2}; yp = varargin{3}; yyB = varargin{4}; ypB = varargin{5}; fct = varargin{6}; data = varargin{7}; if isempty(data) [qBd, flag] = feval(fct,t,yy,yp,yyB,ypB); new_data = []; else [qBd, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,data); end case 1 % Dependent on yS t = varargin{1}; yy = varargin{2}; yp = varargin{3}; Ns = varargin{4}; yyS = varargin{5}; ypS = varargin{6}; yyB = varargin{7}; ypB = varargin{8}; fct = varargin{9}; data = varargin{10}; N = length(y); yyS = reshape(yS,N,Ns); ypS = reshape(yS,N,Ns); if isempty(data) [qBd, flag] = feval(fct,t,yy,yp,yyS,ypS,yyB,ypB); new_data = []; else [qBd, flag, new_data] = feval(fct,t,yy,yp,yyS,ypS,yyB,ypB,data); end endsundials-2.5.0/sundialsTB/idas/idm/idm_djac.m0000600000175000017500000000042111741421121021652 0ustar sylvestresylvestrefunction [J, flag, new_data] = idm_djac(t, yy, yp, rr, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [J, flag] = feval(fct,t,yy,yp,rr,cj); new_data = []; else [J, flag, new_data] = feval(fct,t,yy,yp,rr,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_bjac.m0000600000175000017500000000042111741421121021650 0ustar sylvestresylvestrefunction [J, flag, new_data] = idm_bjac(t, yy, yp, rr, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [J, flag] = feval(fct,t,yy,yp,rr,cj); new_data = []; else [J, flag, new_data] = feval(fct,t,yy,yp,rr,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_psol.m0000600000175000017500000000043011741421121021726 0ustar sylvestresylvestrefunction [z, flag, new_data] = idm_psol(t, yy, yp, rr, r, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [z, flag] = feval(fct,t,yy,yp,rr,r,cj); new_data = []; else [z, flag, new_data] = feval(fct,t,yy,yp,rr,r,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_gcomB.m0000600000175000017500000000041411741421121022002 0ustar sylvestresylvestrefunction [flag, new_data] = idm_gcomB(t, yy, yp, yyB, ypB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,yy,yp,yyB,ypB); new_data = []; else [flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_rhsQ.m0000600000175000017500000000037611741421121021677 0ustar sylvestresylvestrefunction [qd, flag, new_data] = idm_rhsQ(t, yy, yp, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [qd, flag] = feval(fct,t,yy,yp); new_data =[]; else [qd, flag, new_data] = feval(fct,t,yy,yp,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_monitor.m0000600000175000017500000000051011741421121022437 0ustar sylvestresylvestrefunction new_mondata = idm_monitor(call, t, yy, yQ, Ns, yyS, fct, mondata) % % Wrapper around the actual user-provided Matlab function % N = length(yy); yyS = reshape(yyS, N, Ns); if isempty(mondata) feval(fct, call, t, yy, yQ, yyS); new_mondata = []; else new_mondata = feval(fct, call, t, yy, yQ, yyS, mondata); end sundials-2.5.0/sundialsTB/idas/idm/idm_root.m0000600000175000017500000000037511741421121021744 0ustar sylvestresylvestrefunction [g, flag, new_data] = idm_root(t, yy, yp, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [g, flag] = feval(fct,t,yy,yp); new_data = []; else [g, flag, new_data] = feval(fct,t,yy,yp,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_glocB.m0000600000175000017500000000044111741421121022001 0ustar sylvestresylvestrefunction [resB, flag, new_data] = idm_glocB(t, yy, yp, yyB, ypB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [resB, flag] = feval(fct,t,yy,yp,yyB,ypB); new_data = []; else [resB, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_resS.m0000600000175000017500000000061611741421121021673 0ustar sylvestresylvestrefunction [rrS, flag, new_data] = idm_resS(t, yy, yp, rr, Ns, yyS, ypS, fct, data) % % Wrapper around the actual user-provided Matlab function % N = length(yy); yyS = reshape(yyS, N, Ns); ypS = reshape(ypS, N, Ns); if isempty(data) [rrS, flag] = feval(fct,t,yy,yp,rr,yyS,ypS); new_data = []; else [rrS, flag, new_data] = feval(fct,t,yy,yp,rr,yyS,ypS,data); end rrS = reshape(rrS, N*Ns, 1);sundials-2.5.0/sundialsTB/idas/idm/idm_res.m0000600000175000017500000000040111741421121021540 0ustar sylvestresylvestrefunction [res, flag, new_data] = idm_res(t, yy, yp, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [res, flag] = feval(fct,t,yy,yp); new_data = []; else [res, flag, new_data] = feval(fct,t,yy,yp,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_jtv.m0000600000175000017500000000043111741421121021555 0ustar sylvestresylvestrefunction [Jv, flag, new_data] = idm_jtv(t, yy, yp, rr, v, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [Jv, flag] = feval(fct,t,yy,yp,rr,v,cj); new_data = []; else [Jv, flag, new_data] = feval(fct,t,yy,yp,rr,v,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_resB.m0000600000175000017500000000177111741421121021655 0ustar sylvestresylvestrefunction [resB, flag, new_data] = idm_resB(type, varargin) % % Wrapper around the actual user-provided Matlab function % switch type case 0 % Not dependent on yS t = varargin{1}; yy = varargin{2}; yp = varargin{3}; yyB = varargin{4}; ypB = varargin{5}; fct = varargin{6}; data = varargin{7}; if isempty(data) [resB, flag] = feval(fct,t,yy,yp,yyB,ypB); new_data = []; else [resB, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,data); end case 1 % Dependent on yS t = varargin{1}; yy = varargin{2}; yp = varargin{3}; Ns = varargin{4}; yyS = varargin{5}; ypS = varargin{6}; yyB = varargin{7}; ypB = varargin{8}; fct = varargin{9}; data = varargin{10}; N = length(yy); yyS = reshape(yyS,N,Ns); ypS = reshape(ypS,N,Ns); if isempty(data) [resB, flag] = feval(fct,t,yy,yp,yyS,ypS,yyB,ypB); new_data = []; else [resB, flag, new_data] = feval(fct,t,yy,yp,yyS,ypS,yyB,ypB,data); end end sundials-2.5.0/sundialsTB/idas/idm/idm_gcom.m0000600000175000017500000000036111741421121021701 0ustar sylvestresylvestrefunction [flag, new_data] = idm_gcom(t, yy, yp, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,yy,yp); new_data = []; else [flag, new_data] = feval(fct,t,yy,yp,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_gloc.m0000600000175000017500000000040311741421121021675 0ustar sylvestresylvestrefunction [res, flag, new_data] = idm_gloc(t, yy, yp, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [res, flag] = feval(fct,t,yy,yp); new_data = []; else [res, flag, new_data] = feval(fct,t,yy,yp,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_psolB.m0000600000175000017500000000047711741421121022043 0ustar sylvestresylvestrefunction [zB, flag, new_data] = idm_psolB(t, yy, yp, yyB, ypB, rrB, rB, cjB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [zB, flag] = feval(fct,t,yy,yp,yyB,ypB,rrB,rB,cjB); new_data = []; else [zB, flag, new_data] = feval(fct,t,yy,yp,yyB,ypB,rrB,rB,cjB,data); end sundials-2.5.0/sundialsTB/idas/idm/idm_options.m0000600000175000017500000000235311741421121022452 0ustar sylvestresylvestrefunction options = idm_options(KeyNames, varargin) m = length(KeyNames); % Initialize the output options structure options = []; for i = 1:m options.(KeyNames{i}) = []; end % If the first argument is an options structure, read its non-empty fields % and update options. Store in j the start of key-value pairs. arg = varargin{1}; if isa(arg,'struct') for i = 1:m if isfield(arg,KeyNames{i}) options.(KeyNames{i}) = arg.(KeyNames{i}); end end j = 2; else j = 1; end % The remaining input arguments must be key-value pairs if rem(nargin-j,2) ~= 0 error('Arguments must be key-value pairs.'); end % Process each key-value pair np = (nargin-j)/2; keynames = lower(KeyNames); for i = 1:np % Get the key key = varargin{j}; % key must be a string if ~isstr(key) error(sprintf('Argument %d is not a string property name.', j)); end % Get the index in keynames that exactly matches the current key % (modulo the case) ik = strmatch(lower(key), keynames, 'exact'); if isempty(ik) error(sprintf('Unrecognized property "%s"', key)); end % Get the value val = varargin{j+1}; % Set the proper field in options options.(KeyNames{ik}) = val; % move to next pair j = j+2; end sundials-2.5.0/sundialsTB/idas/idm/idm_bjacB.m0000600000175000017500000000042211741421121021753 0ustar sylvestresylvestrefunction [J, flag, new_data] = idm_bjacB(t, yy, yp, rr, cj, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [J, flag] = feval(fct,t,yy,yp,rr,cj); new_data = []; else [J, flag, new_data] = feval(fct,t,yy,yp,rr,cj,data); end sundials-2.5.0/sundialsTB/idas/idm/src/0000755000175000017500000000000011767174700020564 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/idm/src/idm.c0000600000175000017500000024740111741421121021461 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.21 $ * $Date: 2012/03/07 21:49:18 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/idas/LICENSE. * ----------------------------------------------------------------- * MEX implementation for IDAS Matlab interface. * ----------------------------------------------------------------- */ /* * TO DO * * - implement idmSolveB_more * - implement IDM_CalcICB */ #include #include #include "idm.h" #include "nvm.h" /* * --------------------------------------------------------------------------------- * Global interface data variable * --------------------------------------------------------------------------------- */ idmInterfaceData idmData = NULL; /* * --------------------------------------------------------------------------------- * Static function prototypes * --------------------------------------------------------------------------------- */ static void idmInitIDASdata(); static void idmPersistIDASdata(); static void idmFinalIDASdata(); static void idmInitPbData(idmPbData pb); static void idmPersistPbData(idmPbData pb); static void idmFinalPbData(idmPbData pb); static int IDM_Initialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_QuadInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_SensInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_AdjInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_InitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_QuadInitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_SensToggleOff(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_CalcIC(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_CalcICB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_SolveB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int idmSolveB_one(mxArray *plhs[], int NtoutB, double *toutB, int itaskB); static int idmSolveB_more(mxArray *plhs[], int NtoutB, double *toutB, int itaskB, booleantype any_quadrB, booleantype any_monB); static int IDM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_StatsB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_SetB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int IDM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); /* * --------------------------------------------------------------------------------- * Main entry point * --------------------------------------------------------------------------------- */ void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { int mode; /* Modes: 1 - initialize IDAS solver 2 - initialize quadratures 3 - initialize forward sensitivity calculations 4 - initialize adjoint sensitivity calculations 5 - initialize backward solver 6 - initialize backward quadratures 11 - reinitialize IDAS solver 12 - reinitialize quadratures 13 - reinitialize forward sensitivity calculations 14 - reinitialize adjoint sensitivity calculations 15 - reinitialize backward solver 16 - reinitialize backward quadratures 18 - toggle FSA off 20 - solve problem 21 - solve backward problem TODO 25 - calculate consistent IC 26 - calculate backward consistent IC TODO 30 - get integrator stats 31 - get backward integrator stats 32 - extract data from ida_mem 33 - set one optional input at a time 34 - set one optional input at a time for backward problems 40 - finalize */ mode = (int)mxGetScalar(prhs[0]); mexUnlock(); if ( (mode != 1) && (idmData == NULL) ) { mexErrMsgTxt("IDAS - Illegal attempt to call before IDAInit."); } switch(mode) { /* Initialization functions */ case 1: if (idmData != NULL) { IDM_Free(nlhs, plhs, nrhs-1, &prhs[1]); idmFinalIDASdata(); } idmInitIDASdata(); IDM_Initialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 2: IDM_QuadInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 3: IDM_SensInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 4: IDM_AdjInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 5: IDM_InitializationB(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 6: IDM_QuadInitializationB(0, nlhs, plhs, nrhs-1, &prhs[1]); break; /* Re-initialization functions */ case 11: IDM_Initialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 12: IDM_QuadInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 13: IDM_SensInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 14: IDM_AdjInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 15: IDM_InitializationB(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 16: IDM_QuadInitializationB(1, nlhs, plhs, nrhs-1, &prhs[1]); break; /* Sensitivity toggle function */ case 18: IDM_SensToggleOff(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Solve functions */ case 20: IDM_Solve(nlhs, plhs, nrhs-1, &prhs[1]); break; case 21: IDM_SolveB(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Consistent IC calculation functions */ case 25: IDM_CalcIC(nlhs, plhs, nrhs-1, &prhs[1]); break; case 26: IDM_CalcICB(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Optional output extraction functions */ case 30: IDM_Stats(nlhs, plhs, nrhs-1, &prhs[1]); break; case 31: IDM_StatsB(nlhs, plhs, nrhs-1, &prhs[1]); break; case 32: IDM_Get(nlhs, plhs, nrhs-1, &prhs[1]); break; case 33: IDM_Set(nlhs, plhs, nrhs-1, &prhs[1]); break; case 34: IDM_SetB(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Memory deallocation function */ case 40: IDM_Free(nlhs, plhs, nrhs-1, &prhs[1]); idmFinalIDASdata(); return; } /* Unless this was the IDAFree call, * make data persistent and lock the MEX file */ if (mode != 40) { idmPersistIDASdata(); mexLock(); } return; } /* * --------------------------------------------------------------------------------- * Private functions * --------------------------------------------------------------------------------- */ static void idmInitIDASdata() { /* Allocate space for global IDAS data structure */ idmData = (idmInterfaceData) mxMalloc(sizeof(struct idmInterfaceData_)); /* Initialize global IDAS data */ idmData->ida_mem = NULL; idmData->fwdPb = NULL; idmData->bckPb = NULL; idmData->NbckPb = 0; idmData->Nd = 0; idmData->Nc = 0; idmData->asa = FALSE; idmData->errMsg = TRUE; return; } static void idmInitPbData(idmPbData pb) { mxArray *empty; pb->n = 0; pb->nq = 0; pb->ng = 0; pb->ns = 0; pb->YY = NULL; pb->YP = NULL; pb->YQ = NULL; pb->YYS = NULL; pb->YPS = NULL; pb->Quadr = FALSE; pb->Fsa = FALSE; pb->Mon = FALSE; pb->LS = LS_DENSE; pb->PM = PM_NONE; empty = mxCreateDoubleMatrix(0,0,mxREAL); pb->RESfct = mxDuplicateArray(empty); pb->Gfct = mxDuplicateArray(empty); pb->QUADfct = mxDuplicateArray(empty); pb->SRESfct = mxDuplicateArray(empty); pb->JACfct = mxDuplicateArray(empty); pb->PSETfct = mxDuplicateArray(empty); pb->PSOLfct = mxDuplicateArray(empty); pb->GLOCfct = mxDuplicateArray(empty); pb->GCOMfct = mxDuplicateArray(empty); pb->MONfct = mxDuplicateArray(empty); pb->MONdata = mxDuplicateArray(empty); pb->mtlb_data = mxDuplicateArray(empty); pb->fwd = idmData->fwdPb; pb->index = 0; pb->next = NULL; mxDestroyArray(empty); } static void idmPersistIDASdata() { idmPbData tmpPb; /* Make global memory persistent */ if (idmData->fwdPb != NULL) { idmPersistPbData(idmData->fwdPb); mexMakeMemoryPersistent(idmData->fwdPb); } tmpPb = idmData->bckPb; while(tmpPb != NULL) { idmPersistPbData(tmpPb); mexMakeMemoryPersistent(tmpPb); tmpPb = tmpPb->next; } mexMakeMemoryPersistent(idmData); return; } static void idmPersistPbData(idmPbData pb) { mexMakeArrayPersistent(pb->mtlb_data); mexMakeArrayPersistent(pb->RESfct); mexMakeArrayPersistent(pb->Gfct); mexMakeArrayPersistent(pb->QUADfct); mexMakeArrayPersistent(pb->SRESfct); mexMakeArrayPersistent(pb->JACfct); mexMakeArrayPersistent(pb->PSETfct); mexMakeArrayPersistent(pb->PSOLfct); mexMakeArrayPersistent(pb->GLOCfct); mexMakeArrayPersistent(pb->GCOMfct); mexMakeArrayPersistent(pb->MONfct); mexMakeArrayPersistent(pb->MONdata); } static void idmFinalIDASdata() { idmPbData tmpPb; if (idmData == NULL) return; if (idmData->fwdPb != NULL) { idmFinalPbData(idmData->fwdPb); mxFree(idmData->fwdPb); idmData->fwdPb = NULL; } while(idmData->bckPb != NULL) { tmpPb = idmData->bckPb->next; mxFree(idmData->bckPb); idmData->bckPb = tmpPb; } mxFree(idmData); idmData = NULL; return; } static void idmFinalPbData(idmPbData pb) { if (pb->YY != NULL) N_VDestroy(pb->YY); if (pb->YP != NULL) N_VDestroy(pb->YP); if (pb->YQ != NULL) N_VDestroy(pb->YQ); if (pb->YYS != NULL) N_VDestroyVectorArray(pb->YYS, pb->ns); if (pb->YPS != NULL) N_VDestroyVectorArray(pb->YPS, pb->ns); mxDestroyArray(pb->mtlb_data); mxDestroyArray(pb->RESfct); mxDestroyArray(pb->Gfct); mxDestroyArray(pb->QUADfct); mxDestroyArray(pb->SRESfct); mxDestroyArray(pb->JACfct); mxDestroyArray(pb->PSETfct); mxDestroyArray(pb->PSOLfct); mxDestroyArray(pb->GLOCfct); mxDestroyArray(pb->GCOMfct); mxDestroyArray(pb->MONfct); mxDestroyArray(pb->MONdata); } /* * --------------------------------------------------------------------------------- * Error handler function. * * This function is both passed as the IDAS error handler and used throughout * the Matlab interface. * * If called directly by one of the interface functions, error_code = -999 to * indicate an error and err_code = +999 to indicate a warning. Otherwise, * err_code is set by the calling IDAS function. * * NOTE: mexErrMsgTxt will end the execution of the MEX file. Therefore we do * not have to intercept any of the IDAS error return flags. * The only return flags we intercept are those from IDASolve() and IDASolveB() * which are passed back to the user (only positive values will make it). * --------------------------------------------------------------------------------- */ void idmErrHandler(int error_code, const char *module, const char *function, char *msg, void *f_data) { char err_msg[256]; if (!(idmData->errMsg)) return; if (error_code > 0) { sprintf(err_msg,"Warning in ==> %s\n%s",function,msg); mexWarnMsgTxt(err_msg); } else if (error_code < 0) { sprintf(err_msg,"Error using ==> %s\n%s",function,msg); mexErrMsgTxt(err_msg); } return; } /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define ida_mem (idmData->ida_mem) #define asa (idmData->asa) #define Nd (idmData->Nd) #define Nc (idmData->Nc) #define NbckPb (idmData->NbckPb) #define fsa (fwdPb->Fsa) #define quadr (fwdPb->Quadr) #define mon (fwdPb->Mon) #define rootSet (fwdPb->RootSet) #define tstopSet (fwdPb->TstopSet) #define yy (fwdPb->YY) #define yp (fwdPb->YP) #define yQ (fwdPb->YQ) #define yyS (fwdPb->YYS) #define ypS (fwdPb->YPS) #define N (fwdPb->n) #define Nq (fwdPb->nq) #define Ng (fwdPb->ng) #define Ns (fwdPb->ns) #define ls (fwdPb->LS) #define pm (fwdPb->PM) #define mtlb_data (fwdPb->mtlb_data) #define mtlb_RESfct (fwdPb->RESfct) #define mtlb_QUADfct (fwdPb->QUADfct) #define mtlb_JACfct (fwdPb->JACfct) #define mtlb_PSETfct (fwdPb->PSETfct) #define mtlb_PSOLfct (fwdPb->PSOLfct) #define mtlb_GLOCfct (fwdPb->GLOCfct) #define mtlb_GCOMfct (fwdPb->GCOMfct) #define mtlb_Gfct (fwdPb->Gfct) #define mtlb_SRESfct (fwdPb->SRESfct) #define mtlb_MONfct (fwdPb->MONfct) #define mtlb_MONdata (fwdPb->MONdata) #define indexB (bckPb->index) #define quadrB (bckPb->Quadr) #define monB (bckPb->Mon) #define yyB (bckPb->YY) #define ypB (bckPb->YP) #define yQB (bckPb->YQ) #define NB (bckPb->n) #define NqB (bckPb->nq) #define lsB (bckPb->LS) #define pmB (bckPb->PM) #define mtlb_dataB (bckPb->mtlb_data) #define mtlb_RESfctB (bckPb->RESfct) #define mtlb_QUADfctB (bckPb->QUADfct) #define mtlb_JACfctB (bckPb->JACfct) #define mtlb_PSETfctB (bckPb->PSETfct) #define mtlb_PSOLfctB (bckPb->PSOLfct) #define mtlb_GLOCfctB (bckPb->GLOCfct) #define mtlb_GCOMfctB (bckPb->GCOMfct) #define mtlb_MONfctB (bckPb->MONfct) #define mtlb_MONdataB (bckPb->MONdata) /* * --------------------------------------------------------------------------------- * Exported procedures * --------------------------------------------------------------------------------- */ /* IDM_Initialization * * action = 0 -> IDACreate + IDAInit * action = 1 -> IDAReInit * * prhs contains: * res * t0 * yy0 * yp0 * options * data * * plhs contains: * status * */ static int IDM_Initialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; const mxArray *options; double t0, *yy0, *yp0; int maxord; long int mxsteps; int itol; realtype reltol, Sabstol, *Vabstol; N_Vector NV_abstol; double hin, hmax; double tstop; booleantype suppress; long int mupper, mlower; int gstype, maxl; long int mudq, mldq; double dqrely; double *id, *cnstr; N_Vector NV_id, NV_cnstr; booleantype errmsg; booleantype res_s; /* ignored */ int status; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* SOLVER INITIALIZATION */ /* Create and initialize a new problem */ fwdPb = (idmPbData) mxMalloc(sizeof(struct idmPbData_)); idmInitPbData(fwdPb); idmData->fwdPb = fwdPb; /* Initialize appropriate vector module */ InitVectors(); /* Extract user-provided RES function */ mxDestroyArray(mtlb_RESfct); mtlb_RESfct = mxDuplicateArray(prhs[0]); /* Extract initial time */ t0 = (double)mxGetScalar(prhs[1]); /* Extract initial conditions */ yy0 = mxGetPr(prhs[2]); yp0 = mxGetPr(prhs[3]); N = mxGetM(prhs[2]); /* Create the solution N_Vectors */ yy = NewVector(N); yp = NewVector(N); /* Load initial conditions */ PutData(yy, yy0, N); PutData(yp, yp0, N); /* Extract options structure */ options = prhs[4]; break; case 1: /* SOLVER RE-INITIALIZATION */ fwdPb = idmData->fwdPb; /* If monitoring was enabled, finalize it now. */ if (mon) mxW_IDAMonitor(2, 0.0, NULL, NULL, NULL, fwdPb); /* Extract initial time */ t0 = (double)mxGetScalar(prhs[0]); /* Extract initial conditions */ yy0 = mxGetPr(prhs[1]); if (mxGetM(prhs[1]) != N) { idmErrHandler(-999, "IDAS", "IDAReInit", "Size of yy0 changed from IDAInit call.", NULL); goto error_return; } yp0 = mxGetPr(prhs[2]); if (mxGetM(prhs[2]) != N) { idmErrHandler(-999, "IDAS", "IDAReInit", "Size of yp0 changed from IDAInit call.", NULL); goto error_return; } /* Load initial conditions */ PutData(yy, yy0, N); PutData(yp, yp0, N); /* Extract options structure */ options = prhs[3]; break; } /* Process the options structure */ status = get_IntgrOptions(options, fwdPb, TRUE, &maxord, &mxsteps, &itol, &reltol, &Sabstol, &Vabstol, &hin, &hmax, &tstop, &suppress, &errmsg, &id, &cnstr, &res_s); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate IDAS functions * * If action = 0 * Create IDAS object and allocate memory * Attach error handler function * Redirect output * If action = 1 * Reinitialize solver * ---------------------------------------- */ switch (action) { case 0: /* Create IDAS object */ ida_mem = IDACreate(); if (ida_mem == NULL) goto error_return; /* Attach the global IDAS data as 'user-data' */ status = IDASetUserData(ida_mem, fwdPb); if (status != IDA_SUCCESS) goto error_return; /* Attach error handler function */ status = IDASetErrHandlerFn(ida_mem, idmErrHandler, fwdPb); if (status != IDA_SUCCESS) goto error_return; /* Call IDAInit */ status = IDAInit(ida_mem, mxW_IDARes, t0, yy, yp); if (status != IDA_SUCCESS) goto error_return; /* Redirect output */ status = IDASetErrFile(ida_mem, stdout); if (status != IDA_SUCCESS) goto error_return; break; case 1: /* Reinitialize solver */ status = IDAReInit(ida_mem, t0, yy, yp); if (status != IDA_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances * ---------------------------------------- */ switch (itol) { case IDA_SS: status = IDASStolerances(ida_mem, reltol, Sabstol); if (status != IDA_SUCCESS) goto error_return; break; case IDA_SV: NV_abstol = N_VClone(yy); PutData(NV_abstol, Vabstol, N); status = IDASVtolerances(ida_mem, reltol, NV_abstol); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_abstol); break; } /* * -------------------------------- * Set various optional inputs * -------------------------------- */ /* set maxorder (default is 5) */ status = IDASetMaxOrd(ida_mem, maxord); if (status != IDA_SUCCESS) goto error_return; /* set initial step size (the default value of 0.0 is ignored by IDAS) */ status = IDASetInitStep(ida_mem, hin); if (status != IDA_SUCCESS) goto error_return; /* set max step (default is infinity) */ status = IDASetMaxStep(ida_mem, hmax); if (status != IDA_SUCCESS) goto error_return; /* set number of max steps */ status = IDASetMaxNumSteps(ida_mem, mxsteps); if (status != IDA_SUCCESS) goto error_return; /* set suppressAlg */ status = IDASetSuppressAlg(ida_mem, suppress); if (status != IDA_SUCCESS) goto error_return; /* set tstop? */ if (tstopSet) { status = IDASetStopTime(ida_mem, tstop); if (status != IDA_SUCCESS) goto error_return; } /* Rootfinding? */ if ( !mxIsEmpty(mtlb_Gfct) && (Ng > 0) ) { status = IDARootInit(ida_mem, Ng, mxW_IDAGfct); if (status != IDA_SUCCESS) goto error_return; rootSet = TRUE; } else { rootSet = FALSE; } /* ID vector specified? */ if (id != NULL) { NV_id = N_VClone(yy); PutData(NV_id, id, N); status = IDASetId(ida_mem, NV_id); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_id); } /* Constraint vector specified? */ if (cnstr != NULL) { NV_cnstr = N_VClone(yy); PutData(NV_cnstr, cnstr, N); status = IDASetConstraints(ida_mem, NV_cnstr); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_cnstr); } /* * ---------------------------------------- * Linear solver * ---------------------------------------- */ status = get_LinSolvOptions(options, fwdPb, TRUE, &mupper, &mlower, &mudq, &mldq, &dqrely, &gstype, &maxl); if (status != 0) goto error_return; switch (ls) { case LS_DENSE: status = IDADense(ida_mem, N); if (status != IDA_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = IDADlsSetDenseJacFn(ida_mem, mxW_IDADenseJac); if (status != IDA_SUCCESS) goto error_return; } break; case LS_BAND: status = IDABand(ida_mem, N, mupper, mlower); if (status != IDA_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = IDADlsSetBandJacFn(ida_mem, mxW_IDABandJac); if (status != IDA_SUCCESS) goto error_return; } break; case LS_SPGMR: status = IDASpgmr(ida_mem, maxl); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsSetGSType(ida_mem, gstype); if (status != IDA_SUCCESS) goto error_return; break; case LS_SPBCG: status = IDASpbcg(ida_mem, maxl); if (status != IDA_SUCCESS) goto error_return; break; case LS_SPTFQMR: status = IDASptfqmr(ida_mem, maxl); if (status != IDA_SUCCESS) goto error_return; break; } /* Jacobian * vector and preconditioner for SPILS linear solvers */ if ( (ls==LS_SPGMR) || (ls==LS_SPBCG) || (ls==LS_SPTFQMR) ) { if (!mxIsEmpty(mtlb_JACfct)) { status = IDASpilsSetJacTimesVecFn(ida_mem, mxW_IDASpilsJac); if (status != IDA_SUCCESS) goto error_return; } switch (pm) { case PM_NONE: if (!mxIsEmpty(mtlb_PSOLfct)) { if (!mxIsEmpty(mtlb_PSETfct)) status = IDASpilsSetPreconditioner(ida_mem, mxW_IDASpilsPset, mxW_IDASpilsPsol); else status = IDASpilsSetPreconditioner(ida_mem, NULL, mxW_IDASpilsPsol); } if (status != IDA_SUCCESS) goto error_return; break; case PM_BBDPRE: if (!mxIsEmpty(mtlb_GCOMfct)) status = IDABBDPrecInit(ida_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_IDABBDgloc, mxW_IDABBDgcom); else status = IDABBDPrecInit(ida_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_IDABBDgloc, NULL); if (status != IDA_SUCCESS) goto error_return; break; } } /* Do we monitor? */ if (mon) mxW_IDAMonitor(0, t0, NULL, NULL, NULL, fwdPb); /* Set errMsg field in global data * (all error messages from here on will respect this) */ idmData->errMsg = errmsg; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* IDM_QuadInitialization * * action = 0 -> IDAQuadInit * prhs contains: * fQ * y0 * options * * action = 1 -> IDAQuadReInit * prhs contains: * y0 * options * */ static int IDM_QuadInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; const mxArray *options; double *yQ0; booleantype rhs_s; /* ignored */ booleantype errconQ; int itolQ; realtype reltolQ, SabstolQ, *VabstolQ; N_Vector NV_abstolQ; int status; fwdPb = idmData->fwdPb; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* QUADRATURE INITIALIZATION */ /* Extract user-provided quadrature RHS function */ mxDestroyArray(mtlb_QUADfct); mtlb_QUADfct = mxDuplicateArray(prhs[0]); /* Extract quadrature initial conditions */ yQ0 = mxGetPr(prhs[1]); Nq = mxGetM(prhs[1]); /* Create the quadrature N_Vector */ yQ = NewVector(Nq); /* Load quadrature initial conditions */ PutData(yQ, yQ0, Nq); /* Extract quadrature options structure */ options = prhs[2]; break; case 1: /* QUADRATURE RE-INITIALIZATION */ /* Extract quadrature initial conditions */ yQ0 = mxGetPr(prhs[0]); if (mxGetM(prhs[0]) != Nq) { idmErrHandler(-999, "IDAS", "IDAQuadReInit", "Size of yQ0 changed from IDAQuadInit call.", NULL); goto error_return; } /* Load quadrature initial conditions */ PutData(yQ, yQ0, Nq); /* Extract quadrature options structure */ options = prhs[1]; break; } /* Process the options structure */ status = get_QuadOptions(options, fwdPb, TRUE, Nq, &rhs_s, &errconQ, &itolQ, &reltolQ, &SabstolQ, &VabstolQ); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate IDAS functions * * If action = 0 * Initialize quadratures * If action = 1 * Reinitialize quadratures * ---------------------------------------- */ switch (action) { case 0: status = IDAQuadInit(ida_mem, mxW_IDAQuadFct, yQ); if (status != IDA_SUCCESS) goto error_return; break; case 1: status = IDAQuadReInit(ida_mem, yQ); if (status != IDA_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances for quadrature variables * ---------------------------------------- */ status = IDASetQuadErrCon(ida_mem, errconQ); if (status != IDA_SUCCESS) goto error_return; if (errconQ) { switch (itolQ) { case IDA_SS: status = IDAQuadSStolerances(ida_mem, reltolQ, SabstolQ); if (status != IDA_SUCCESS) goto error_return; break; case IDA_SV: NV_abstolQ = N_VClone(yQ); PutData(NV_abstolQ, VabstolQ, Nq); status = IDAQuadSVtolerances(ida_mem, reltolQ, NV_abstolQ); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_abstolQ); break; } } /* Quadratures will be integrated */ quadr = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* IDM_SensInitialization * action = 0 -> IDASensInit * action = 1 -> IDASensReInit * * prhs contains: * Ns * sensi_meth * yS0 * options * * plhs contains: * status * */ static int IDM_SensInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; const mxArray *options; booleantype fS_DQ; IDASensResFn resS; double *yyS0, *ypS0; int ism; mxArray *pfield; char *pfield_name; booleantype errconS; int itolS; realtype reltolS; realtype *SabstolS, *VabstolS; N_Vector *NV_abstolS; int *plist, dqtype; double *p, *pbar, rho; int is, status; p = NULL; plist = NULL; pbar = NULL; fwdPb = idmData->fwdPb; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* FSA INITIALIZATION */ /* Extract number of sensitivities */ Ns = (int)mxGetScalar(prhs[0]); /* Extract user-provided sensitivity residual function */ if ( mxIsEmpty(prhs[1]) ) { resS = NULL; fS_DQ = TRUE; } else { mxDestroyArray(mtlb_SRESfct); mtlb_SRESfct = mxDuplicateArray(prhs[1]); resS = mxW_IDASensRes; fS_DQ = FALSE; } /* Extract sensitivity initial conditions */ yyS0 = mxGetPr(prhs[2]); ypS0 = mxGetPr(prhs[3]); /* Create the sensitivity N_Vectors */ yyS = N_VCloneVectorArray(Ns, yy); ypS = N_VCloneVectorArray(Ns, yy); /* Load sensitivity initial conditions */ for (is=0;isfwdPb; status = IDASensToggleOff(ida_mem); if (status != IDA_SUCCESS) { status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } fsa = FALSE; status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); } /* IDM_AdjInitialization * * prhs contains: * * plhs contains: * status */ static int IDM_AdjInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { int interp; int buflen, status; char *bufval; switch (action) { case 0: /* Number of steps */ Nd = (int)mxGetScalar(prhs[0]); /* Interpolation method */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(status != 0) { idmErrHandler(-999, "IDAS", "IDAAdjInit", "Could not parse InterpType.", NULL); goto error_return; } if(!strcmp(bufval,"Hermite")) { interp = IDA_HERMITE; } else if(!strcmp(bufval,"Polynomial")) { interp = IDA_POLYNOMIAL; } else { idmErrHandler(-999, "IDAS", "IDAAdjInit", "Interp. type has an illegal value.", NULL); goto error_return; } status = IDAAdjInit(ida_mem, Nd, interp); if (status != IDA_SUCCESS) goto error_return; break; case 1: status = IDAAdjReInit(ida_mem); if (status != IDA_SUCCESS) goto error_return; break; } asa = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* IDM_InitializationB * * action = 0 -> IDACreateB + IDAInitB * action = 1 -> IDAReInitB * * prhs contains: * resB * tF * yyB0 * ypB0 * options * data * * plhs contains: * status * */ static int IDM_InitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData bckPb; const mxArray *options; int idxB; double tB0, *yyB0, *ypB0; int maxordB; long int mxstepsB; int itolB; realtype reltolB, SabstolB, *VabstolB; N_Vector NV_abstolB; double hinB, hmaxB; double tstopB; /* ignored */ booleantype errmsgB; /* ignored */ booleantype suppressB; long int mupperB, mlowerB; int gstypeB, maxlB; long int mudqB, mldqB; double dqrelyB; double *idB, *cnstrB; N_Vector NV_idB; booleantype res_s; booleantype found_bck; int status; int i_status; /* Set output containing status */ i_status = (action == 0) ? 1 : 0; /* * ----------------------------- * Finalize Forward monitoring * ----------------------------- */ if (idmData->fwdPb->Mon) { mxW_IDAMonitor(2, 0.0, NULL, NULL, NULL, idmData->fwdPb); idmData->fwdPb->Mon = FALSE; } /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* BACKWARD SOLVER INITIALIZATION */ /* Create and initialize a new problem */ bckPb = (idmPbData) mxMalloc(sizeof(struct idmPbData_)); idmInitPbData(bckPb); bckPb->next = idmData->bckPb; idmData->bckPb = bckPb; /* Extract user-provided RHS function */ mxDestroyArray(mtlb_RESfctB); mtlb_RESfctB = mxDuplicateArray(prhs[0]); /* Extract final time */ tB0 = (double)mxGetScalar(prhs[1]); /* Extract final conditions */ yyB0 = mxGetPr(prhs[2]); ypB0 = mxGetPr(prhs[3]); NB = mxGetM(prhs[2]); /* Create the solution N_Vectors */ yyB = NewVector(NB); ypB = NewVector(NB); /* Load final conditions */ PutData(yyB, yyB0, NB); PutData(ypB, ypB0, NB); /* Extract options structure */ options = prhs[4]; break; case 1: /* BACKWARD SOLVER RE-INITIALIZATION */ /* Extract index of current backward problem */ idxB = (int)mxGetScalar(prhs[0]); /* Find current backward problem */ found_bck = FALSE; bckPb = idmData->bckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) { idmErrHandler(-999, "IDAS", "IDAReInitB", "idxB has an illegal value.", NULL); goto error_return; } /* If backward monitoring was enabled, finalize it now. */ if (monB) mxW_IDAMonitorB(2, indexB, 0.0, NULL, NULL, bckPb); /* Extract final time */ tB0 = (double)mxGetScalar(prhs[1]); /* Extract final conditions */ yyB0 = mxGetPr(prhs[2]); if (mxGetM(prhs[2]) != NB) { idmErrHandler(-999, "IDAS", "IDAReInitB", "Size of yyB0 changed from IDAInitB call.", NULL); goto error_return; } yyB0 = mxGetPr(prhs[3]); if (mxGetM(prhs[3]) != NB) { idmErrHandler(-999, "IDAS", "IDAReInitB", "Size of ypB0 changed from IDAInitB call.", NULL); goto error_return; } /* Load final conditions */ PutData(yyB, yyB0, NB); PutData(ypB, ypB0, NB); /* Extract options structure */ options = prhs[4]; break; } /* Process the options structure */ status = get_IntgrOptions(options, bckPb, FALSE, &maxordB, &mxstepsB, &itolB, &reltolB, &SabstolB, &VabstolB, &hinB, &hmaxB, &tstopB, &suppressB, &errmsgB, &idB, &cnstrB, &res_s); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate IDAS functions * * If action = 0 * Create IDAS object and allocate memory * Initialize and allocate memory * If action = 1 * Reinitialize solver * ---------------------------------------- */ switch (action) { case 0: status = IDACreateB(ida_mem, &idxB); if (status != IDA_SUCCESS) goto error_return; status = IDASetUserDataB(ida_mem, idxB, bckPb); if (status != IDA_SUCCESS) goto error_return; if (res_s) status = IDAInitBS(ida_mem, idxB, mxW_IDAResBS, tB0, yyB, ypB); else status = IDAInitB(ida_mem, idxB, mxW_IDAResB, tB0, yyB, ypB); if (status != IDA_SUCCESS) goto error_return; /* Return idxB */ plhs[0] = mxCreateDoubleScalar((double)idxB); indexB = idxB; NbckPb++; break; case 1: status = IDAReInitB(ida_mem, idxB, tB0, yyB, ypB); if (status != IDA_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances * ---------------------------------------- */ switch (itolB) { case IDA_SS: status = IDASStolerancesB(ida_mem, idxB, reltolB, SabstolB); if (status != IDA_SUCCESS) goto error_return; break; case IDA_SV: NV_abstolB = N_VClone(yyB); PutData(NV_abstolB, VabstolB, NB); status = IDASVtolerancesB(ida_mem, idxB, reltolB, NV_abstolB); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_abstolB); break; } /* * -------------------------------- * Set various optional inputs * -------------------------------- */ /* set maxorder (default is consistent with LMM) */ status = IDASetMaxOrdB(ida_mem, idxB, maxordB); if (status != IDA_SUCCESS) goto error_return; /* set initial step size (the default value of 0.0 is ignored by IDAS) */ status = IDASetInitStepB(ida_mem, idxB, hinB); if (status != IDA_SUCCESS) goto error_return; /* set max step (default is infinity) */ status = IDASetMaxStepB(ida_mem, idxB, hmaxB); if (status != IDA_SUCCESS) goto error_return; /* set number of max steps */ status = IDASetMaxNumStepsB(ida_mem, idxB, mxstepsB); if (status != IDA_SUCCESS) goto error_return; /* set suppressAlg */ status = IDASetSuppressAlgB(ida_mem, idxB, suppressB); if (status != IDA_SUCCESS) goto error_return; /* ID vector specified? */ if (idB != NULL) { NV_idB = N_VClone(yyB); PutData(NV_idB, idB, NB); status = IDASetIdB(ida_mem, idxB, NV_idB); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_idB); } /* * ---------------------------------------- * Linear solver * ---------------------------------------- */ status = get_LinSolvOptions(options, bckPb, FALSE, &mupperB, &mlowerB, &mudqB, &mldqB, &dqrelyB, &gstypeB, &maxlB); if (status != 0) goto error_return; switch(lsB) { case LS_DENSE: status = IDADenseB(ida_mem, idxB, NB); if (status != IDA_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfctB)) { status = IDADlsSetDenseJacFnB(ida_mem, idxB, mxW_IDADenseJacB); if (status != IDA_SUCCESS) goto error_return; } break; case LS_BAND: status = IDABandB(ida_mem, idxB, NB, mupperB, mlowerB); if (status != IDA_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfctB)) { status = IDADlsSetBandJacFnB(ida_mem, idxB, mxW_IDABandJacB); if (status != IDA_SUCCESS) goto error_return; } break; case LS_SPGMR: status = IDASpgmrB(ida_mem, idxB, maxlB); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsSetGSTypeB(ida_mem, idxB, gstypeB); if (status != IDA_SUCCESS) goto error_return; break; case LS_SPBCG: status = IDASpbcgB(ida_mem, idxB, maxlB); if (status != IDA_SUCCESS) goto error_return; break; case LS_SPTFQMR: status = IDASptfqmrB(ida_mem, idxB, maxlB); if (status != IDA_SUCCESS) goto error_return; break; } /* Jacobian * vector and preconditioner for SPILS linear solvers */ if ( (lsB==LS_SPGMR) || (lsB==LS_SPBCG) || (lsB==LS_SPTFQMR) ) { if (!mxIsEmpty(mtlb_JACfctB)) { status =IDASpilsSetJacTimesVecFnB(ida_mem, idxB, mxW_IDASpilsJacB); if (status != IDA_SUCCESS) goto error_return; } switch (pmB) { case PM_NONE: if (!mxIsEmpty(mtlb_PSOLfctB)) { if (!mxIsEmpty(mtlb_PSETfctB)) status = IDASpilsSetPreconditionerB(ida_mem, idxB, mxW_IDASpilsPsetB, mxW_IDASpilsPsolB); else status =IDASpilsSetPreconditionerB(ida_mem, idxB, NULL, mxW_IDASpilsPsolB); } if (status != IDA_SUCCESS) goto error_return; break; case PM_BBDPRE: if (!mxIsEmpty(mtlb_GCOMfctB)) status = IDABBDPrecInitB(ida_mem, idxB, NB, mudqB, mldqB, mupperB, mlowerB, dqrelyB, mxW_IDABBDglocB, mxW_IDABBDgcomB); else status = IDABBDPrecInitB(ida_mem, idxB, NB, mudqB, mldqB, mupperB, mlowerB, dqrelyB, mxW_IDABBDglocB, NULL); if (status != IDA_SUCCESS) goto error_return; break; } } /* Do we monitor? */ if (monB) mxW_IDAMonitorB(0, idxB, tB0, NULL, NULL, bckPb); /* Successful return */ status = 0; plhs[i_status] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[i_status] = mxCreateDoubleScalar((double)status); return(-1); } /* IDM_QuadInitializationB * * action = 0 -> IDAQuadInitB * prhs contains: * idxB * fQB * yQB0 * options * * action = 1 -> IDAQuadReInitB * idxB * yQB0 * options * */ static int IDM_QuadInitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData bckPb; const mxArray *options; int idxB; double *yQB0; booleantype rhs_s; booleantype errconQB; int itolQB; realtype reltolQB, SabstolQB, *VabstolQB; N_Vector NV_abstolQB; booleantype found_bck; int status; /* Extract index of current backward problem */ idxB = (int)mxGetScalar(prhs[0]); /* Find current backward problem */ found_bck = FALSE; bckPb = idmData->bckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) { idmErrHandler(-999, "IDAS", "IDAQuadInitB/IDAQuadReInitB", "idxB has an illegal value.", NULL); goto error_return; } /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* BACKWARD QUADRATURE INITIALIZATION */ /* Extract user-provided quadrature RHS function */ mxDestroyArray(mtlb_QUADfctB); mtlb_QUADfctB = mxDuplicateArray(prhs[1]); /* Extract quadrature final conditions */ yQB0 = mxGetPr(prhs[2]); NqB = mxGetM(prhs[2]); /* Create the backward quadrature N_Vector */ yQB = NewVector(NqB); /* Load quadrature final conditions */ PutData(yQB, yQB0, NqB); /* Extract quadrature options structure */ options = prhs[3]; break; case 1: /* BACKWARD QUADRATURE RE-INITIALIZATION */ /* Extract quadrature final conditions */ yQB0 = mxGetPr(prhs[1]); if (mxGetM(prhs[1]) != NqB) { idmErrHandler(-999, "IDAS", "IDAQuadReInitB", "Size of yQB0 changed from IDAQuadInitB call.", NULL); goto error_return; } /* Load quadrature final conditions */ PutData(yQB, yQB0, NqB); /* Extract quadrature options structure */ options = prhs[2]; break; } /* Process the options structure */ status = get_QuadOptions(options, bckPb, FALSE, NqB, &rhs_s, &errconQB, &itolQB, &reltolQB, &SabstolQB, &VabstolQB); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate IDAS functions * * If action = 0 * Initialize backward quadratures * If action = 1 * Reinitialize backward quadratures * ---------------------------------------- */ switch (action) { case 0: if (rhs_s) status = IDAQuadInitBS(ida_mem, idxB, mxW_IDAQuadFctBS, yQB); else status = IDAQuadInitB(ida_mem, idxB, mxW_IDAQuadFctB, yQB); if (status != IDA_SUCCESS) goto error_return; break; case 1: status = IDAQuadReInitB(ida_mem, idxB, yQB); if (status != IDA_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances for quadrature variables * ---------------------------------------- */ status = IDASetQuadErrConB(ida_mem, idxB, errconQB); if (status != IDA_SUCCESS) goto error_return; if (errconQB) { switch (itolQB) { case IDA_SS: status = IDAQuadSStolerancesB(ida_mem, idxB, reltolQB, SabstolQB); if (status != IDA_SUCCESS) goto error_return; break; case IDA_SV: NV_abstolQB = N_VClone(yQB); PutData(NV_abstolQB, VabstolQB, NqB); status = IDAQuadSVtolerancesB(ida_mem, idxB, reltolQB, NV_abstolQB); if (status != IDA_SUCCESS) goto error_return; N_VDestroy(NV_abstolQB); break; } } quadrB = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } static int IDM_CalcIC(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; double tout; int buflen, icopt; char *bufval; int status; fwdPb = idmData->fwdPb; /* Extract tout */ tout = (double) mxGetScalar(prhs[0]); /* Extract icopt */ icopt = -1; buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"FindAlgebraic")) { icopt = IDA_YA_YDP_INIT; } else if(!strcmp(bufval,"FindAll")) { icopt = IDA_Y_INIT; } else { idmErrHandler(-999, "IDAS", "IDACalcIC", "icopt has an illegal value.", NULL); goto error_return; } /* Call IDACalcIC */ status = IDACalcIC(ida_mem, icopt, tout); if (status < 0) goto error_return; /* IDACalcIC return flag */ plhs[0] = mxCreateDoubleScalar((double)status); if (nlhs == 1) return(0); /* Extract and return corrected IC */ status = IDAGetConsistentIC(ida_mem, yy, yp); if (status != IDA_SUCCESS) goto error_return; plhs[1] = mxCreateDoubleMatrix(N,1,mxREAL); GetData(yy, mxGetPr(plhs[1]), N); plhs[2] = mxCreateDoubleMatrix(N,1,mxREAL); GetData(yp, mxGetPr(plhs[2]), N); /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); if (nlhs > 1) { plhs[1] = mxCreateDoubleScalar((double)status); plhs[2] = mxCreateDoubleScalar((double)status); } return(-1); } static int IDM_CalcICB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { return(0); } static int IDM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; int buflen; char *bufval; int nlhs_needed, dims[3]; int itask, is, Ntout, itout, s_idx; double *tout, tret, h; double *tdata, *yydata, *yQdata, *yySdata; long int nst; int status, ida_status; fwdPb = idmData->fwdPb; /* Set index of output corresponding to FSA */ if (fsa) { s_idx = quadr ? 4 : 3; } /* * ---------------------------------------------------------------- * Verify if number of output arguments agrees with current options * ---------------------------------------------------------------- */ nlhs_needed = 3; if (quadr) nlhs_needed++; if (fsa) nlhs_needed++; if (nlhs < nlhs_needed) { idmErrHandler(-999, "IDAS", "IDASolve", "Too few output arguments.", NULL); goto error_return; } if (nlhs > nlhs_needed) { idmErrHandler(-999, "IDAS", "IDASolve", "Too many output arguments.", NULL); goto error_return; } /* * ---------------------------------------------------------------- * Extract input arguments * ---------------------------------------------------------------- */ /* Extract tout */ Ntout = mxGetM(prhs[0]) * mxGetN(prhs[0]); tout = mxGetPr(prhs[0]); /* If rootfinding or tstop are enabled, we do not allow multiple output times */ if (rootSet && (Ntout>1)) { idmErrHandler(-999, "IDAS", "IDASolve", "More than one tout value prohibited with rootfinding enabled.", NULL); goto error_return; } if (tstopSet && (Ntout>1)) { idmErrHandler(-999, "IDAS", "IDASolve", "More than one tout value prohibited with tstop enabled.", NULL); goto error_return; } /* Extract itask */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"Normal")) { itask = IDA_NORMAL; } else if(!strcmp(bufval,"OneStep")) { itask = IDA_ONE_STEP; } else { idmErrHandler(-999, "IDAS", "IDASolve", "Illegal value for itask.", NULL); goto error_return; } if (itask == IDA_ONE_STEP) { /* If itask==IDA_ONE_STEP, we do not allow multiple output times and we do not monitor */ if (Ntout>1) { idmErrHandler(-999, "IDAS", "IDASolve", "More than one tout value prohibited in ONE_STEP mode.", NULL); goto error_return; } if (mon) { idmErrHandler(+999, "IDAS", "IDASolve", "Monitoring disabled in ONE_STEP mode.", NULL); mon = FALSE; } } else { /* Check if tout values are legal */ status = IDAGetCurrentTime(ida_mem, &tret); if (status != IDA_SUCCESS) goto error_return; status = IDAGetNumSteps(ida_mem, &nst); if (status != IDA_SUCCESS) goto error_return; /* h is used throughout this function as integration direction only */ if (nst == 0) { h = tout[0] - tret; } else { IDAGetLastStep(ida_mem, &h); if ( (tout[0] - tret + h)*h < 0.0 ) { idmErrHandler(-999, "IDAS", "IDASolve", "Illegal value of tout.", NULL); goto error_return; } } for (itout=1; itout0) && ((tret - tout[itout])*h >= 0.0) ) { /* No need to take an additional step */ ida_status = IDA_SUCCESS; } else { /* Take additional steps */ while(1) { if (!asa) ida_status = IDASolve(ida_mem, tout[itout], &tret, yy, yp, IDA_ONE_STEP); else ida_status = IDASolveF(ida_mem, tout[itout], &tret, yy, yp, IDA_ONE_STEP, &Nc); if (ida_status < 0) goto error_return; /* Call the monitoring function */ if (quadr) { status = IDAGetQuad(ida_mem, &tret, yQ); if (status != IDA_SUCCESS) goto error_return; } if (fsa) { status = IDAGetSens(ida_mem, &tret, yyS); if (status != IDA_SUCCESS) goto error_return; } mxW_IDAMonitor(1, tret, yy, yQ, yyS, fwdPb); /* If a root was found or tstop was reached, break out of while loop */ if (ida_status == IDA_TSTOP_RETURN || ida_status == IDA_ROOT_RETURN) break; /* If current tout was reached break out of while loop */ if ( (tret - tout[itout])*h >= 0.0 ) break; } } /* On a tstop or root return, return solution at tret. * Otherwise (ida_status=IDA_SUCCESS), return solution at tout[itout]. */ if (ida_status == IDA_TSTOP_RETURN || ida_status == IDA_ROOT_RETURN) { if (quadr) { status = IDAGetQuad(ida_mem, &tret, yQ); if (status != IDA_SUCCESS) goto error_return; } if (fsa) { status = IDAGetSens(ida_mem, &tret, yyS); if (status != IDA_SUCCESS) goto error_return; } } else { tret = tout[itout]; status = IDAGetDky(ida_mem, tret, 0, yy); if (status != IDA_SUCCESS) goto error_return; if (quadr) { status = IDAGetQuadDky(ida_mem, tret, 0, yQ); if (status != IDA_SUCCESS) goto error_return; } if (fsa) { status = IDAGetSensDky(ida_mem, tret, 0, yyS); if (status != IDA_SUCCESS) goto error_return; } } tdata[itout] = tret; GetData(yy, &yydata[itout*N], N); if (quadr) { GetData(yQ, &yQdata[itout*Nq], Nq); } if (fsa) { for (is=0; isbckPb; while(bckPb != NULL) { if (quadrB) any_quadrB = TRUE; if (monB) any_monB = TRUE; bckPb = bckPb->next; } /* * ---------------------------------------------------------------- * Verify if number of output arguments agrees with current options * ---------------------------------------------------------------- */ nlhs_bad = 0; if (nlhs < 3) nlhs_bad = -1; if (nlhs > 4) nlhs_bad = 1; if ( (nlhs == 3) && any_quadrB ) nlhs_bad = -1; if (nlhs_bad < 0) { idmErrHandler(-999, "IDAS", "IDASolveB", "Too few output arguments.", NULL); goto error_return; } if (nlhs_bad > 0) { idmErrHandler(-999, "IDAS", "IDASolveB", "Too many output arguments.", NULL); goto error_return; } /* * ---------------------------------------------------------------- * Extract input arguments * ---------------------------------------------------------------- */ /* Extract tout */ NtoutB = mxGetM(prhs[0]) * mxGetN(prhs[0]); toutB = mxGetPr(prhs[0]); /* Check if first tout value is in the right direction */ status = IDAGetLastStep(ida_mem, &h); if (status != IDA_SUCCESS) goto error_return; status = IDAGetCurrentTime(ida_mem, &tret); if (status != IDA_SUCCESS) goto error_return; /* The stepsize of the forward problem is used to indicate the integration direction */ if ( (tret - toutB[0])*h < 0.0 ) { idmErrHandler(-999, "IDAS", "IDASolveB", "tout value in wrong direction.", NULL); goto error_return; } /* Extract itaskB */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"Normal")) { itaskB = IDA_NORMAL; } else if(!strcmp(bufval,"OneStep")) { itaskB = IDA_ONE_STEP; } else { idmErrHandler(-999, "IDAS", "IDASolveB", "Illegal value for itask.", NULL); goto error_return; } /* If itask == IDA_ONE_STEP, then * - we do not allow multiple output times * - we disable monitoring */ if ( itaskB == IDA_ONE_STEP ) { if (NtoutB > 1) { idmErrHandler(-999, "IDAS", "IDASolveB", "More than one tout value prohibited in ONE_STEP mode.", NULL); goto error_return; } if (any_monB) { idmErrHandler(+999, "IDAS", "IDASolveB", "Monitoring disabled in itask=ONE_STEP", NULL); bckPb = idmData->bckPb; while(bckPb != NULL) { monB = FALSE; bckPb = bckPb->next; } any_monB = FALSE; } } /* Call the appropriate function to do all the work. * Note: if we made it here, we rely on the functions idmSolveB_one and idmSolveB_more * to set the output arrays in plhs appropriately. */ if (NbckPb == 1) ida_status = idmSolveB_one(plhs, NtoutB, toutB, itaskB); else ida_status = idmSolveB_more(plhs, NtoutB, toutB, itaskB, any_quadrB, any_monB); if (ida_status < 0) return(-1); else return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } return(-1); } static int idmSolveB_one(mxArray *plhs[], int NtoutB, double *toutB, int itaskB) { idmPbData bckPb; void *ida_memB; double tretB, hB; double *tdata, *ydata, *yQdata; int itout; long int nstB; int status, ida_status; bckPb = idmData->bckPb; ida_memB = IDAGetAdjIDABmem(ida_mem, indexB); /* Check if tout values are legal */ status = IDAGetCurrentTime(ida_memB, &tretB); if (status != IDA_SUCCESS) goto error_return; status = IDAGetNumSteps(ida_memB, &nstB); if (status != IDA_SUCCESS) goto error_return; /* hB is used throughout this function as integration direction only */ if (nstB == 0) { hB = toutB[0] - tretB; } else { status = IDAGetLastStep(ida_memB, &hB); if (status != IDA_SUCCESS) goto error_return; if ( (toutB[0] - tretB + hB)*hB < 0.0 ) { idmErrHandler(-999, "IDAS", "IDASolveB", "Illegal value of tout.", NULL); goto error_return; } } for (itout=1; itout0) && ((tretB - toutB[itout])*hB >= 0.0) ) { /* No need to take an additional step */ ida_status = IDA_SUCCESS; } else { /* Take additional steps */ while(1) { ida_status = IDASolveB(ida_mem, toutB[itout], IDA_ONE_STEP); if (ida_status < 0) goto error_return; /* Call the monitoring function */ status = IDAGetB(ida_mem, indexB, &tretB, yyB, ypB); if (status != IDA_SUCCESS) goto error_return; if (quadrB) { status = IDAGetQuadB(ida_mem, indexB, &tretB, yQB); if (status != IDA_SUCCESS) goto error_return; } mxW_IDAMonitorB(1, indexB, tretB, yyB, yQB, bckPb); /* If current tout was reached break out of while loop */ if ( (tretB - toutB[itout])*hB >= 0.0 ) break; } } tretB = toutB[itout]; tdata[itout] = tretB; status = IDAGetDky(ida_memB, tretB, 0, yyB); if (status != IDA_SUCCESS) goto error_return; GetData(yyB, &ydata[itout*NB], NB); if (quadrB) { status = IDAGetQuadDky(ida_memB, tretB, 0, yQB); if (status != IDA_SUCCESS) goto error_return; GetData(yQB, &yQdata[itout*NqB], NqB); } } } /* IDASolve return flag (only non-negative values make it here) */ plhs[0] = mxCreateDoubleScalar((double)ida_status); return(0); error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } return(-1); } static int idmSolveB_more(mxArray *plhs[], int NtoutB, double *toutB, int itaskB, booleantype any_quadrB, booleantype any_monB) { idmPbData bckPb; mxArray *cell; int status, ida_status; idmErrHandler(-999, "IDAS", "IDASolveB", "Integration of multiple backward problems is not yet implemented.", NULL); goto error_return; plhs[0] = mxCreateDoubleScalar((double)ida_status); return(0); error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); /* plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } */ return(-1); } static int IDM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; const char *fnames_intgr[]={ "nst", "nfe", "nge", "nsetups", "netf", "nni", "ncfn", "qlast", "qcur", "h0used", "hlast", "hcur", "tcur", "RootInfo", "QuadInfo", "LSInfo", "FSAInfo" }; const char *fnames_root[]={ "nge", "roots" }; const char *fnames_dense[]={ "name", "njeD", "nfeD" }; const char *fnames_band[]={ "name", "njeB", "nfeB" }; const char *fnames_spils[]={ "name", "nli", "npe", "nps", "ncfl", "njeSG", "nfeSG" }; const char *fnames_quad[]={ "nfQe", "netfQ" }; const char *fnames_sens[]={ "nrSe", "nfeS", "nsetupsS", "netfS", "nniS", "ncfnS", }; long int nst, nfe, nsetups, nni, ncfn, netf, nge; int qlast, qcur; double h0used, hlast, hcur, tcur; int *rootsfound; long int njeD, nfeD; long int njeB, nfeB; long int nli, npe, nps, ncfl, njeSG, nfeSG; long int nfQe, netfQ; long int nrSe, nfeS, netfS, nsetupsS; long int nniS, ncfnS; int i, status; mxArray *mxS_root, *mxS_ls, *mxS_quad, *mxS_fsa; mxArray *mxS_rootsfound; double *tmp; int nfields; if (idmData == NULL) return(0); fwdPb = idmData->fwdPb; status = IDAGetIntegratorStats(ida_mem, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0used, &hlast, &hcur, &tcur); if (status != IDA_SUCCESS) goto error_return; status = IDAGetNonlinSolvStats(ida_mem, &nni, &ncfn); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_intgr)/sizeof(*fnames_intgr); plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_intgr); mxSetField(plhs[0], 0, "nst", mxCreateDoubleScalar((double)nst)); mxSetField(plhs[0], 0, "nfe", mxCreateDoubleScalar((double)nfe)); mxSetField(plhs[0], 0, "nsetups", mxCreateDoubleScalar((double)nsetups)); mxSetField(plhs[0], 0, "netf", mxCreateDoubleScalar((double)netf)); mxSetField(plhs[0], 0, "nni", mxCreateDoubleScalar((double)nni)); mxSetField(plhs[0], 0, "ncfn", mxCreateDoubleScalar((double)ncfn)); mxSetField(plhs[0], 0, "qlast", mxCreateDoubleScalar((double)qlast)); mxSetField(plhs[0], 0, "qcur", mxCreateDoubleScalar((double)qcur)); mxSetField(plhs[0], 0, "h0used", mxCreateDoubleScalar(h0used)); mxSetField(plhs[0], 0, "hlast", mxCreateDoubleScalar(hlast)); mxSetField(plhs[0], 0, "hcur", mxCreateDoubleScalar(hcur)); mxSetField(plhs[0], 0, "tcur", mxCreateDoubleScalar(tcur)); /* Root Finding Statistics */ if (Ng > 0) { status = IDAGetNumGEvals(ida_mem, &nge); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_root)/sizeof(*fnames_root); mxS_root = mxCreateStructMatrix(1, 1, nfields, fnames_root); mxSetField(mxS_root, 0, "nge", mxCreateDoubleScalar((double)nge)); rootsfound = (int *) malloc(Ng*sizeof(int)); status = IDAGetRootInfo(ida_mem, rootsfound); if (status != IDA_SUCCESS) goto error_return; mxS_rootsfound = mxCreateDoubleMatrix(Ng,1,mxREAL); tmp = mxGetPr(mxS_rootsfound); for (i=0;ibckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) idmErrHandler(-999, "IDAS", "IDAGetStatsB", "idxB has an illegal value.", NULL); ida_memB = IDAGetAdjIDABmem(ida_mem, indexB); status = IDAGetIntegratorStats(ida_memB, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0used, &hlast, &hcur, &tcur); if (status != IDA_SUCCESS) goto error_return; status = IDAGetNonlinSolvStats(ida_memB, &nni, &ncfn); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_intgr)/sizeof(*fnames_intgr); plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_intgr); mxSetField(plhs[0], 0, "nst", mxCreateDoubleScalar((double)nst)); mxSetField(plhs[0], 0, "nfe", mxCreateDoubleScalar((double)nfe)); mxSetField(plhs[0], 0, "nsetups", mxCreateDoubleScalar((double)nsetups)); mxSetField(plhs[0], 0, "netf", mxCreateDoubleScalar((double)netf)); mxSetField(plhs[0], 0, "nni", mxCreateDoubleScalar((double)nni)); mxSetField(plhs[0], 0, "ncfn", mxCreateDoubleScalar((double)ncfn)); mxSetField(plhs[0], 0, "qlast", mxCreateDoubleScalar((double)qlast)); mxSetField(plhs[0], 0, "qcur", mxCreateDoubleScalar((double)qcur)); mxSetField(plhs[0], 0, "h0used", mxCreateDoubleScalar(h0used)); mxSetField(plhs[0], 0, "hlast", mxCreateDoubleScalar(hlast)); mxSetField(plhs[0], 0, "hcur", mxCreateDoubleScalar(hcur)); mxSetField(plhs[0], 0, "tcur", mxCreateDoubleScalar(tcur)); /* Quadrature Statistics */ if (quadrB) { status = IDAGetQuadStats(ida_memB, &nfQe, &netfQ); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_quad)/sizeof(*fnames_quad); mxS_quad = mxCreateStructMatrix(1, 1, nfields, fnames_quad); mxSetField(mxS_quad, 0, "nfQe", mxCreateDoubleScalar((double)nfQe)); mxSetField(mxS_quad, 0, "netfQ", mxCreateDoubleScalar((double)netfQ)); } else { mxS_quad = mxCreateDoubleMatrix(0,0,mxREAL); } mxSetField(plhs[0], 0, "QuadInfo", mxS_quad); /* Linear Solver Statistics */ switch(lsB){ case LS_DENSE: status = IDADlsGetNumJacEvals(ida_memB, &njeD); if (status != IDA_SUCCESS) goto error_return; status = IDADlsGetNumResEvals(ida_memB, &nfeD); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_dense)/sizeof(*fnames_dense); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_dense); mxSetField(mxS_ls, 0, "name", mxCreateString("Dense")); mxSetField(mxS_ls, 0, "njeD", mxCreateDoubleScalar((double)njeD)); mxSetField(mxS_ls, 0, "nfeD", mxCreateDoubleScalar((double)nfeD)); break; case LS_BAND: status = IDADlsGetNumJacEvals(ida_memB, &njeB); if (status != IDA_SUCCESS) goto error_return; status = IDADlsGetNumResEvals(ida_memB, &nfeB); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_band)/sizeof(*fnames_band); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_band); mxSetField(mxS_ls, 0, "name", mxCreateString("Band")); mxSetField(mxS_ls, 0, "njeB", mxCreateDoubleScalar((double)njeB)); mxSetField(mxS_ls, 0, "nfeB", mxCreateDoubleScalar((double)nfeB)); break; case LS_SPGMR: case LS_SPBCG: case LS_SPTFQMR: status = IDASpilsGetNumLinIters(ida_memB, &nli); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsGetNumPrecEvals(ida_memB, &npe); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsGetNumPrecSolves(ida_memB, &nps); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsGetNumConvFails(ida_memB, &ncfl); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsGetNumJtimesEvals(ida_memB, &njeSG); if (status != IDA_SUCCESS) goto error_return; status = IDASpilsGetNumResEvals(ida_memB, &nfeSG); if (status != IDA_SUCCESS) goto error_return; nfields = sizeof(fnames_spils)/sizeof(*fnames_spils); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_spils); if (lsB == LS_SPGMR) mxSetField(mxS_ls, 0, "name", mxCreateString("GMRES")); else if (lsB == LS_SPBCG) mxSetField(mxS_ls, 0, "name", mxCreateString("BiCGStab")); else mxSetField(mxS_ls, 0, "name", mxCreateString("TFQMR")); mxSetField(mxS_ls, 0, "nli", mxCreateDoubleScalar((double)nli)); mxSetField(mxS_ls, 0, "npe", mxCreateDoubleScalar((double)npe)); mxSetField(mxS_ls, 0, "nps", mxCreateDoubleScalar((double)nps)); mxSetField(mxS_ls, 0, "ncfl", mxCreateDoubleScalar((double)ncfl)); mxSetField(mxS_ls, 0, "njeSG", mxCreateDoubleScalar((double)njeSG)); mxSetField(mxS_ls, 0, "nfeSG", mxCreateDoubleScalar((double)nfeSG)); break; } mxSetField(plhs[0], 0, "LSInfo", mxS_ls); /* Successful return */ status = 0; plhs[1] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[1] = mxCreateDoubleScalar((double)status); return(-1); } static int IDM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; const mxArray *options; mxArray *opt; double tstop; int status; fwdPb = idmData->fwdPb; options = prhs[0]; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* User data */ opt = mxGetField(options,0,"UserData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_data); mtlb_data = mxDuplicateArray(opt); } /* Stopping time */ opt = mxGetField(options,0,"StopTime"); if ( !mxIsEmpty(opt) ) { tstop = (double)mxGetScalar(opt); status = IDASetStopTime(ida_mem, tstop); if (status != IDA_SUCCESS) goto error_return; } /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } static int IDM_SetB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { return(0); } static int IDM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb; double t; N_Vector ewt; double *this, *next; int key, k, i, nfields; IDAadjCheckPointRec *ckpnt; const char *fnames_ckpnt[]={ "t0", "t1", "nstep", "order", "step" }; int status; fwdPb = idmData->fwdPb; key = (int) (*mxGetPr(prhs[0])); switch (key) { case 1: /* DerivSolution */ t = *mxGetPr(prhs[1]); k = (int) (*mxGetPr(prhs[2])); plhs[0] = mxCreateDoubleMatrix(N,1,mxREAL); status = IDAGetDky(ida_mem, t, k, yy); if (status != IDA_SUCCESS) goto error_return; GetData(yy, mxGetPr(plhs[0]), N); break; case 2: /* ErrorWeights */ ewt = N_VClone(yy); plhs[0] = mxCreateDoubleMatrix(N,1,mxREAL); status = IDAGetErrWeights(ida_mem, ewt); if (status != IDA_SUCCESS) goto error_return; GetData(ewt, mxGetPr(plhs[0]), N); N_VDestroy(ewt); break; case 3: /* not used */ break; case 4: /* CheckPointsInfo */ ckpnt = (IDAadjCheckPointRec *) malloc ( (Nc+1)*sizeof(IDAadjCheckPointRec)); status = IDAGetAdjCheckPointsInfo(ida_mem, ckpnt); if (status != IDA_SUCCESS) { free(ckpnt); goto error_return; } nfields = sizeof(fnames_ckpnt)/sizeof(*fnames_ckpnt); plhs[0] = mxCreateStructMatrix(Nc+1, 1, nfields, fnames_ckpnt); for (i=0; i<=Nc; i++) { this = (double *)(ckpnt[Nc-i].my_addr); next = (double *)(ckpnt[Nc-i].next_addr); mxSetField(plhs[0], i, "t0", mxCreateDoubleScalar((double)(ckpnt[Nc-i].t0))); mxSetField(plhs[0], i, "t1", mxCreateDoubleScalar((double)(ckpnt[Nc-i].t1))); mxSetField(plhs[0], i, "nstep", mxCreateDoubleScalar((double)(ckpnt[Nc-i].nstep))); mxSetField(plhs[0], i, "order", mxCreateDoubleScalar((double)(ckpnt[Nc-i].order))); mxSetField(plhs[0], i, "step", mxCreateDoubleScalar((double)(ckpnt[Nc-i].step))); } free(ckpnt); break; } /* Successful return */ status = 0; plhs[1] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[1] = mxCreateDoubleScalar((double)status); return(-1); } static int IDM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { idmPbData fwdPb, bckPb; if (idmData == NULL) return(0); fwdPb = idmData->fwdPb; if (mon) mxW_IDAMonitor(2, 0.0, NULL, NULL, NULL, fwdPb); bckPb = idmData->bckPb; while (bckPb != NULL) { if (monB) mxW_IDAMonitorB(2, indexB, 0.0, NULL, NULL, bckPb); bckPb = bckPb->next; } IDAFree(&ida_mem); return(0); } sundials-2.5.0/sundialsTB/idas/idm/src/idmOpts.c0000600000175000017500000005530511741421121022327 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2012/03/07 21:49:18 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/idas/LICENSE. * ----------------------------------------------------------------- * Option parsing functions for the IDAS Matlab interface. * ----------------------------------------------------------------- */ #include #include "idm.h" /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define N (thisPb->n) #define Ns (thisPb->ns) #define Ng (thisPb->ng) #define ls (thisPb->LS) #define pm (thisPb->PM) #define mtlb_data (thisPb->mtlb_data) #define mtlb_JACfct (thisPb->JACfct) #define mtlb_PSETfct (thisPb->PSETfct) #define mtlb_PSOLfct (thisPb->PSOLfct) #define mtlb_GLOCfct (thisPb->GLOCfct) #define mtlb_GCOMfct (thisPb->GCOMfct) #define mtlb_Gfct (thisPb->Gfct) #define mon (thisPb->Mon) #define tstopSet (thisPb->TstopSet) #define mtlb_MONfct (thisPb->MONfct) #define mtlb_MONdata (thisPb->MONdata) /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_IntgrOptions(const mxArray *options, idmPbData thisPb, booleantype fwd, int *maxord, long int *mxsteps, int *itol, realtype *reltol, double *Sabstol, double **Vabstol, double *hin, double *hmax, double *tstop, booleantype *suppress, booleantype *errmsg, double **id, double **cnstr, booleantype *res_s) { mxArray *opt; char *bufval; int buflen, status, q; long int i, m, n; double *tmp; char *fctName; char *fwd_fctName = "IDAInit/IDAReInit"; char *bck_fctName = "IDAInitB/IDAReInitB"; if (fwd) fctName = fwd_fctName; else fctName = bck_fctName; /* Set default values */ *maxord = 5; *mxsteps = 0; *itol = IDA_SS; *reltol = 1.0e-3; *Sabstol = 1.0e-6; *Vabstol = NULL; *hin = 0.0; *hmax = 0.0; *res_s = FALSE; *suppress = FALSE; *id = NULL; *cnstr = NULL; Ng = 0; tstopSet = FALSE; mon = FALSE; *errmsg = TRUE; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* User data */ opt = mxGetField(options,0,"UserData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_data); mtlb_data = mxDuplicateArray(opt); } /* Tolerances */ opt = mxGetField(options,0,"RelTol"); if ( !mxIsEmpty(opt) ) { *reltol = *mxGetPr(opt); if (*reltol < 0.0 ) { idmErrHandler(-999, "IDAS", fctName, "RelTol is negative.", NULL); return(-1); } } opt = mxGetField(options,0,"AbsTol"); if ( !mxIsEmpty(opt) ) { m = mxGetM(opt); n = mxGetN(opt); if ( (n != 1) && (m != 1) ) { idmErrHandler(-999, "IDAS", fctName, "AbsTol is not a scalar or a vector.", NULL); return(-1); } if ( m > n ) n = m; tmp = mxGetPr(opt); if (n == 1) { *itol = IDA_SS; *Sabstol = *tmp; if (*Sabstol < 0.0) { idmErrHandler(-999, "IDAS", fctName, "AbsTol is negative.", NULL); return(-1); } } else if (n == N) { *itol = IDA_SV; *Vabstol = (double *) malloc(N*sizeof(double)); for(i=0;i *maxord) { idmErrHandler(-999, "IDAS", fctName, "MaxOrder is too large for BDF.", NULL); return(-1); } *maxord = q; } /* Initial step size */ opt = mxGetField(options,0,"InitialStep"); if ( !mxIsEmpty(opt) ) { *hin = *mxGetPr(opt); } /* Maximum step size */ opt = mxGetField(options,0,"MaxStep"); if ( !mxIsEmpty(opt) ) { tmp = mxGetPr(opt); if (*tmp < 0.0) { idmErrHandler(-999, "IDAS", fctName, "MaxStep is negative.", NULL); return(-1); } if ( mxIsInf(*tmp) ) *hmax = 0.0; else *hmax = *tmp; } /* ID vector */ opt = mxGetField(options,0,"VariableTypes"); if ( !mxIsEmpty(opt) ) { m = mxGetM(opt); n = mxGetN(opt); if ( (n != 1) && (m != 1) ) { idmErrHandler(-999, "IDAS", fctName, "VariableTypes is not a vector.", NULL); return(-1); } if ( m > n ) n = m; if (n == N) { tmp = mxGetPr(opt); *id = (double *)malloc(N*sizeof(double)); for(i=0;i 0) { /* Roots function */ opt = mxGetField(options,0,"RootsFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_Gfct); mtlb_Gfct = mxDuplicateArray(opt); } else { idmErrHandler(-999, "IDAS", fctName, "RootsFn required for NumRoots > 0", NULL); return(-1); } } } /* Constraints vector */ opt = mxGetField(options,0,"ConstraintTypes"); if ( !mxIsEmpty(opt) ) { m = mxGetM(opt); n = mxGetN(opt); if ( (n != 1) && (m != 1) ) { idmErrHandler(-999, "IDAS", fctName, "ConstraintTypes is not a vector.", NULL); return(-1); } if ( m > n ) n = m; if (n == N) { tmp = mxGetPr(opt); *cnstr = (double *)malloc(N*sizeof(double)); for(i=0;i n ) n = m; tmp = mxGetPr(opt); if (n == 1) { *itolQ = IDA_SS; *SabstolQ = *tmp; if (*SabstolQ < 0.0) { idmErrHandler(-999, "IDAS", fctName, "AbsTol is negative.", NULL); return(-1); } } else if (n == Nq) { *itolQ = IDA_SV; *VabstolQ = (double *)malloc(Nq*sizeof(double)); for(i=0;i n) n = m; if ( n != Ns) { idmErrHandler(-999, "IDAS", "IDASensInit/IDASensReInit", "ParamList does not contain Ns elements.", NULL); return(-1); } *plist = (int *) malloc(Ns*sizeof(int)); for (is=0;is n ) n = m; if ( n != Ns) { idmErrHandler(-999, "IDAS", "IDASensInit/IDASensReInit", "ParamScales does not contain Ns elements.", NULL); return(-1); } tmp = mxGetPr(opt); *pbar = (double *) malloc(Ns*sizeof(double)); for(i=0;iFsa) #define quadr (fwdPb->Quadr) #define N (fwdPb->n) #define Nq (fwdPb->nq) #define Ng (fwdPb->ng) #define Ns (fwdPb->ns) #define quadrB (bckPb->Quadr) #define NB (bckPb->n) #define NqB (bckPb->nq) /* * --------------------------------------------------------------------------------- * Wrapper functions * --------------------------------------------------------------------------------- */ int mxW_IDARes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { idmPbData fwdPb; mxArray *mx_in[5], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = fwdPb->RESfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"idm_res"); PutData(rr, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDAQuadFct(realtype tres, N_Vector yy, N_Vector yp, N_Vector ypQ, void *user_data) { idmPbData fwdPb; mxArray *mx_in[5], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tres); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = fwdPb->QUADfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"idm_rhsQ"); PutData(ypQ, mxGetPr(mx_out[0]), Nq); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDAGfct(realtype t, N_Vector yy, N_Vector yp, realtype *gout, void *user_data) { idmPbData fwdPb; double *gdata; int i, ret; mxArray *mx_in[5], *mx_out[3]; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = fwdPb->Gfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"idm_root"); gdata = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[6] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); mexCallMATLAB(3,mx_out,7,mx_in,"idm_djac"); /* Extract data */ J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[6] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); mexCallMATLAB(3,mx_out,7,mx_in,"idm_bjac"); /* Extract data */ eband = mupper + mlower + 1; J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[7] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); GetData(v, mxGetPr(mx_in[4]), N); mexCallMATLAB(3,mx_out,8,mx_in,"idm_jtv"); PutData(Jv, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDASpilsPset(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { idmPbData fwdPb; mxArray *mx_in[7], *mx_out[2]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current rr */ mx_in[4] = mxCreateLogicalScalar(c_j); /* current c_j */ mx_in[5] = fwdPb->PSETfct; /* matlab function handle */ mx_in[6] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); mexCallMATLAB(2,mx_out,7,mx_in,"idm_pset"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } int mxW_IDASpilsPsol(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { idmPbData fwdPb; mxArray *mx_in[8], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current rr */ mx_in[4] = mxCreateDoubleMatrix(N,1,mxREAL); /* right hand side r */ mx_in[5] = mxCreateDoubleScalar(c_j); /* current c_j */ mx_in[6] = fwdPb->PSOLfct; /* matlab function handle */ mx_in[7] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); GetData(rvec, mxGetPr(mx_in[4]), N); mexCallMATLAB(3,mx_out,8,mx_in,"idm_psol"); PutData(zvec, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } /* * ---------------------------- * BBD PRECONDITONER FUNCTIONS * ---------------------------- */ int mxW_IDABBDgloc(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data) { idmPbData fwdPb; mxArray *mx_in[5], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = fwdPb->GLOCfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"idm_gloc"); PutData(gval, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDABBDgcom(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, void *user_data) { idmPbData fwdPb; mxArray *mx_in[5], *mx_out[2]; int ret; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = fwdPb->GCOMfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); mexCallMATLAB(2,mx_out,5,mx_in,"idm_gcom"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } /* * ---------------------------- * FORWARD SENSITVITY FUNCTIONS * ---------------------------- */ int mxW_IDASensRes(int Nsens, realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector *yyS, N_Vector *ypS, N_Vector *rrS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { idmPbData fwdPb; mxArray *mx_in[9], *mx_out[3]; int is, ret; double *tmp_yyS, *tmp_ypS, *tmp_rrS; /* Extract global interface data from user-data */ fwdPb = (idmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tres); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current rr */ mx_in[4] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[5] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yyS */ mx_in[6] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current ypS */ mx_in[7] = fwdPb->SRESfct; /* matlab function handle */ mx_in[8] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(rr, mxGetPr(mx_in[3]), N); tmp_yyS = mxGetPr(mx_in[5]); tmp_ypS = mxGetPr(mx_in[6]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(0.0); /* type=0: not dependent on yS */ mx_in[1] = mxCreateDoubleScalar(tt); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[6] = bckPb->RESfct; /* matlab function handle */ mx_in[7] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[2]), N); GetData(yp, mxGetPr(mx_in[3]), N); GetData(yyB, mxGetPr(mx_in[4]), NB); GetData(ypB, mxGetPr(mx_in[5]), NB); mexCallMATLAB(3,mx_out,8,mx_in,"idm_resB"); PutData(rrB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDAResBS(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB) { idmPbData fwdPb, bckPb; mxArray *mx_in[11], *mx_out[3]; double *tmp_yyS, *tmp_ypS; int is, ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(1.0); /* type=1: dependent on yS */ mx_in[1] = mxCreateDoubleScalar(tt); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[4] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[5] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yyS */ mx_in[6] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current ypS */ mx_in[7] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[8] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[9] = bckPb->RESfct; /* matlab function handle */ mx_in[10] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[2]), N); GetData(yp, mxGetPr(mx_in[3]), N); tmp_yyS = mxGetPr(mx_in[5]); tmp_ypS = mxGetPr(mx_in[6]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(0.0); /* type=0: not dependent on yS */ mx_in[1] = mxCreateDoubleScalar(tt); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[6] = bckPb->QUADfct; /* matlab function handle */ mx_in[7] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[2]), N); GetData(yp, mxGetPr(mx_in[3]), N); GetData(yyB, mxGetPr(mx_in[4]), NB); GetData(ypB, mxGetPr(mx_in[5]), NB); mexCallMATLAB(3,mx_out,8,mx_in,"idm_rhsQB"); PutData(ypQB, mxGetPr(mx_out[0]), NqB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDAQuadFctBS(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector ypQB, void *user_dataB) { idmPbData fwdPb, bckPb; mxArray *mx_in[11], *mx_out[3]; double *tmp_yyS, *tmp_ypS; int is, ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(1.0); /* type=1: dependent on yS */ mx_in[1] = mxCreateDoubleScalar(tt); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[4] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[5] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yyS */ mx_in[6] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current ypS */ mx_in[7] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[8] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[9] = bckPb->QUADfct; /* matlab function handle */ mx_in[10] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[2]), N); GetData(yp, mxGetPr(mx_in[3]), N); tmp_yyS = mxGetPr(mx_in[5]); tmp_ypS = mxGetPr(mx_in[6]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current rrB */ mx_in[6] = mxCreateDoubleScalar(c_jB); /* current c_jB */ mx_in[7] = bckPb->JACfct; /* matlab function handle */ mx_in[8] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); GetData(rrB, mxGetPr(mx_in[5]), NB); mexCallMATLAB(3,mx_out,9,mx_in,"idm_djacB"); JB_data = mxGetPr(mx_out[0]); for (i=0;ifwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current rrB */ mx_in[6] = mxCreateDoubleScalar(c_jB); /* current c_jB */ mx_in[7] = bckPb->JACfct; /* matlab function handle */ mx_in[8] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); GetData(rrB, mxGetPr(mx_in[5]), NB); mexCallMATLAB(3,mx_out,9,mx_in,"idm_bjacB"); ebandB = mupperB + mlowerB + 1; JB_data = mxGetPr(mx_out[0]); for (i=0;ifwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current rrB */ mx_in[6] = mxCreateDoubleMatrix(NB,1,mxREAL); /* vector vB */ mx_in[7] = mxCreateDoubleScalar(c_jB); /* current c_jB */ mx_in[8] = bckPb->JACfct; /* matlab function handle */ mx_in[9] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); GetData(rrB, mxGetPr(mx_in[5]), NB); GetData(vB, mxGetPr(mx_in[6]), NB); mexCallMATLAB(3,mx_out,10,mx_in,"idm_jtvB"); PutData(JvB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_in[6]); mxDestroyArray(mx_in[7]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDASpilsPsetB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { idmPbData fwdPb, bckPb; mxArray *mx_in[9], *mx_out[2]; int ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current rrB */ mx_in[6] = mxCreateDoubleScalar(c_jB); /* current c_jB */ mx_in[7] = bckPb->PSETfct; /* matlab function handle */ mx_in[8] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); GetData(rrB, mxGetPr(mx_in[5]), NB); mexCallMATLAB(2,mx_out,9,mx_in,"idm_psetB"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_in[6]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } int mxW_IDASpilsPsolB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *user_dataB, N_Vector tmpB) { idmPbData fwdPb, bckPb; mxArray *mx_in[10], *mx_out[3]; int ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current rrB */ mx_in[6] = mxCreateDoubleMatrix(NB,1,mxREAL); /* right hand side rB */ mx_in[7] = mxCreateDoubleScalar(c_jB); /* current c_jB */ mx_in[8] = bckPb->PSOLfct; /* matlab function handle */ mx_in[9] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); GetData(rrB, mxGetPr(mx_in[5]), NB); GetData(rvecB, mxGetPr(mx_in[6]), NB); mexCallMATLAB(3,mx_out,10,mx_in,"idm_psolB"); PutData(zvecB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_in[6]); mxDestroyArray(mx_in[7]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDABBDglocB(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB) { idmPbData fwdPb, bckPb; mxArray *mx_in[7], *mx_out[3]; int ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = bckPb->GLOCfct; /* matlab function handle */ mx_in[6] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); mexCallMATLAB(3,mx_out,7,mx_in,"idm_glocB"); PutData(gvalB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_IDABBDgcomB(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, void *user_dataB) { idmPbData fwdPb, bckPb; mxArray *mx_in[7], *mx_out[2]; int ret; /* Extract global interface data from user-data */ bckPb = (idmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(tt); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yp */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current ypB */ mx_in[5] = bckPb->GCOMfct; /* matlab function handle */ mx_in[6] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(yy, mxGetPr(mx_in[1]), N); GetData(yp, mxGetPr(mx_in[2]), N); GetData(yyB, mxGetPr(mx_in[3]), NB); GetData(ypB, mxGetPr(mx_in[4]), NB); mexCallMATLAB(2,mx_out,7,mx_in,"idm_gcomB"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } /* * --------------------------------------------------------------------------------- * Wrapper around matlab monitor function * --------------------------------------------------------------------------------- */ void mxW_IDAMonitor(int call, double t, N_Vector yy, N_Vector yQ, N_Vector *yyS, idmPbData fwdPb) { mxArray *mx_in[8], *mx_out[1]; double *tmp_yyS; int is; mx_in[0] = mxCreateDoubleScalar(call); /* call type (0:first, 1:interm. 2:last) */ mx_in[1] = mxCreateDoubleScalar(t); /* current time */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yy */ if (quadr) { mx_in[3] = mxCreateDoubleMatrix(Nq,1,mxREAL); /* current quadratures */ } else { mx_in[3] = mxCreateDoubleMatrix(0,0,mxREAL); } mx_in[4] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ if (fsa) { mx_in[5] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yyS */ } else { mx_in[5] = mxCreateDoubleMatrix(0,0,mxREAL); } mx_in[6] = fwdPb->MONfct; /* Matlab monitor function */ mx_in[7] = fwdPb->MONdata; /* data for monitor function */ if (call == 1) { GetData(yy, mxGetPr(mx_in[2]), N); if (quadr) { GetData(yQ, mxGetPr(mx_in[3]), Nq); } if (fsa) { tmp_yyS = mxGetPr(mx_in[5]); for (is=0; isMONfct; mx_in[6] = bckPb->MONdata; if (call == 1) { GetData(yyB, mxGetPr(mx_in[3]), NB); if (quadrB) GetData(yQB, mxGetPr(mx_in[4]), NqB); } mexCallMATLAB(1,mx_out,7,mx_in,"idm_monitorB"); if (!mxIsEmpty(mx_out[0])) { UpdateMonitorData(mx_out[0], bckPb); } mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); } /* * --------------------------------------------------------------------------------- * Private functions to update the user data structures * --------------------------------------------------------------------------------- */ static void UpdateUserData(mxArray *new_mtlb_data, idmPbData pb) { mexUnlock(); mxDestroyArray(pb->mtlb_data); pb->mtlb_data = mxDuplicateArray(new_mtlb_data); mexMakeArrayPersistent(pb->mtlb_data); mexLock(); } static void UpdateMonitorData(mxArray *new_mtlb_data, idmPbData pb) { mexUnlock(); mxDestroyArray(pb->MONdata); pb->MONdata = mxDuplicateArray(new_mtlb_data); mexMakeArrayPersistent(pb->MONdata); mexLock(); } sundials-2.5.0/sundialsTB/idas/idm/src/idm.h0000600000175000017500000002536711741421121021473 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2012/03/07 21:49:18 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/idas/LICENSE. * ----------------------------------------------------------------- * Header file for the IDAS Matlab interface. * ----------------------------------------------------------------- */ #ifndef _IDM_H #define _IDM_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include "mex.h" #include #include #include #include #include #include #include /* * --------------------------------------------------------------------------------- * Constants * --------------------------------------------------------------------------------- */ /* Tolerance types */ enum {IDA_SS, IDA_SV, IDA_EE}; /* Linear solver types */ enum {LS_DENSE, LS_BAND, LS_SPGMR, LS_SPBCG, LS_SPTFQMR}; /* Preconditioner modules */ enum {PM_NONE, PM_BBDPRE}; /* * --------------------------------------------------------------------------------- * Types for global data structures * --------------------------------------------------------------------------------- */ typedef struct idmPbData_ { long int n; /* problem dimension */ N_Vector YY; /* solution vector */ N_Vector YP; /* derivative of solution vector */ booleantype Quadr; /* integrate quadratures? */ long int nq; /* number of quadratures */ N_Vector YQ; /* quadratures vector */ booleantype Fsa; /* integrate sensitivities? */ int ns; /* number of sensitivities */ N_Vector *YYS; /* sensitivity vectors */ N_Vector *YPS; /* derivatives of sensitivity vectors */ booleantype RootSet; /* rootfinding active? */ int ng; /* number of root functions */ booleantype TstopSet; /* tstop active? */ int LS; /* linear solver type */ int PM; /* preconditioner module */ booleantype Mon; /* monitoring? */ /* Matlab functions and data associated with this problem */ mxArray *RESfct; mxArray *QUADfct; mxArray *JACfct; mxArray *PSETfct; mxArray *PSOLfct; mxArray *GLOCfct; mxArray *GCOMfct; mxArray *Gfct; mxArray *SRESfct; mxArray *MONfct; mxArray *MONdata; /* Pointer to the global Matlab user data */ mxArray *mtlb_data; /* Information for backward problems only */ struct idmPbData_ *fwd; int index; /* index of this problem */ struct idmPbData_ *next; /* pointer to next problem in linked list */ } *idmPbData; typedef struct idmInterfaceData_ { void *ida_mem; /* IDAS solver memory */ booleantype asa; /* Perform ASA? */ int Nd; /* number of data points */ int Nc; /* number of check points */ struct idmPbData_ *fwdPb; struct idmPbData_ *bckPb; int NbckPb; /* Number of backward problems in the linked list bckPb */ booleantype errMsg; /* post error/warning messages? */ } *idmInterfaceData; /* * --------------------------------------------------------------------------------- * Error handler function * --------------------------------------------------------------------------------- */ void idmErrHandler(int error_code, const char *module, const char *function, char *msg, void *eh_data); /* * --------------------------------------------------------------------------------- * Wrapper functions * --------------------------------------------------------------------------------- */ int mxW_IDARes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); int mxW_IDAGfct(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data); int mxW_IDAQuadFct(realtype tres, N_Vector yy, N_Vector yp, N_Vector ypQ, void *user_data); int mxW_IDASensRes(int Nsens, realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_IDADenseJac(long int Neq, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_IDABandJac(long int Neq, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_IDASpilsJac(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2); int mxW_IDASpilsPset(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_IDASpilsPsol(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); int mxW_IDABBDgloc(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); int mxW_IDABBDgcom(long int Nlocal, realtype tt, N_Vector yy, N_Vector yp, void *user_data); void mxW_IDAMonitor(int call, double t, N_Vector yy, N_Vector yQ, N_Vector *yyS, idmPbData fwdPb); int mxW_IDAResB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); int mxW_IDAResBS(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); int mxW_IDAQuadFctB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector ypQB, void *user_dataB); int mxW_IDAQuadFctBS(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector ypQB, void *user_dataB); int mxW_IDADenseJacB(long int NeqB, realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_IDABandJacB(long int NeqB, long int mupperB, long int mlowerB, realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_IDASpilsJacB(realtype t, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B); int mxW_IDASpilsPsetB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_IDASpilsPsolB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *user_dataB, N_Vector tmpB); int mxW_IDABBDglocB(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB); int mxW_IDABBDgcomB(long int NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, void *user_dataB); void mxW_IDAMonitorB(int call, int idxB, double tB, N_Vector yyB, N_Vector yQB, idmPbData bckPb); /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_IntgrOptions(const mxArray *options, idmPbData thisPb, booleantype fwd, int *maxord, long int *mxsteps, int *itol, realtype *reltol, double *Sabstol, double **Vabstol, double *hin, double *hmax, double *tstop, booleantype *suppress, booleantype *errmsg, double **id, double **cnstr, booleantype *res_s); int get_LinSolvOptions(const mxArray *options, idmPbData thisPb, booleantype fwd, long int *mupper, long int *mlower, long int *mudq, long int *mldq, double *dqrely, int *gstype, int *maxl); int get_QuadOptions(const mxArray *options, idmPbData thisPb, booleantype fwd, long int Nq, booleantype *rhs_s, booleantype *errconQ, int *itolQ, double *reltolQ, double *SabstolQ, double **VabstolQ); int get_FSAOptions(const mxArray *options, idmPbData thisPb, int *ism, char **pfield_name, int **plist, double **pbar, int *dqtype, double *rho, booleantype *errconS, int *itolS, double *reltolS, double **SabstolS, double **VabstolS); #ifdef __cplusplus } #endif #endif sundials-2.5.0/sundialsTB/idas/IDAGetStatsB.m0000600000175000017500000000442311741421121021533 0ustar sylvestresylvestrefunction [si, status] = IDAGetStatsB(idxB) %IDAGetStatsB returns run statistics for the backward IDAS solver. % % Usage: STATS = IDAGetStatsB(IDXB) % % IDXB is the index of the backward problem, returned by IDAInitB. % %Fields in the structure STATS % %o nst - number of integration steps %o nre - number of residual function evaluations %o nsetups - number of linear solver setup calls %o netf - number of error test failures %o nni - number of nonlinear solver iterations %o ncfn - number of convergence test failures %o qlast - last method order used %o qcur - current method order %o h0used - actual initial step size used %o hlast - last step size used %o hcur - current step size %o tcur - current time reached by the integrator %o QuadInfo - structure with quadrature integration statistics %o LSInfo - structure with linear solver statistics % %The structure LSinfo has different fields, depending on the linear solver used. % %If quadratures were present, the structure QuadInfo has the following fields % %o nfQe - number of quadrature integrand function evaluations %o netfQ - number of error test failures for quadrature variables % % Fields in LSinfo for the 'Dense' linear solver % %o name - 'Dense' %o njeD - number of Jacobian evaluations %o nreD - number of residual function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Band' linear solver % %o name - 'Band' %o njeB - number of Jacobian evaluations %o nreB - number of residual function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'GMRES' and 'BiCGStab' linear solvers % %o name - 'GMRES' or 'BiCGStab' %o nli - number of linear solver iterations %o npe - number of preconditioner setups %o nps - number of preconditioner solve function calls %o ncfl - number of linear system convergence test failures %o njeSG - number of Jacobian-vector product evaluations %o nreSG - number of residual function evaluations for difference-quotient % Jacobian-vector product approximation % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:18 $ mode = 31; if nargin ~= 1 error('Wrong number of input arguments'); end [si, status] = idm(mode, idxB-1); sundials-2.5.0/sundialsTB/idas/IDASetB.m0000600000175000017500000000264511741421121020534 0ustar sylvestresylvestrefunction status = IDASetB(idxB, varargin) %IDASetB changes optional input values during the integration. % % Usage: IDASetB( IDXB, 'NAME1',VALUE1,'NAME2',VALUE2,... ) % % IDASetB can be used to change some of the optional inputs for % the backward problem identified by IDXB during the backward % integration, i.e., without need for a solver reinitialization. % The property names accepted by IDASet are a subset of those valid % for IDASetOptions. Any unspecified properties are left unchanged. % % IDASetB with no input arguments displays all property names. % %IDASetB properties %(See also the IDAS User Guide) % %UserData - problem data passed unmodified to all user functions. % Set VALUE to be the new user data. %RelTol - Relative tolerance % Set VALUE to the new relative tolerance %AbsTol - absolute tolerance % Set VALUE to be either the new scalar absolute tolerance or % a vector of absolute tolerances, one for each solution component. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ if (nargin == 0) fprintf(' UserData\n'); fprintf('\n'); fprintf(' RelTol\n'); fprintf(' AbsTol\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'RelTol' 'AbsTol' }; options = idm_options(KeyNames,varargin{:}); mode = 34; status = idm(mode, idxB, options); sundials-2.5.0/sundialsTB/idas/IDAGet.m0000600000175000017500000000244211741421121020411 0ustar sylvestresylvestrefunction [output, status] = IDAGet(key, varargin) %IDAGet extracts data from the IDAS solver memory. % % Usage: RET = IDAGet ( KEY [, P1 [, P2] ... ]) % % IDAGet returns internal IDAS information based on KEY. For some values % of KEY, additional arguments may be required and/or more than one output is % returned. % % KEY is a string and should be one of: % o DerivSolution - Returns a vector containing the K-th order derivative % of the solution at time T. The time T and order K must be passed through % the input arguments P1 and P2, respectively: % DKY = IDAGet('DerivSolution', T, K) % o ErrorWeights - Returns a vector containing the current error weights. % EWT = IDAGet('ErrorWeights') % o CheckPointsInfo - Returns an array of structures with check point information. % CK = IDAGet('CheckPointInfo) % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:18 $ mode = 32; if strcmp(key, 'DerivSolution') t = varargin{1}; k = varargin{2}; [output, status] = idm(mode,1,t,k); elseif strcmp(key, 'ErrorWeights') [output, status] = idm(mode,2); elseif strcmp(key, 'CheckPointsInfo') [output, status] = idm(mode,4); else error('IDAGet:: Unrecognized key'); endsundials-2.5.0/sundialsTB/idas/Contents.m0000600000175000017500000001325411741421121021154 0ustar sylvestresylvestre% IDAS, a DAE integrator with sensitivity analysis capabilities % % The Matlab interface to the SUNDIALS solver IDAS provides access % to all functionality of the underlying solver, including IVP simulation % and sensitvity analysis (both forward and adjoint). % % The interface consists of several user-callable functions. In addition, % the user must provide several required and optional user-supplied % functions which define the problem to be solved. The user-callable % functions and the types of user-supplied functions are listed below. % For completness, some functions appear more than once. % % Functions for DAE integration % % IDASetOptions - create an options structure for IDAS. % IDASetQuadOptions - create an options structure for quadrature integration. % IDAInit - allocate and initialize memory for IDAS. % IDAQuadInit - allocate and initialize memory for quadrature integration. % IDAReInit - reinitialize memory for IDAS. % IDAQuadReInit - reinitialize memory for quadrature integration. % IDACalcIC - compute consistent initial conditions. % IDASolve - integrate the DAE problem. % IDAGetStats - return statistics for the IDAS solver. % IDAGet - extract data from IDAS memory. % IDAFree - deallocate memory for the IDAS solver. % % Functions for forward sensitivity analysis % % IDASetOptions - create an options structure for an DAE problem. % IDAQuadSetOptions - create an options structure for quadrature integration. % IDASensSetOptions - create an options structure for FSA. % IDAInit - allocate and initialize memory for IDAS. % IDAQuadInit - allocate and initialize memory for quadrature integration. % IDASensInit - allocate and initialize memory for FSA. % IDAReInit - reinitialize memory for IDAS. % IDAQuadReInit - reinitialize memory for quadrature integration. % IDASensReInit - reinitialize memory for FSA. % IDASensToggleOff - temporarily deactivates FSA. % IDASetIC - compute consistent initial conditions. % IDASolve - integrate the DAE problem. % IDAGetStats - return statistics for the IDAS solver. % IDAGet - extract data from IDAS memory. % IDAFree - deallocate memory for the IDAS solver. % % Functions for adjoint sensitivity analysis % % IDASetOptions - create an options structure for an DAE problem. % IDAQuadSetOptions - create an options structure for quadrature integration. % IDAInit - allocate and initialize memory for the forward problem. % IDAQuadInit - allocate and initialize memory for forward quadrature integration. % IDAQuadReInit - reinitialize memory for forward quadrature integration. % IDAReInit - reinitialize memory for the forward problem. % IDAAdjInit - allocate and initialize memory for ASA. % IDAInitB - allocate and initialize a backward problem. % IDAAdjReInit - reinitialize memory for ASA. % IDAReInitB - reinitialize a backward problem. % IDASetIC - compute consistent initial conditions. % IDASetICb - compute consistent final conditions for backward problem. % IDASolve - integrate the forward DAE problem. % IDASolveB - integrate the backward problems. % IDAGetStats - return statistics for the integration of the forward problem. % IDAGetStatsB - return statistics for the integration of a backward problem. % IDAGet - extract data from IDAS memory. % IDAFree - deallocate memory for the IDAS solver. % % User-supplied function types for forward problems % % IDAResFn - DAE residual function % IDARootFn - root-finding function % IDAQuadRhsFn - quadrature RHS function % IDASensResFn - sensitivity DAE residual function % IDADenseJacFn - dense Jacobian function % IDABandJacFn - banded Jacobian function % IDAJacTimesVecFn - Jacobian times vector function % IDAPrecSetupFn - preconditioner setup function % IDAPrecSolveFn - preconditioner solve function % IDAGlocalFn - RHS approximation function (BBDPre) % IDAGcomFn - communication function (BBDPre) % IDAMonitorFn - monitoring function % % User-supplied function types for backward problems % % IDAResFnB - backard DAE residual function % IDAQuadRhsFnB - quadrature RHS function % IDADenseJacFnB - dense Jacobian function % IDABandJacFnB - banded Jacobian function % IDAJacTimesVecFnB - Jacobian times vector function % IDAPrecSetupFnB - preconditioner setup function % IDAPrecSolveFnB - preconditioner solve function % IDAGlocalFnB - RHS approximation function (BBDPre) % IDAGcomFnB - communication function (BBDPre) % IDAMonitorFnB - monitoring function % % Serial examples provided with the toolbox % % midasRoberts_dns - chemical kinetics problem (index-1 DAE) % midasRoberts_ASAi_dns - ASA for the robertson problem % midasBruss_dns - 2D, 2-species, time dependent PDE (index-1 DAE) % midasBruss_ASA_dns - ASA for the brusselator example % midasHeat2D_bnd - 2D heat problem % midasPendI1_dns - simple pendulum example (index-1 DAE) % midasPendI2_dns - simple pendulum example (stabilized index-2 DAE) % midasSlCrank_dns - slider-crank example (stabilized index-2 DAE) % midasSlCrank_FSA_dns - FSA for the slider-crank example % midasReInit_dns - integration over solution discontinuities % % Parallel examples provided with the toolbox % % N/A % Use the mpirun function to run any of the parallel examples % % See also nvector, putils sundials-2.5.0/sundialsTB/idas/IDASolveB.m0000600000175000017500000000374211741421121021070 0ustar sylvestresylvestrefunction [varargout] = IDASolveB(tout,itask) %IDASolveB integrates the backward DAE. % % Usage: [STATUS, T, YB] = IDASolveB ( TOUT, ITASK ) % [STATUS, T, YB, YQB] = IDASolveB ( TOUT, ITASK ) % % If ITASK is 'Normal', then the solver integrates from its current internal % T value to a point at or beyond TOUT, then interpolates to T = TOUT and returns % YB(TOUT). If ITASK is 'OneStep', then the solver takes one internal time step % and returns in YB the solution at the new internal time. In this case, TOUT % is used only during the first call to IDASolveB to determine the direction of % integration and the rough scale of the problem. In either case, the time % reached by the solver is returned in T. % % If quadratures were computed (see IDAQuadInitB), IDASolveB will return their % values at T in the vector YQB. % % In ITASK =' Normal' mode, to obtain solutions at specific times T0,T1,...,TFINAL % (all increasing or all decreasing) use TOUT = [T0 T1 ... TFINAL]. In this case % the output arguments YB and YQB are matrices, each column representing the solution % vector at the corresponding time returned in the vector T. % % If more than one backward problem was defined, the return arguments are cell % arrays, with T{IDXB}, YB{IDXB}, and YQB{IDXB} corresponding to the backward % problem with index IDXB (as returned by IDAInitB). % % On return, STATUS is one of the following: % 0: IDASolveB succeeded. % 1: IDASolveB succeded and return at a tstop value (internally set). % -1: An error occurred (see printed message). % % See also IDASetOptions, IDAGetStatsB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.5 $Date: 2011/06/01 22:05:01 $ mode = 21; if nargin ~= 2 error('Wrong number of input arguments'); end if nargout < 3 || nargout > 4 error('Wrong number of output arguments'); end varargout = cell (nargout, 1); [varargout{:}] = idm(mode,tout,itask); sundials-2.5.0/sundialsTB/idas/IDAGetStats.m0000600000175000017500000000624511741421121021435 0ustar sylvestresylvestrefunction [si, status] = IDAGetStats() %IDAGetStats returns run statistics for the IDAS solver. % % Usage: STATS = IDAGetStats % %Fields in the structure STATS % %o nst - number of integration steps %o nre - number of residual function evaluations %o nsetups - number of linear solver setup calls %o netf - number of error test failures %o nni - number of nonlinear solver iterations %o ncfn - number of convergence test failures %o qlast - last method order used %o qcur - current method order %o h0used - actual initial step size used %o hlast - last step size used %o hcur - current step size %o tcur - current time reached by the integrator %o RootInfo - strucutre with rootfinding information %o QuadInfo - structure with quadrature integration statistics %o LSInfo - structure with linear solver statistics %o FSAInfo - structure with forward sensitivity solver statistics % %If rootfinding was requested, the structure RootInfo has the following fields % %o nge - number of calls to the rootfinding function %o roots - array of integers (a value of 1 in the i-th component means that the % i-th rootfinding function has a root (upon a return with status=2 from % IDASolve). % %If quadratures were present, the structure QuadInfo has the following fields % %o nfQe - number of quadrature integrand function evaluations %o netfQ - number of error test failures for quadrature variables % %The structure LSinfo has different fields, depending on the linear solver used. % % Fields in LSinfo for the 'Dense' linear solver % %o name - 'Dense' %o njeD - number of Jacobian evaluations %o nreD - number of residual function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Band' linear solver % %o name - 'Band' %o njeB - number of Jacobian evaluations %o nreB - number of residual function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'GMRES' and 'BiCGStab' linear solvers % %o name - 'GMRES' or 'BiCGStab' %o nli - number of linear solver iterations %o npe - number of preconditioner setups %o nps - number of preconditioner solve function calls %o ncfl - number of linear system convergence test failures %o njeSG - number of Jacobian-vector product evaluations %o nreSG - number of residual function evaluations for difference-quotient % Jacobian-vector product approximation % %If forward sensitivities were computed, the structure FSAInfo has the %following fields % %o nrSe - number of sensitivity residual evaluations %o nreS - number of residual evaluations for difference-quotient % sensitivity residual approximation %o nsetupsS - number of linear solver setups triggered by sensitivity variables %o netfS - number of error test failures for sensitivity variables %o nniS - number of nonlinear solver iterations for sensitivity variables %o ncfnS - number of convergence test failures due to sensitivity variables % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 30; [si, status] = idm(mode); sundials-2.5.0/sundialsTB/idas/IDASetOptions.m0000600000175000017500000003121411741421121022000 0ustar sylvestresylvestrefunction options = IDASetOptions(varargin) %IDASetOptions creates an options structure for IDAS. % % Usage: OPTIONS = IDASetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = IDASetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = IDASetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % a IDAS options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = IDASetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % IDASetOptions with no input arguments displays all property names % and their possible values. % %IDASetOptions properties %(See also the IDAS User Guide) % %UserData - User data passed unmodified to all functions [ empty ] % If UserData is not empty, all user provided functions will be % passed the problem data as their last input argument. For example, % the RES function must be defined as R = DAEFUN(T,YY,TP,DATA). % %RelTol - Relative tolerance [ positive scalar | {1e-4} ] % RelTol defaults to 1e-4 and is applied to all components of the solution % vector. See AbsTol. %AbsTol - Absolute tolerance [ positive scalar or vector | {1e-6} ] % The relative and absolute tolerances define a vector of error weights % with components % ewt(i) = 1/(RelTol*|y(i)| + AbsTol) if AbsTol is a scalar % ewt(i) = 1/(RelTol*|y(i)| + AbsTol(i)) if AbsTol is a vector % This vector is used in all error and convergence tests, which % use a weighted RMS norm on all error-like vectors v: % WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v(i)*ewt(i))^2 ), % where N is the problem dimension. %MaxNumSteps - Maximum number of steps [positive integer | {500}] % IDASolve will return with an error after taking MaxNumSteps internal steps % in its attempt to reach the next output time. %InitialStep - Suggested initial stepsize [ positive scalar ] % By default, IDASolve estimates an initial stepsize h0 at the initial time % t0 as the solution of % WRMSnorm(h0^2 ydd / 2) = 1 % where ydd is an estimated second derivative of y(t0). %MaxStep - Maximum stepsize [ positive scalar | {inf} ] % Defines an upper bound on the integration step size. %MaxOrder - Maximum method order [ 1-5 for BDF | {5} ] % Defines an upper bound on the linear multistep method order. %StopTime - Stopping time [ scalar ] % Defines a value for the independent variable past which the solution % is not to proceed. %RootsFn - Rootfinding function [ function ] % To detect events (roots of functions), set this property to the event % function. See IDARootFn. %NumRoots - Number of root functions [ integer | {0} ] % Set NumRoots to the number of functions for which roots are monitored. % If NumRoots is 0, rootfinding is disabled. % %SuppressAlgVars - Suppres algebraic vars. from error test [ on | {off} ] %VariableTypes - Alg./diff. variables [ vector ] %ConstraintTypes - Simple bound constraints [ vector ] % %LinearSolver - Linear solver type [{Dense}|Band|GMRES|BiCGStab|TFQMR] % Specifies the type of linear solver to be used for the Newton nonlinear % solver. Valid choices are: Dense (direct, dense Jacobian), Band (direct, % banded Jacobian), GMRES (iterative, scaled preconditioned GMRES), % BiCGStab (iterative, scaled preconditioned stabilized BiCG), TFQMR % (iterative, scaled transpose-free QMR). % The GMRES, BiCGStab, and TFQMR are matrix-free linear solvers. %JacobianFn - Jacobian function [ function ] % This propeerty is overloaded. Set this value to a function that returns % Jacobian information consistent with the linear solver used (see Linsolver). % If not specified, IDAS uses difference quotient approximations. % For the Dense linear solver, JacobianFn must be of type IDADenseJacFn and % must return a dense Jacobian matrix. For the Band linear solver, JacobianFn % must be of type IDABandJacFn and must return a banded Jacobian matrix. % For the iterative linear solvers, GMRES, BiCGStab, and TFQMR, JacobianFn must % be of type IDAJacTimesVecFn and must return a Jacobian-vector product. %KrylovMaxDim - Maximum number of Krylov subspace vectors [ integer | {5} ] % Specifies the maximum number of vectors in the Krylov subspace. This property % is used only if an iterative linear solver, GMRES, BiCGStab, or TFQMR is used % (see LinSolver). %GramSchmidtType - Gram-Schmidt orthogonalization [ Classical | {Modified} ] % Specifies the type of Gram-Schmidt orthogonalization (classical or modified). % This property is used only if the GMRES linear solver is used (see LinSolver). %PrecModule - Preconditioner module [ BBDPre | {UserDefined} ] % If PrecModule = 'UserDefined', then the user must provide at least a % preconditioner solve function (see PrecSolveFn) % IDAS provides one general-purpose preconditioner module, BBDPre, which can % be only used with parallel vectors. It provide a preconditioner matrix that % is block-diagonal with banded blocks. The blocking corresponds to the % distribution of the dependent variable vector y among the processors. % Each preconditioner block is generated from the Jacobian of the local part % (on the current processor) of a given function g(t,y,yp) approximating % f(t,y,yp) (see GlocalFn). The blocks are generated by a difference quotient % scheme on each processor independently. This scheme utilizes an assumed % banded structure with given half-bandwidths, mldq and mudq (specified through % LowerBwidthDQ and UpperBwidthDQ, respectively). However, the banded Jacobian % block kept by the scheme has half-bandwiths ml and mu (specified through % LowerBwidth and UpperBwidth), which may be smaller. %PrecSetupFn - Preconditioner setup function [ function ] % If PrecType is not 'None', PrecSetupFn specifies an optional function which, % together with PrecSolve, defines the preconditioner matrix, which must be an % aproximation to the Newton matrix. PrecSetupFn must be of type IDAPrecSetupFn. %PrecSolveFn - Preconditioner solve function [ function ] % If PrecType is not 'None', PrecSolveFn specifies a required function which % must solve a linear system Pz = r, for given r. PrecSolveFn must be of type % IDAPrecSolveFn. %GlocalFn - Local residual approximation function for BBDPre [ function ] % If PrecModule is BBDPre, GlocalFn specifies a required function that % evaluates a local approximation to the DAE residual. GlocalFn must % be of type IDAGlocFn. %GcommFn - Inter-process communication function for BBDPre [ function ] % If PrecModule is BBDPre, GcommFn specifies an optional function % to perform any inter-process communication required for the evaluation of % GlocalFn. GcommFn must be of type IDAGcommFn. %LowerBwidth - Jacobian/preconditioner lower bandwidth [ integer | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the lower half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in IDAS is used % (see PrecModule), it specifies the lower half-bandwidth of the retained % banded approximation of the local Jacobian block. % LowerBwidth defaults to 0 (no sub-diagonals). %UpperBwidth - Jacobian/preconditioner upper bandwidth [ integer | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the upper half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in IDAS is used % (see PrecModule), it specifies the upper half-bandwidth of the retained % banded approximation of the local Jacobian block. % UpperBwidth defaults to 0 (no super-diagonals). %LowerBwidthDQ - BBDPre preconditioner DQ lower bandwidth [ integer | {0} ] % Specifies the lower half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). %UpperBwidthDQ - BBDPre preconditioner DQ upper bandwidth [ integer | {0} ] % Specifies the upper half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). % %MonitorFn - User-provied monitoring function [ function ] % Specifies a function that is called after each successful integration step. % This function must have type IDAMonitorFn or IDAMonitorFnB, depending on % whether these options are for a forward or a backward problem, respectively. % Sample monitoring functions IDAMonitor and IDAMonitorB are provided % with IDAS. %MonitorData - User-provied data for the monitoring function [ struct ] % Specifies a data structure that is passed to the MonitorFn function every time % it is called. % %SensDependent - Backward problem depending on sensitivities [ {false} | true ] % Specifies whether the backward problem right-hand side depends on % forward sensitivites. If TRUE, the residual function provided for % this backward problem must have the appropriate type (see IDAResFnB). % %ErrorMessages - Post error/warning messages [ {true} | false ] % Note that any errors in IDAInit will result in a Matlab error, thus % stoping execution. Only subsequent calls to IDAS functions will respect % the value specified for 'ErrorMessages'. % %NOTES: % % The properties listed above that can only be used for forward problems % are: ConstraintTypes, StopTime, RootsFn, and NumRoots. % % The property SensDependent is relevant only for backward problems. % % See also % IDAInit, IDAReInit, IDAInitB, IDAReInitB % IDAResFn, IDARootFn % IDADenseJacFn, IDABandJacFn, IDAJacTimesVecFn % IDAPrecSetupFn, IDAPrecSolveFn % IDAGlocalFn, IDAGcommFn % IDAMonitorFn % IDAResFnB % IDADenseJacFnB, IDABandJacFnB, IDAJacTimesVecFnB % IDAPrecSetupFnB, IDAPrecSolveFnB % IDAGlocalFnB, IDAGcommFnB % IDAMonitorFnB % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.5 $Date: 2007/12/05 21:58:19 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) & (nargout == 0) fprintf(' UserData: [ empty ]\n'); fprintf('\n'); fprintf(' RelTol: [ positive scalar | {1e-4} ]\n'); fprintf(' AbsTol: [ positive scalar or vector | {1e-6} ]\n'); fprintf(' MaxNumSteps: [ positive integer | {500} ]\n'); fprintf(' InitialStep: [ positive scalar ]\n'); fprintf(' MaxStep: [ positive scalar | {inf} ]\n'); fprintf(' MaxOrder: [ 1-12 for Adams, 1-5 for BDF | {5} ]\n'); fprintf(' StopTime: [ scalar ]\n'); fprintf(' RootsFn: [ function ]\n'); fprintf(' NumRoots: [ integer | {0} ]\n'); fprintf('\n'); fprintf(' SuppressAlgVars: [ on | {off} ]\n'); fprintf(' VariableTypes: [ vector ]\n'); fprintf(' ConstraintTypes: [ vector ]\n'); fprintf('\n'); fprintf(' LinearSolver: [ {Dense} | Band | GMRES | BiCGStab | TFQMR ]\n'); fprintf(' JacobianFn: [ function ]\n'); fprintf(' KrylovMaxDim: [ integer | {5} ]\n'); fprintf(' GramSchmidtType: [ Classical | {Modified} ]\n'); fprintf(' PrecModule: [ BBDPre | {UserDefined} ]\n'); fprintf(' PrecSetupFn: [ function ]\n'); fprintf(' PrecSolveFn: [ function ]\n'); fprintf(' GlocalFn: [ function ]\n'); fprintf(' GcommFn: [ function ]\n'); fprintf(' LowerBwidth: [ integer | {0} ]\n'); fprintf(' UpperBwidth: [ integer | {0} ]\n'); fprintf(' LowerBwidthDQ: [ integer | {0} ]\n'); fprintf(' UpperBwidthDQ: [ integer | {0} ]\n'); fprintf('\n'); fprintf(' MonitorFn: [ function ]\n'); fprintf(' MonitorData: [ struct ]\n'); fprintf('\n'); fprintf(' SensDependent: [ {false} | true ]\n'); fprintf('\n'); fprintf(' ErrorMessages: [ false | {true} ]\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'RelTol' 'AbsTol' 'MaxNumSteps' 'InitialStep' 'MaxStep' 'MaxOrder' 'StopTime' 'RootsFn' 'NumRoots' 'VariableTypes' 'ConstraintTypes' 'SuppressAlgVars' 'LinearSolver' 'JacobianFn' 'PrecModule' 'PrecSetupFn' 'PrecSolveFn' 'KrylovMaxDim' 'GramSchmidtType' 'GlocalFn' 'GcommFn' 'LowerBwidth' 'UpperBwidth' 'LowerBwidthDQ' 'UpperBwidthDQ' 'MonitorFn' 'MonitorData' 'SensDependent' 'ErrorMessages' }; options = idm_options(KeyNames,varargin{:});sundials-2.5.0/sundialsTB/idas/IDACalcICB.m0000600000175000017500000000125311741421121021051 0ustar sylvestresylvestrefunction [status, varargout] = IDACalcICB(tout,icmeth) %IDACalcICB computes consistent initial conditions for the backward phase. % % Usage: STATUS = IDACalcICB ( TOUTB, ICMETHB ) % [STATUS, YY0B, YP0B] = IDACalcIC ( TOUTB, ICMETHB ) % % See also: IDASetOptions, IDAInitB, IDAReInitB % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.4 $Date: 2011/05/26 00:05:36 $ mode = 26; if nargout == 1 status = idm(mode, tout, icmeth); elseif nargout == 3 [status, yy, yp] = idm(mode, tout, icmeth); varargout(1) = {yy}; varargout(2) = {yp}; else disp('IDACalcICB:: wrong number of output arguments'); end sundials-2.5.0/sundialsTB/idas/IDAReInit.m0000600000175000017500000000200211741421121021054 0ustar sylvestresylvestrefunction status = IDAReInit(t0,yy0,yp0,options) %IDAReInit reinitializes memory for IDAS. % where a prior call to IDAInit has been made with the same % problem size N. IDAReInit performs the same input checking % and initializations that IDAInit does, but it does no % memory allocation, assuming that the existing internal memory % is sufficient for the new problem. % % Usage: IDAReInit ( T0, YY0, YP0 [, OPTIONS ] ) % % T0 is the initial value of t. % YY0 is the initial condition vector y(t0). % YP0 is the initial condition vector y'(t0). % OPTIONS is an (optional) set of integration options, created with % the IDASetOptions function. % % See also: IDASetOptions, IDAInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 11; if nargin < 3 error('Too few input arguments'); end if nargin < 4 options = []; end status = idm(mode, t0, yy0, yp0, options); sundials-2.5.0/sundialsTB/idas/IDAQuadSetOptions.m0000600000175000017500000000474511741421121022624 0ustar sylvestresylvestrefunction options = IDAQuadSetOptions(varargin) %IDAQuadSetOptions creates an options structure for IDAS. % % Usage: OPTIONS = IDAQuadSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = IDAQuadSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = IDAQuadSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % an IDAS options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = IDAQuadSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % IDAQuadSetOptions with no input arguments displays all property names % and their possible values. % %IDAQuadSetOptions properties %(See also the IDAS User Guide) % %ErrControl - Error control strategy for quadrature variables [ on | {off} ] % Specifies whether quadrature variables are included in the error test. %RelTol - Relative tolerance for quadrature variables [ scalar {1e-4} ] % Specifies the relative tolerance for quadrature variables. This parameter is % used only if QuadErrCon=on. %AbsTol - Absolute tolerance for quadrature variables [ scalar or vector {1e-6} ] % Specifies the absolute tolerance for quadrature variables. This parameter is % used only if QuadErrCon=on. % %SensDependent - Backward problem depending on sensitivities [ {false} | true ] % Specifies whether the backward problem quadrature right-hand side depends % on forward sensitivites. If TRUE, the right-hand side function provided for % this backward problem must have the appropriate type (see IDAQuadRhsFnB). % % See also % IDAQuadInit, IDAQuadReInit. % IDAQuadInitB, IDAQuadReInitB % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:38:42 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) && (nargout == 0) fprintf(' ErrControl: [ {false} | true ]\n'); fprintf(' RelTol: [ positive scalar {1e-4} ]\n'); fprintf(' AbsTol: [ positive scalar or vector {1e-6} ]\n'); fprintf('\n'); fprintf(' SensDependent: [ {false} | true ]\n'); fprintf('\n'); return; end KeyNames = { 'ErrControl' 'RelTol' 'AbsTol' 'SensDependent' }; options = idm_options(KeyNames,varargin{:}); sundials-2.5.0/sundialsTB/idas/IDAMonitor.m0000600000175000017500000004032211741421121021320 0ustar sylvestresylvestrefunction [new_data] = IDAMonitor(call, T, Y, YQ, YS, data) %IDAMonitor is the default IDAS monitoring function. % To use it, set the Monitor property in IDASetOptions to % 'IDAMonitor' or to @IDAMonitor and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to IDASetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see IDAGetStats) % o mode [ {'graphical'} | 'text' | 'both' ] % In graphical mode, plot the evolutions of the above quantities. % In text mode, print a table. % o sol [ true | {false} ] % If true, plot solution components. % o sensi [ true | {false} ] % If true and if FSA is enabled, plot sensitivity components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also IDASetOptions, IDAMonitorFn % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to IDASetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2009/04/22 04:25:06 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.grph if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end end if data.text if data.cntr | data.stats data.hft = figure; end end if data.sol | data.sensi data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y and YS for additional initializations if data.first if isempty(YS) data.sensi = false; end if data.sol | data.sensi if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end if data.sensi data.Ns = size(YS,2); data.ys = zeros(data.N, data.Ns, data.updt); data.nps = data.nps + data.Ns; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; Ns = data.Ns; y = data.y; ys = data.ys; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = IDAGetStats; t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end if data.sensi for k = 1:Ns for j = 1:N ys(j,k,n) = YS(data.select(j),k); end end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) & data.grph graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_init(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol | data.sensi sol_init(n, hfs, nps, data.sol, data.sensi, ... N, Ns, t, y, ys); end data.initialized = true; else if (data.stats | data.cntr) & data.grph graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_update(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, data.sensi, N, Ns, t, y, ys); end end if call == 2 if (data.stats | data.cntr) & data.grph graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol | data.sensi sol_final(hfs, nps, data.sol, data.sensi, N, Ns); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.ys = ys; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'mode') data.mode = 'graphical'; end if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'sensi') data.sensi = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end data.grph = true; data.text = true; if strcmp(data.mode,'graphical') data.text = false; end if strcmp(data.mode,'text') data.grph = false; end if ~data.sol & ~data.sensi data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.Ns = 0; data.y = 0; data.ys = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) fig_name = 'IDAS run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfg); set(hfg,'Name',fig_name); set(hfg,'color',[1 1 1]); pl = 0; % Time label and figure title tlab = '\rightarrow t \rightarrow'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') abs(h(1:n))]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') q(1:n)]; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); % Attention: Children are loaded in reverse order! xd = [get(hc(1),'XData') t(1:n)]; yd = [get(hc(1),'YData') ncfn(1:n)]; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') netf(1:n)]; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') nni(1:n)]; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') nfe(1:n)]; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') nst(1:n)]; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = text_init(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) fig_name = 'IDAS run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hft); set(hft,'Name',fig_name); set(hft,'color',[1 1 1]); set(hft,'MenuBar','none'); set(hft,'Resize','off'); % Create text box margins=[10 10 50 50]; % left, right, top, bottom pos=get(hft,'position'); tbpos=[margins(1) margins(4) pos(3)-margins(1)-margins(2) ... pos(4)-margins(3)-margins(4)]; tbpos(tbpos<1)=1; htb=uicontrol(hft,'style','listbox','position',tbpos,'tag','textbox'); set(htb,'BackgroundColor',[1 1 1]); set(htb,'SelectionHighlight','off'); set(htb,'FontName','courier'); % Create table head tpos = [tbpos(1) tbpos(2)+tbpos(4)+10 tbpos(3) 20]; ht=uicontrol(hft,'style','text','position',tpos,'tag','text'); set(ht,'BackgroundColor',[1 1 1]); set(ht,'HorizontalAlignment','left'); set(ht,'FontName','courier'); newline = ' time step order | nst nfe nni netf ncfn'; set(ht,'String',newline); % Create OK button bsize=[60,28]; badjustpos=[0,25]; bpos=[pos(3)/2-bsize(1)/2+badjustpos(1) -bsize(2)/2+badjustpos(2)... bsize(1) bsize(2)]; bpos=round(bpos); bpos(bpos<1)=1; hb=uicontrol(hft,'style','pushbutton','position',bpos,... 'string','Close','tag','okaybutton'); set(hb,'callback','close'); % Save handles handles=guihandles(hft); guidata(hft,handles); for i = 1:n newline = ''; if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = text_update(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) figure(hft); handles=guidata(hft); for i = 1:n if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) fig_name = 'IDAS solution'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfs); set(hfs,'Name',fig_name); set(hfs,'color',[1 1 1]); % Time label tlab = '\rightarrow t \rightarrow'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hold on; ys_crt = ys(:,is,1:n); for i = 1:N hp = plot(t(1:n),ys_crt(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); str = sprintf('s_{%d}',is); ylabel(str); str = sprintf('Sensitivity %d',is); title(str); end end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') y(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); ys_crt = ys(:,is,:); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') ys_crt(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, sensi, N, Ns) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('s%d_{%d}',is,i); end legend(cstring); end end drawnow sundials-2.5.0/sundialsTB/idas/IDAQuadInit.m0000600000175000017500000000142111741421121021404 0ustar sylvestresylvestrefunction status = IDAQuadInit(fctQ, yQ0, options) %IDAQuadInit allocates and initializes memory for quadrature integration. % % Usage: IDAQuadInit ( QFUN, YQ0 [, OPTIONS ] ) % % QFUN is a function defining the righ-hand sides of the quadrature % ODEs yQ' = fQ(t,y). % YQ0 is the initial conditions vector yQ(t0). % OPTIONS is an (optional) set of QUAD options, created with % the IDASetQuadOptions function. % % See also: IDASetQuadOptions, IDAQuadRhsFn % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 2; if nargin < 2 error('Too few input arguments'); end if nargin < 3 options = []; end status = idm(mode, fctQ, yQ0, options); sundials-2.5.0/sundialsTB/idas/examples_ser/0000755000175000017500000000000011767174700021713 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/examples_ser/midasBruss_dns.m0000600000175000017500000001234411741421121025025 0ustar sylvestresylvestrefunction midasBruss_dns %midasBruss_dns Brusselator example % This example solves the 2D Brusselator example on an (mx)x(my) % grid of the square with side L, using the MOL with central % finite-differences for the semidiscretization in space. % Homogeneous BC on all sides are incorporated as algebraic % constraints. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ %-------------- % Problem data %-------------- eps = 2.0e-3; % diffusion param A = 1.0; B = 3.4; % Spatial length 0 <= x,y, <= L L = 1.0; % grid size mx = 20; my = 20; dx = L/mx; dy = L/my; % coefficients in central FD hdif = eps/dx^2; vdif = eps/dy^2; % problem dimension nx = mx+1; ny = my+1; n = 2*nx*ny; x = linspace(0,L,nx); y = linspace(0,L,ny); data.eps = eps; data.A = A; data.B = B; data.L = L; data.dx = dx; data.dy = dy; data.nx = nx; data.ny = ny; data.x = x; data.y = y; data.hdif = hdif; data.vdif = vdif; %------------------- % Initial conditions %------------------- [u0, v0] = BRUSic(data); Y0 = UV2Y(u0, v0, data); Yp0 = zeros(n,1); % --------------------- % Initialize integrator % --------------------- % Integration limits t0 = 0.0; tf = 1.0; % Specify algebraic variables u_id = ones(ny,nx); u_id(1,:) = 0; u_id(ny,:) = 0; u_id(:,1) = 0; u_id(:,nx) = 0; v_id = ones(ny,nx); v_id(1,:) = 0; v_id(ny,:) = 0; v_id(:,1) = 0; v_id(:,nx) = 0; id = UV2Y(u_id, v_id, data); options = IDASetOptions('UserData',data,... 'RelTol',1.e-5,... 'AbsTol',1.e-5,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'MaxNumSteps', 1000,... 'LinearSolver','Dense'); % Initialize IDAS IDAInit(@BRUSres,t0,Y0,Yp0,options); % Compute consistent I.C. [status, Y0, Yp0] = IDACalcIC(tf, 'FindAlgebraic'); % --------------- % Integrate to tf % --------------- plotSol(t0,Y0,data); [status, t, Y] = IDASolve(tf, 'Normal'); plotSol(t,Y,data); % ----------- % Free memory % ----------- IDAFree; %%save foo.mat t Y data return % ==================================================================================== % Initial conditions % ==================================================================================== function [u0, v0] = BRUSic(data) dx = data.dx; dy = data.dy; nx = data.nx; ny = data.ny; L = data.L; x = data.x; y = data.y; n = 2*nx*ny; [x2D , y2D] = meshgrid(x,y); u0 = 1.0 - 0.5 * cos(pi*y2D/L); u0(1,:) = u0(2,:); u0(ny,:) = u0(ny-1,:); u0(:,1) = u0(:,2); u0(:,nx) = u0(:,nx-1); v0 = 3.5 - 2.5*cos(pi*x2D/L); v0(1,:) = v0(2,:); v0(ny,:) = v0(ny-1,:); v0(:,1) = v0(:,2); v0(:,nx) = v0(:,nx-1); return % ==================================================================================== % 1D <-> 2D conversion functions % ==================================================================================== function y = UV2Y(u, v, data) nx = data.nx; ny = data.ny; u1 = reshape(u, 1, nx*ny); v1 = reshape(v, 1, nx*ny); y = reshape([u1;v1], 2*nx*ny,1); return function [u,v] = Y2UV(y, data) nx = data.nx; ny = data.ny; y2 = reshape(y, 2, nx*ny); u = reshape(y2(1,:), ny, nx); v = reshape(y2(2,:), ny, nx); return % ==================================================================================== % Residual function % ==================================================================================== function [res, flag, new_data] = BRUSres(t,Y,Yp,data) dx = data.dx; dy = data.dy; nx = data.nx; ny = data.ny; eps = data.eps; A = data.A; B = data.B; L = data.L; hdif = data.hdif; vdif = data.vdif; % Convert Y and Yp to (u,v) and (up, vp) [u,v] = Y2UV(Y,data); [up,vp] = Y2UV(Yp,data); % 2D residuals ru = zeros(ny,nx); rv = zeros(ny,nx); % Inside the domain for iy = 2:ny-1 for ix = 2:nx-1 uu = u(iy,ix); vv = v(iy,ix); ru(iy,ix) = up(iy,ix) - ... hdif * ( u(iy,ix+1) - 2*uu + u(iy,ix-1) ) - ... vdif * ( u(iy+1,ix) - 2*uu + u(iy-1,ix) ) - ... A + (B+1)*uu - uu^2 * vv; rv(iy,ix) = vp(iy,ix) - ... hdif * ( v(iy,ix+1) - 2*vv + v(iy,ix-1) ) - ... vdif * ( v(iy+1,ix) - 2*vv + v(iy-1,ix) ) - ... B*uu + uu^2 * vv; end end % Boundary conditions ru(1,:) = u(1,:) - u(2,:); ru(ny,:) = u(ny,:) - u(ny-1,:); ru(:,1) = u(:,1) - u(:,2); ru(:,nx) = u(:,nx) - u(:,nx-1); rv(1,:) = v(1,:) - v(2,:); rv(ny,:) = v(ny,:) - v(ny-1,:); rv(:,1) = v(:,1) - v(:,2); rv(:,nx) = v(:,nx) - v(:,nx-1); % Convert (ru,rv) to res res = UV2Y(ru,rv,data); % Return flag and pb. data flag = 0; new_data = []; % ==================================================================================== % Plot (u,v) % ==================================================================================== function plotSol(t,Y,data) x = data.x; y = data.y; [u,v] = Y2UV(Y, data); figure; set(gcf,'position',[600 600 650 300]) subplot(1,2,1) surfc(x,y,u); shading interp %view(0,90) view(-15,35) axis tight box on grid off xlabel('x'); ylabel('y'); title(sprintf('u(x,y,%g)',t)) %colorbar('horiz'); subplot(1,2,2) surfc(x,y,v); shading interp %view(0,90) view(-15,35) axis tight box on grid off xlabel('x'); ylabel('y'); title(sprintf('v(x,y,%g)',t)) %colorbar('horiz'); return sundials-2.5.0/sundialsTB/idas/examples_ser/midasPendI2_dns.m0000600000175000017500000000614711741421121025014 0ustar sylvestresylvestrefunction midasPendI2_dns %midasPendI1_dns - Simple pendulum modeled as an index-2 DAE % The pendulum is modeled using the x and y positions with % the constraint x^2 + y^2 = L^2 % The stabilized index-2 (GGL formulation) DAE (in first-order form) % includes differential equations for the positions and velocities % with additional Lagrange multipliers included in the position % differential equations) and the position and velocity constraints. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ % x, y, vx, vy, lam, mu neq = 6; t0 = 0.0; tf = 10.0; id = ones(neq,1); id(5) = 0; id(6) = 0; options = IDASetOptions('RelTol',1.e-6,... 'AbsTol',1.e-6,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'MaxNumSteps', 1000,... 'LinearSolver','Dense'); y0 = zeros(neq,1); yp0 = zeros(neq,1); y0(1) = 1.0; yp0(4) = 9.81; fprintf('Consistent IC:\n'); disp([y0 yp0]) IDAInit(@pendGGL_f,t0,y0,yp0,options); it = 1; time(it) = t0; sol_y(it,:) = y0'; [res, dummy1, status] = pendGGL_f(t0, y0, yp0); pc(it) = res(5); vc(it) = res(6); t = t0; t_start = clock; while t < tf [status,t,y] = IDASolve(tf,'OneStep'); it = it+1; time(it) = t; sol_y(it,:) = y'; yp=yp0; % For verification purposes only, compute position and velocity constraint violations % (use dummy yp = yp0) [res, dummy1, status] = pendGGL_f(t, y, yp0); pc(it) = res(5); vc(it) = res(6); end runtime = etime(clock,t_start); fprintf('Solver stats:\n'); disp(IDAGetStats); fprintf('Run time: %f\n',runtime); figure; subplot(3,1,1) hold on plot(time,sol_y(:,1),'b'); plot(time,sol_y(:,2),'r'); box on set(gca,'XLim',[t0 tf]) title('position'); legend('x','y'); subplot(3,1,2) hold on plot(time,sol_y(:,3),'b'); plot(time,sol_y(:,4),'r'); box on set(gca,'XLim',[t0 tf]) title('velocity'); legend('v_x', 'v_y'); subplot(3,1,3) hold on plot(time,sol_y(:,5),'b'); plot(time,sol_y(:,6),'r'); box on set(gca,'XLim',[t0 tf]) title('Lagrange multipliers'); legend('\lambda', '\mu'); figure plotyy(time, pc, time, vc); box on title('position and velocity constraint violations'); figure subplot(2,1,1) plot(sol_y(:,1),sol_y(:,2)); axis equal axis tight box on grid on xlabel('x'); ylabel('y'); title('trajectory'); phi = atan2( sol_y(:,1) , sol_y(:,2) ); phi_d = ( sol_y(:,1).*sol_y(:,4) - sol_y(:,2).*sol_y(:,3) ) ./ ( sol_y(:,1).^2 + sol_y(:,2).^2 ) ; subplot(2,1,2) plot3(time,phi, phi_d); xlabel('time'); ylabel('\phi'); zlabel('\phi^\prime'); view(-30,15); set(gca,'XLim',[t0 tf]) grid on box on title('phase plot'); IDAFree; function [res, flag, new_data] = pendGGL_f(t,yy,yp) g = 9.81; m = 1.0; b = 0.3; L = 1.0; x = yy(1); xd = yp(1); y = yy(2); yd = yp(2); vx = yy(3); vxd = yp(3); vy = yy(4); vyd = yp(4); lam = yy(5); mu = yy(6); res(1) = -xd + (vx+2*x*mu); res(2) = -yd + (vy+2*y*mu); res(3) = -vxd + (-b*vx+2*x*lam)/m; res(4) = -vyd + (m*g-b*vy+2*y*lam)/m; res(5) = x^2 + y^2 - L^2; res(6) = 2*x*vx + 2*y*vy; flag = 0; new_data = []; sundials-2.5.0/sundialsTB/idas/examples_ser/midasSlCrank_FSA_dns.m0000600000175000017500000001225011741421121025751 0ustar sylvestresylvestrefunction midasSlCrank_FSA_dns %midasSlCrank_FSA_dns - FSA for the slider-crank example % % Sensitivities w.r.t. k and c are computed % % See also: midasSlCrank_dns % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2009/04/26 23:27:29 $ % Problem data data.a = 0.5; data.J1 = 1.0; data.m2 = 1.0; data.J2 = 2.0; data.l0 = 1.0; data.F = 1.0; data.params(1) = 1.0; % spring constant data.params(2) = 1.0; % damper constant % Integration limits t0 = 0.0; tf = 10.0; % Specify algebraic variables id = ones(10,1); id(7:10) = 0.0; % Integration options options = IDASetOptions('UserData',data,... 'RelTol',1.e-6,... 'AbsTol',1.e-6,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'MaxNumSteps', 1000,... 'LinearSolver','Dense'); % Set consistent IC [yy0, yp0] = setIC(data); % Initialize IDAS IDAInit(@scRES,t0,yy0,yp0,options); % FSA options Ns = 2; options = IDASensSetOptions('method','Simultaneous',... 'ErrControl',true,... 'ParamField','params',... 'ParamList',[1 2]); % Sensitivity IC yyS0 = zeros(10, Ns); ypS0 = zeros(10, Ns); % Initialize FSA IDASensInit(Ns, [], yyS0, ypS0, options); % Compute consistent IC % Store inital time and IC it = 1; time(it,1) = t0; solution(it,:) = yy0'; sensitivity1(it,:) = yyS0(:,1)'; sensitivity2(it,:) = yyS0(:,2)'; % Call solver in ONE_STEP mode t = t0; while t < tf [status,t,y,yS] = IDASolve(tf,'OneStep'); it = it+1; time(it,1) = t; solution(it,:) = y'; sensitivity1(it,:) = yS(:,1)'; sensitivity2(it,:) = yS(:,2)'; end fprintf('Solver stats:\n'); disp(IDAGetStats); IDAFree; % Plot slider position and its sensitivities figure; set(gcf,'position',[475 250 1000 400]); hold on X = [time ; flipud(time)]; Y1 = [solution(:,2) ; flipud(solution(:,2)+sensitivity1(:,2))]; Y2 = [solution(:,2) ; flipud(solution(:,2)+sensitivity2(:,2))]; hp1 = patch(X,Y1,'r'); hp2 = patch(X,Y2,'b'); %set(hp1,'EdgeColor','none','FaceAlpha',0.5); %set(hp2,'EdgeColor','none','FaceAlpha',0.5); set(hp1,'EdgeColor','none'); set(hp2,'EdgeColor','none'); hp = plot(time,solution(:,2),'k'); set(hp,'LineWidth',2); set(gca,'XLim',[t0 tf]); box on grid on % ==================================================================================== % Consistent IC % ==================================================================================== function [yy, yp] = setIC(data) a = data.a; J1 = data.J1; m2 = data.m2; J2 = data.J2; q = pi/2.0; p = -asin(a*sin(q)); x = cos(p) + a*cos(q); yy = zeros(10,1); yp = zeros(10,1); yy(1) = q; % crank angle yy(2) = x; % slider position yy(3) = p; % conecting rod angle Q = force(yy, data); yp(4) = Q(1)/J1; % crank angular acceleration yp(5) = Q(2)/m2; % slider horizontal acceleration yp(6) = Q(3)/J2; % connecting rod angular acceleration return % ==================================================================================== % Generalized force calculation % ==================================================================================== function Q = force(yy, data) a = data.a; k = data.params(1); c = data.params(2); l0 = data.l0; F = data.F; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x^2 - x*(c2+a*c1) + (1.0 + a^2)/4.0 + a*c21/2.0; l = sqrt(l2); ld = 2.0*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/2.0; ld = ld / (2.0*l); f = k*(l-l0) + c*ld; fl = f/l; Q(1) = - fl * a * (s21/2.0 + x*s1) / 2.0; Q(2) = fl * (c2/2.0 - x + a*c1/2.0) + F; Q(3) = - fl * (x*s2 - a*s21/2.0) / 2.0 - F*s2; return % ==================================================================================== % Residual function % ==================================================================================== function [res, flag, new_data] = scRES(t,yy,yp,data) a = data.a; J1 = data.J1; m2 = data.m2; J2 = data.J2; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity lam1 = yy(7); % Lagrange multiplier (cnstr) lam2 = yy(8); % Lagrange multiplier (cnstr) mu1 = yy(9); % Lagrange multiplier (GGL) mu2 = yy(10); % Lagrange multiplier (GGL) s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); % Generalized forces Q = force(yy, data); % Velocities (GGL modified) res(1) = yp(1) - qd + a*s1*mu1 - a*c1*mu2; res(2) = yp(2) - xd + mu1; res(3) = yp(3) - pd + s2*mu1 - c2*mu2; % Dynamical equations res(4) = J1*yp(4) - Q(1) + a*s1*lam1 - a*c1*lam2; res(5) = m2*yp(5) - Q(2) + lam1; res(6) = J2*yp(6) - Q(3) + s2*lam1 - c2*lam2; % Position constraints res(7) = x - c2 - a*c1; res(8) = -s2 - a*s1; % Velocity constraints res(9) = a*s1*qd + xd + s2*pd; res(10) = -a*c1*qd - c2*pd; flag = 0; new_data = []; return sundials-2.5.0/sundialsTB/idas/examples_ser/midasReInit_dns.m0000600000175000017500000000437711741421121025130 0ustar sylvestresylvestrefunction [] = midasReInit_dns() %midasReInit_dns - Illustration of the IDAS reinitialization function % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ fprintf('Example for integrating over a discontinuity in states\n'); fprintf('using the IDAS re-initialization function\n\n'); fprintf('Integrate over t = [ 0 1.0 ] the DAE:'); fprintf(' y1'' + y1 - y2 = 0\n'); fprintf(' y1 + y2 = 0\n'); fprintf('with initial conditions:\n'); fprintf(' y1(0) = 1.0\n'); fprintf(' y2(0) = -1.0\n'); fprintf('until y2(t*) = -0.5. At t*, perturb:\n'); fprintf(' y1(t*) <- y1(t*) - 0.25\n'); fprintf(' y2(t*) <- y2(t*) + 0.25\n'); fprintf('and continue the integration to t = 1.0\n\n'); t0 = 0.0; tout = 1.0; y0 = [1.0;-1.0]; yp0 = [-2.0;0.0]; % Set optional inputs options = IDASetOptions('RelTol',1.e-4,... 'AbsTol',1.e-5,... 'LinearSolver','Dense'); options = IDASetOptions(options,'RootsFn',@my_rootfct, 'NumRoots',1); % Initialize solver IDAInit(@my_resfct,t0,y0,yp0,options); % Initialize arrays tt = []; yy1 = []; yy2 = []; % Integrate DAE until root is found t = t0; while t % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ data.p = [0.04; 1.0e4; 3.0e7]; t0 = 0.0; y0 = [1.0;0.0;0.0]; yp0 = [-0.04;0.04;0.0]; options = IDASetOptions('UserData', data,... 'RelTol',1.e-4,... 'AbsTol',[1.e-8; 1.e-14; 1.e-6],... 'LinearSolver','Dense',... 'JacobianFn',@djacfn); options = IDASetOptions(options,'RootsFn',@rootfn, 'NumRoots',2); %mondata.sol = true; mondata.updt = 100; options = IDASetOptions(options,'MonitorFn',@IDAMonitor,'MonitorData',mondata); IDAInit(@resfn,t0,y0,yp0,options); t1 = 0.4; tmult = 10.0; nout = 12; fprintf('-----------------------------------------------------------------------\n'); fprintf(' t y1 y2 y3'); fprintf(' | nst k h\n'); fprintf('-----------------------------------------------------------------------\n'); iout = 0; tout = t1; while iout < nout [status,t,y] = IDASolve(tout,'Normal'); % Extract statistics si = IDAGetStats; % Print output if(status == 2) fprintf(' ... Root found %d %d\n',si.RootInfo.roots(1), si.RootInfo.roots(2)); end fprintf('%10.4e %12.4e %12.4e %12.4e | %3d %1d %12.4e\n',... t, y(1), y(2), y(3), si.nst, si.qlast, si.hlast); % Update output time if(status == 0) iout = iout+1; tout = tout*tmult; end end si = IDAGetStats; IDAFree; function [rr, flag, new_data] = resfn(t, y, yp, data) % DAE residual function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); rr(1) = -r1*y(1) + r2*y(2)*y(3) - yp(1); rr(2) = r1*y(1) - r2*y(2)*y(3) - r3*y(2)*y(2) - yp(2); rr(3) = y(1) + y(2) + y(3) - 1.0; flag = 0; new_data = []; function [J, flag, new_data] = djacfn(t, y, yp, rr, cj, data) % Dense Jacobian function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); J(1,1) = -r1 - cj; J(2,1) = r1; J(3,1) = 1.0; J(1,2) = r2*y(3); J(2,2) = -r2*y(3) - 2*r3*y(2) - cj; J(3,2) = 1.0; J(1,3) = r2*y(2); J(2,3) = -r2*y(2); J(3,3) = 1.0; flag = 0; new_data = []; function [g, flag, new_data] = rootfn(t,y,yp,data) % Root finding function g(1) = y(1) - 0.0001; g(2) = y(3) - 0.01; flag = 0; new_data = []; sundials-2.5.0/sundialsTB/idas/examples_ser/midasRoberts_ASAi_dns.m0000600000175000017500000001256711741421121026213 0ustar sylvestresylvestrefunction midasRoberts_ASAi_dns() %midasRoberts_ASAi_dns - IDAS ASA example problem (serial, dense) % The following is a simple example problem, with the coding % needed for its solution by IDAS. The problem is from % chemical kinetics, and consists of the following three rate % equations: % dy1/dt = -p1*y1 + p2*y2*y3 % dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2 % 0 = y1 + y2 + y3 - 1 % on the interval from t = 0.0 to t = 4.e7, with initial % conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. % While integrating the system, we also use the rootfinding % feature to find the points at which y1 = 1e-4 or at which % y3 = 0.01. % % The gradient with respect to the problem parameters p1, p2, % and p3 of the following quantity: % G = int_t0^t1 y3(t) dt % is computed using ASA. % % The gradient dG/dp is obtained as: % dG/dp = [ int_t0^tf y1*(l1-l2) dt , % int_t0^tf -y2*y3*(l1-l2) dt , % int_t0^tf y2^2*l2 dt ] % % where l = [l1, l2, l3] is solutions of: % dl1/dt = p1*l1 - p1*l2 + l3 % dl2/dt = -p2*y3*l1 + (p2*y3+2*p3*y2)*l2 + l3 % 0 = -p2*y2*l1 + p2*y2*l2 + l3 + 1 % with final conditions % l1(tf) = l2(tf) = 0.0 and l3(tf) = -1.0 % % All integrals (appearing in G and dG/dp) are computed using % the quadrature integration features in IDAS. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ % Problem parameters % ------------------ data.p = [0.04; 1.0e4; 3.0e7]; % Initialize forward problem % -------------------------- options = IDASetOptions('UserData', data,... 'RelTol',1.e-4,... 'AbsTol',[1.e-8; 1.e-14; 1.e-6],... 'LinearSolver','Dense',... 'JacobianFn',@djacfn); %mondata.sol = true; %mondata.updt = 100; %options = IDASetOptions(options,'MonitorFn',@IDAMonitor,'MonitorData',mondata); t0 = 0.0; y = [1.0;0.0;0.0]; yp = [-0.04;0.04;0.0]; IDAInit(@resfn,t0,y,yp,options); % Initialize forward quadrature (G) % --------------------------------- optionsQ = IDAQuadSetOptions('ErrControl',true,... 'RelTol',1.e-4,'AbsTol',1.e-6); q = 0.0; IDAQuadInit(@quadfn, q, optionsQ); % Activate ASA % ------------ IDAAdjInit(150, 'Hermite'); % Forward integration % ------------------- fprintf('Forward integration '); tf = 4.e7; [status, t, y, q] = IDASolve(tf,'Normal'); si = IDAGetStats; fprintf('(%d steps)\n',si.nst); fprintf('G = %12.4e\n',q(1)); % Initialize backward problem % --------------------------- optionsB = IDASetOptions('UserData',data,... 'RelTol',1.e-6,... 'AbsTol',1.e-3,... 'LinearSolver','Dense'); %mondataB = struct; %optionsB = IDASetOptions(optionsB,'MonitorFn',@IDAMonitorB,'MonitorData',mondataB); yB = [0.0 ; 0.0 ; -1.0]; yBp = [ -1.0 ; -1.0 ; 0.0 ]; idxB = IDAInitB(@resfnB,tf,yB,yBp,optionsB); % Initialize backward quadratures (dG/dp) % --------------------------------------- optionsQB = IDAQuadSetOptions('ErrControl',true,... 'RelTol',1.e-6,'AbsTol',1.e-3); qB = [0.0;0.0;0.0]; IDAQuadInitB(idxB, @quadfnB, qB, optionsQB); % Backward integration % -------------------- fprintf('Backward integration '); [status, t, yB, qB] = IDASolveB(t0,'Normal'); siB = IDAGetStatsB(idxB); fprintf('(%d steps)\n',siB.nst); fprintf('dG/dp: %12.4e %12.4e %12.4e\n',... -qB(1),-qB(2),-qB(3)); fprintf('lambda(t0): %12.4e %12.4e %12.4e\n',... yB(1),yB(2),yB(3)); % Free IDAS memory % ---------------- IDAFree; return % =========================================================================== function [rr, flag, new_data] = resfn(t, y, yp, data) % DAE residual function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); rr(1) = -r1*y(1) + r2*y(2)*y(3) - yp(1); rr(2) = r1*y(1) - r2*y(2)*y(3) - r3*y(2)*y(2) - yp(2); rr(3) = y(1) + y(2) + y(3) - 1.0; flag = 0; new_data = []; % =========================================================================== function [J, flag, new_data] = djacfn(t, y, yp, rr, cj, data) % Dense Jacobian function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); J(1,1) = -r1 - cj; J(2,1) = r1; J(3,1) = 1.0; J(1,2) = r2*y(3); J(2,2) = -r2*y(3) - 2*r3*y(2) - cj; J(3,2) = 1.0; J(1,3) = r2*y(2); J(2,3) = -r2*y(2); J(3,3) = 1.0; flag = 0; new_data = []; % =========================================================================== function [qd, flag, new_data] = quadfn(t, y, yp, data) % Forward quadrature integrand function qd = y(3); flag = 0; new_data = []; return % =========================================================================== function [rrB, flag, new_data] = resfnB(t, y, yp, yB, yBp, data) % Adjoint residual function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); rrB(1) = yBp(1) - r1*(yB(1)-yB(2)) - yB(3); rrB(2) = yBp(2) + r2*y(3)*(yB(1)-yB(2)) - 2.0*r3*y(2)*yB(2) - yB(3); rrB(3) = -r2*y(2)*(yB(1)-yB(2)) + yB(3) + 1.0; flag = 0; new_data = []; return % =========================================================================== function [qBd, flag, new_data] = quadfnB(t, y, yp, yB, ypB, data) % Backward problem quadrature integrand function qBd(1) = y(1)*(yB(1)-yB(2)); qBd(2) = -y(2)*y(3)*(yB(1)-yB(2)); qBd(3) = y(2)^2*yB(2); flag = 0; new_data = []; return sundials-2.5.0/sundialsTB/idas/examples_ser/midasSlCrank_dns.m0000600000175000017500000002652611741421121025273 0ustar sylvestresylvestrefunction midasSlCrank_dns %midasSlCrank_dns Slider-crank example % The multibody system consists of two bodies (crank and % connecting rod) with a translational-spring-damper (TSDA) % and a constant force acting on the connecting rod. % % The system has a single degree of freedom. It is modeled with 3 % generalized coordinates (crank angle, horizontal position of the % translational joint, and angle of the connecting rod) and % therefore has 2 constraints. % % Example 6.1.8, pp. 271 in % Ed. Haug - Intermediate Dynamics, Prentiss Hall, 1992 % % For its solution with IDAS, the resulting index-3 DAE is reformulated % as a stabilized index-2 DAE (Gear-Gupta-Leimkhuler formulation) by % introducing 2 additional Lagrange multipliers and appending the % velocity constraints. % % | | % | /\ | /\ % | / \ | / \ % | a/2 / \ 1/2 | / \ % | / \ | / \ % | /--TSDA--\ | / \ % | / \ | / \ % | / a/2 \ 1/2 | / \--- % |/ \ |/ \ q1 q3 / \ \ % +----------------------------- +---------------------------- % \ | \ |\ % \ | -|-\ % \ 1 | | \ % \ |<----- q2 ----->| \ % \ \ % \ \ % \ --> F \ % % The local reference frame on the crank is positioned at the % revolute joint on the ground. The crank has length a, mass m1, and % intertia (with respect to the local frame) J1. % The local reference frame on the conncting rod is positioned at the % translational joint. The connecting rod has length 2, mass m2, and % inertia J2. % The TSDA has spring constant k, damping constant c, and free length l0. % A constant horizontal force F acts on the connecting rod. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2009/04/26 23:27:29 $ % Problem data data.a = 0.5; data.J1 = 1.0; data.m2 = 1.0; data.J2 = 2.0; data.k = 1.0; data.c = 1.0; data.l0 = 1.0; data.F = 1.0; % Integration limits t0 = 0.0; tf = 10.0; % Specify algebraic variables id = ones(10,1); id(7:10) = 0.0; % Integration options options = IDASetOptions('UserData',data,... 'RelTol',1.e-6,... 'AbsTol',1.e-6,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'MaxNumSteps', 1000,... 'LinearSolver','Dense'); % Set consistent IC [yy0, yp0] = setIC(data); % Initialize IDAS IDAInit(@scRes,t0,yy0,yp0,options); % Store inital time and IC it = 1; time(it) = t0; pos(it,:) = yy0(1:3)'; vel(it,:) = yy0(4:6)'; acc(it,:) = yp0(4:6)'; lam(it,:) = yy0(7:8)'; % Compute constraint joint forces at initial time Fc(it,:) = joint_forces(yy0, yp0, data); % Call solver in ONE_STEP mode t = t0; while t < tf [status,t,yy] = IDASolve(tf,'OneStep'); it = it+1; time(it) = t; pos(it,:) = yy(1:3)'; vel(it,:) = yy(4:6)'; lam(it,:) = yy(7:8)'; yp = IDAGet('DerivSolution',t,1); acc(it,:) = yp(4:6)'; Fc(it,:) = joint_forces(yy, yp, data); end fprintf('Solver stats:\n'); disp(IDAGetStats); % Plot solution figure; set(gcf,'position',[475 250 1000 800]); subplot(2,2,1) hold on plot(time,pos(:,1),'b'); plot(time,pos(:,2),'r'); plot(time,pos(:,3),'g'); box on set(gca,'XLim',[t0 tf]) title('position'); legend('q','x','p'); subplot(2,2,2) hold on plot(time,vel(:,1),'b'); plot(time,vel(:,2),'r'); plot(time,vel(:,3),'g'); box on set(gca,'XLim',[t0 tf]) title('velocity'); legend('q''', 'x''', 'p'''); subplot(2,2,3) hold on plot(time,acc(:,1),'b'); plot(time,acc(:,2),'r'); plot(time,acc(:,3),'g'); box on set(gca,'XLim',[t0 tf]) title('acceleration'); legend('q''''', 'x''''', 'p'''''); subplot(2,2,4) hold on plot(time,lam(:,1),'b'); plot(time,lam(:,2),'r'); box on set(gca,'XLim',[t0 tf]) title('Lagrange multipliers (cnstr. forces)'); legend('\lambda_1', '\lambda_2'); % Plot joint forces figure; set(gcf,'position',[275 150 800 800]); plot(time,Fc); set(gca,'XLim',[t0 tf]) title('joint forces'); legend('vrt. force in rev. crank-ground',... 'hrz. force in rev. crank-ground',... 'vrt. force in rev. crank-rod',... 'hrz. force in rev. crank-rod',... 'vrt. force in transl.',... 'torque in transl.'); IDAFree; % ==================================================================================== % Consistent IC % ==================================================================================== function [yy, yp] = setIC(data) a = data.a; J1 = data.J1; m2 = data.m2; J2 = data.J2; q = pi/2.0; p = -asin(a*sin(q)); x = cos(p) + a*cos(q); yy = zeros(10,1); yp = zeros(10,1); yy(1) = q; % crank angle yy(2) = x; % slider position yy(3) = p; % conecting rod angle Q = appl_forces(yy, data); g = gamma(yy,data); G = jac(yy,data); % Extended mass matrix in index-1 formulation MM = zeros(5,5); MM(1,1) = J1; MM(2,2) = m2; MM(3,3) = J2; MM(4:5,1:3) = G; MM(1:3,4:5) = G'; % Right-hand side in index-1 formulation b = [Q;g]; % Solution of MM*x = b acc = MM^(-1)*b; yp(4) = acc(1); yp(5) = acc(2); yp(6) = acc(3); % yy(7) = acc(4); yy(8) = acc(5); return % ==================================================================================== % Constraint Jacobian % ==================================================================================== function G = jac(yy,data) a = data.a; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); G(1,1) = a*s1; G(1,2) = 1.0; G(1,3) = s2; G(2,1) = -a*c1; G(2,2) = 0.0; G(2,3) = -c2; return % ==================================================================================== % Right-hand side of acceleration constraint % ==================================================================================== function g = gamma(yy, data) a = data.a; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); g(1,1) = - (a*qd^2*c1+pd^2*c2); g(2,1) = - (a*qd^2*s1 + pd^2*s2); return % ==================================================================================== % Generalized applied forces calculation % ==================================================================================== function Q = appl_forces(yy, data) a = data.a; k = data.k; c = data.c; l0 = data.l0; F = data.F; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x^2 - x*(c2+a*c1) + (1.0 + a^2)/4.0 + a*c21/2.0; l = sqrt(l2); ld = 2.0*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/2.0; ld = ld / (2.0*l); f = k*(l-l0) + c*ld; fl = f/l; Q(1,1) = - fl * a * (s21/2.0 + x*s1) / 2.0; Q(2,1) = fl * (c2/2.0 - x + a*c1/2.0) + F; Q(3,1) = - fl * (x*s2 - a*s21/2.0) / 2.0 - F*s2; return % ==================================================================================== % Residual function % ==================================================================================== function [res, flag, new_data] = scRes(t,yy,yp,data) a = data.a; J1 = data.J1; m2 = data.m2; J2 = data.J2; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity lam1 = yy(7); % Lagrange multiplier (cnstr) lam2 = yy(8); % Lagrange multiplier (cnstr) mu1 = yy(9); % Lagrange multiplier (GGL) mu2 = yy(10); % Lagrange multiplier (GGL) s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); % Generalized forces Q = appl_forces(yy, data); % Velocities (GGL modified) res(1) = yp(1) - qd + a*s1*mu1 - a*c1*mu2; res(2) = yp(2) - xd + mu1; res(3) = yp(3) - pd + s2*mu1 - c2*mu2; % Dynamical equations res(4) = J1*yp(4) - Q(1) + a*s1*lam1 - a*c1*lam2; res(5) = m2*yp(5) - Q(2) + lam1; res(6) = J2*yp(6) - Q(3) + s2*lam1 - c2*lam2; % Position constraints res(7) = x - c2 - a*c1; res(8) = -s2 - a*s1; % Velocity constraints res(9) = a*s1*qd + xd + s2*pd; res(10) = -a*c1*qd - c2*pd; flag = 0; new_data = []; return % ==================================================================================== % Joint constraint forces % ==================================================================================== function Fc = joint_forces(yy, yp, data) % Compute joint reaction forces for given positins, velocities, and % accelerations. This is done by including the reaction forces and torques, % considering the free body diagrams for the crank and connecting rod, and % writing the dynamical equilibrium equations. % a = data.a; k = data.k; c = data.c; l0 = data.l0; F = data.F; J1 = data.J1; m2 = data.m2; J2 = data.J2; q = yy(1); % crank angle x = yy(2); % slider position p = yy(3); % conecting rod angle qd = yy(4); % crank angular velocity xd = yy(5); % slider horizontal velocity pd = yy(6); % conecting rod angular velocity qdd = yp(4); % crank angular acc. xdd = yp(5); % slider horizontal acc. pdd = yp(6); % connecting rod angular acc. s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x^2 - x*(c2+a*c1) + (1.0 + a^2)/4.0 + a*c21/2.0; l = sqrt(l2); ld = 2.0*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/2.0; ld = ld / (2.0*l); f = k*(l-l0) + c*ld; fl = f/l; % TSDA forces acting on crank and connecting rod Q1A(1) = x-0.5*c2-a/2*c1; Q1A(2) = -0.5*(s2+a*s1); Q1A(3) = -0.5*(a*x*s1+s21); Q2A(1) = -Q1A(1); Q2A(2) = -Q1A(2); Q2A(3) = -0.5*(x*s2+a*s21); Q1A = fl*Q1A'; Q2A = fl*Q2A'; QA = [-Q1A;-Q2A]; % Force F acting on connecting rod FA = [0;0;0;F;0;-F*s2]; % Dynamic forces MA = [0;0;J1*qdd;m2*xdd;0;J2*pdd]; % Dynamic equilibrium equations: % MA = QA+FA + FC % where the joint constraint forces are: % Fc(1) = vertical force in revolute join crank-ground % Fc(2) = horizontal force in revolute join crank-ground % Fc(3) = vertical force in revolute joint crank-connecting rod % Fc(4) = vertical force in revolute joint crank-connecting rod % Fc(5) = vertical force in translational joint % Fc(6) = reaction torque acting in translational joint % and therefore % FC = A * Fc % where % A = [ % 0 1 0 1 0 0 % 1 0 1 0 0 0 % 0 0 a*c1 -1*s1 0 0 % 0 0 0 -1 0 0 % 0 0 -1 0 1 0 % 0 0 -c2 -s2 0 1 % ]; b = MA-QA-FA; Fc(4) = -b(4); Fc(2) = b(1) - Fc(4); if abs(c1) > 0.1 Fc(3) = ( b(3) + a*s1*Fc(4) ) / (a*c1); end Fc(1) = b(2) - Fc(3); Fc(5) = b(5) + Fc(3); Fc(6) = b(6) + c2*Fc(3) + s2*Fc(4); return sundials-2.5.0/sundialsTB/idas/examples_ser/midasHeat2D_bnd.m0000600000175000017500000000767511741421121024770 0ustar sylvestresylvestrefunction midasHeat2D_bnd %midasHeat2D_bnd: 2D heat equation, serial, banded. % % This example solves a discretized 2D heat equation problem. % This version uses the band solver IDABand, and IDACalcIC. % % The DAE system solved is a spatial discretization of the PDE % du/dt = d^2u/dx^2 + d^2u/dy^2 % on the unit square. The boundary condition is u = 0 on all edges. % Initial conditions are given by u = 16 x (1 - x) y (1 - y). % The PDE is treated with central differences on a uniform M x M % grid. The values of u at the interior points satisfy ODEs, and % equations u = 0 at the boundaries are appended, to form a DAE % system of size N = M^2. Here M = 10. % % The system is solved with IDA using the banded linear system % solver, half-bandwidths equal to M, and default % difference-quotient Jacobian. For purposes of illustration, % IDACalcIC is called to compute correct values at the boundary, % given incorrect values as input initial guesses. The constraints % u >= 0 are posed for all components. Output is taken at % t = 0, .01, .02, .04, ..., 10.24. (Output at t = 0 is for % IDACalcIC cost statistics only.) % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ m = 20; N = m^2; data.m = m; data.N = N; data.dx = 1.0/(m-1); data.c = 1.0/data.dx^2; fp = figure; set(gcf,'position',[250 175 560 900]); [t0,yy0,yp0,id,cnstr] = ic(data); % Plot initial guess for IC figure(fp); subplot(2,1,1); hold on hs1 = surf(reshape(yy0,m,m)); shading interp set(hs1,'FaceAlpha',0.35); box on view(-30,30) options = IDASetOptions('UserData',data,... 'RelTol',0.0,... 'AbsTol',1.0e-3,... 'VariableTypes',id,... 'ConstraintTypes',cnstr,... 'LinearSolver','Band',... 'LowerBwidth',m,... 'UpperBwidth',m); IDAInit(@resfun,t0,yy0,yp0,options); tout = 0.01; [status, yy0_mod, yp0_mod] = IDACalcIC(tout, 'FindAlgebraic'); % Plot corrected IC figure(fp); subplot(2,1,1); hs1 = surf(reshape(yy0_mod,m,m)); set(hs1,'FaceColor','none'); % Plot solution subplot(2,1,2); hold on hs1 = surf(reshape(yy0_mod,m,m)); shading interp view(-30,30) zlim_yy = get(gca,'ZLim'); box on fprintf('t = %.4f [Press any key]\n',t0); pause; nout = 5; tout = 0.01; for iout = 1:nout [status,t,yy] = IDASolve(tout,'Normal'); tout = 2*tout; figure(fp); subplot(2,1,2); set(hs1,'FaceAlpha',0.15); hs1 = surf(reshape(yy,m,m)); shading interp set(gca,'ZLim',zlim_yy); fprintf('t = %.4f [Press any key]\n',t); pause; end IDAFree; function [t,yy,yp,id,cnstr] = ic(data) m = data.m; N = data.N; dx = data.dx; id = ones(N,1); cnstr = ones(N,1); yy = zeros(N,1); yp = zeros(N,1); t = 0.0; % Initialize yy on all grid points. */ for j=0:m-1 yfact = dx * j; offset = m*j; for i=0:m-1 xfact = dx * i; loc = offset + i + 1; yy(loc) = 16.0 * xfact * (1.0 - xfact) * yfact * (1.0 - yfact); end end % The residual gives the negative of ODE RHS values at % interior points. yp = zeros(N,1); [yp,flag,new_data] = resfun(t,yy,yp,data); yp = -yp; % Finally, set values of yy, yp, and id at boundary points. for j=0:m-1 offset = m*j; for i=0:m-1 loc = offset + i + 1; if (j == 0 || j == m-1 || i == 0 || i == m-1 ) yy(loc) = 0.1; yp(loc) = 0.0; id(loc) = 0.0; end end end % ==================================================================== function [rr,flag,new_data] = resfun(t,yy,yp,data) m = data.m; N = data.N; dx = data.dx; c = data.c; % Initialize resval to uu, to take care of boundary equations. rr = yy; % Loop over interior points; set rr = yp - (central difference). for j = 1:m-2 offset = m*j; for i = 1:m-2 loc = offset + i + 1; rr(loc) = yp(loc) - c * ... (yy(loc-1) + yy(loc+1) + yy(loc-m) + yy(loc+m) - 4.0*yy(loc)); end end flag = 0; new_data = [];sundials-2.5.0/sundialsTB/idas/examples_ser/midasBruss_ASA_dns.m0000600000175000017500000001711411741421121025511 0ustar sylvestresylvestrefunction midasBruss_ASA_dns %midasBruss_ASA_dns - ASA example for the Brusselator problem % This example solves the forward and adjoint problems for % the 2D Brusselator example. % % See also: midasBruss_dns % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ %-------------- % Problem data %-------------- eps = 2.0e-3; % diffusion param A = 1.0; B = 3.4; % Spatial length 0 <= x,y, <= L L = 1.0; % grid size mx = 20; my = 20; dx = L/mx; dy = L/my; % coefficients in central FD hdif = eps/dx^2; vdif = eps/dy^2; % problem dimension nx = mx+1; ny = my+1; n = 2*nx*ny; x = linspace(0,L,nx); y = linspace(0,L,ny); % Load user data structure data.eps = eps; data.A = A; data.B = B; data.L = L; data.dx = dx; data.dy = dy; data.nx = nx; data.ny = ny; data.x = x; data.y = y; data.hdif = hdif; data.vdif = vdif; % --------------------- % Initialize integrator % --------------------- % Integration limits t0 = 0.0; tf = 1.0; % Initial conditions [u, v] = BRUSic(data); Y = UV2Y(u, v, data); Yp = zeros(n,1); % Specify algebraic variables u_id = ones(ny,nx); u_id(1,:) = 0; u_id(ny,:) = 0; u_id(:,1) = 0; u_id(:,nx) = 0; v_id = ones(ny,nx); v_id(1,:) = 0; v_id(ny,:) = 0; v_id(:,1) = 0; v_id(:,nx) = 0; id = UV2Y(u_id, v_id, data); % Optional inputs options = IDASetOptions('UserData',data,... 'RelTol',1.e-5,... 'AbsTol',1.e-5,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'MaxNumSteps', 1000,... 'LinearSolver','Dense'); % Initialize forward problem IDAInit(@BRUSres,t0,Y,Yp,options); % Compute consistent I.C. [status, Y, Yp] = IDACalcIC(tf, 'FindAlgebraic'); % -------------- % Initialize ASA % -------------- IDAAdjInit(150, 'Hermite'); % --------------- % Integrate to tf % --------------- [status, t, Y] = IDASolve(tf, 'Normal'); [u,v] = Y2UV(Y, data); stats_fwd = IDAGetStats; plotSol(t,Y,data); % --------------------------- % Initialize backward problem % --------------------------- % Specify algebraic variables l_id = ones(ny,nx); l_id(1,:) = 0; l_id(ny,:) = 0; l_id(:,1) = 0; l_id(:,nx) = 0; m_id = ones(ny,nx); m_id(1,:) = 0; m_id(ny,:) = 0; m_id(:,1) = 0; m_id(:,nx) = 0; idB = UV2Y(l_id, m_id, data); % Final conditions l = ones(ny,nx); m = zeros(ny,nx); YB = UV2Y(l, m, data); lp = -2.0 * u .* v .* l + (B+1) * l; mp = - l .* (u.^2); YBp = UV2Y(lp, mp, data); % Optional inputs optionsB = IDASetOptions('UserData',data,... 'RelTol',1.e-5,... 'AbsTol',1.e-5,... 'VariableTypes',id,... 'suppressAlgVars','on',... 'LinearSolver','Dense'); % Initialize backward problem idxB = IDAInitB(@BRUSresB,tf,YB,YBp,optionsB); % -------------------------- % Backward integration to t0 % -------------------------- [status, t, YB] = IDASolveB(t0,'Normal'); plotSol(t,YB,data); % ----------- % Free memory % ----------- IDAFree; return % ==================================================================================== % Initial conditions % ==================================================================================== function [u0, v0] = BRUSic(data) dx = data.dx; dy = data.dy; nx = data.nx; ny = data.ny; L = data.L; x = data.x; y = data.y; n = 2*nx*ny; [x2D , y2D] = meshgrid(x,y); u0 = 1.0 - 0.5 * cos(pi*y2D/L); u0(1,:) = u0(2,:); u0(ny,:) = u0(ny-1,:); u0(:,1) = u0(:,2); u0(:,nx) = u0(:,nx-1); v0 = 3.5 - 2.5*cos(pi*x2D/L); v0(1,:) = v0(2,:); v0(ny,:) = v0(ny-1,:); v0(:,1) = v0(:,2); v0(:,nx) = v0(:,nx-1); return % ==================================================================================== % Residual function % ==================================================================================== function [res, flag, new_data] = BRUSres(t,Y,Yp,data) nx = data.nx; ny = data.ny; A = data.A; B = data.B; hdif = data.hdif; vdif = data.vdif; % Convert Y and Yp to (u,v) and (up, vp) [u,v] = Y2UV(Y,data); [up,vp] = Y2UV(Yp,data); % 2D residuals ru = zeros(ny,nx); rv = zeros(ny,nx); % Inside the domain for iy = 2:ny-1 for ix = 2:nx-1 uu = u(iy,ix); vv = v(iy,ix); ru(iy,ix) = up(iy,ix) ... - hdif * ( u(iy,ix+1) - 2*uu + u(iy,ix-1) ) ... - vdif * ( u(iy+1,ix) - 2*uu + u(iy-1,ix) ) ... - A + (B+1)*uu - uu^2 * vv; rv(iy,ix) = vp(iy,ix) ... - hdif * ( v(iy,ix+1) - 2*vv + v(iy,ix-1) ) ... - vdif * ( v(iy+1,ix) - 2*vv + v(iy-1,ix) ) ... - B*uu + uu^2 * vv; end end % Boundary conditions ru(1,:) = u(1,:) - u(2,:); ru(ny,:) = u(ny,:) - u(ny-1,:); ru(:,1) = u(:,1) - u(:,2); ru(:,nx) = u(:,nx) - u(:,nx-1); rv(1,:) = v(1,:) - v(2,:); rv(ny,:) = v(ny,:) - v(ny-1,:); rv(:,1) = v(:,1) - v(:,2); rv(:,nx) = v(:,nx) - v(:,nx-1); % Convert (ru,rv) to res res = UV2Y(ru,rv,data); % Return flag and pb. data flag = 0; new_data = []; % ==================================================================================== % Backward residual function % ==================================================================================== function [resB, flag, new_data] = BRUSresB(t, Y, Yp, YB, YBp, data) nx = data.nx; ny = data.ny; A = data.A; B = data.B; hdif = data.hdif; vdif = data.vdif; % Convert Y to (u,v) [u,v] = Y2UV(Y,data); % Convert YB and YBp to (l,m) and (lp,mp) [l,m] = Y2UV(YB,data); [lp,mp] = Y2UV(YBp,data); % 2D residuals rl = zeros(ny,nx); rm = zeros(ny,nx); % Inside the domain for iy = 2:ny-1 for ix = 2:nx-1 uu = u(iy,ix); vv = v(iy,ix); ll = l(iy,ix); mm = m(iy,ix); rl(iy,ix) = lp(iy,ix) ... + hdif * ( l(iy,ix+1) - 2*ll + l(iy,ix-1) ) ... + vdif * ( l(iy+1,ix) - 2*ll + l(iy-1,ix) ) ... + 2*uu*vv*ll - (B+1)*ll + B*mm - 2*uu*vv*mm; rm(iy,ix) = mp(iy,ix) ... + hdif * ( m(iy,ix+1) - 2*mm + m(iy,ix-1) ) ... + vdif * ( m(iy+1,ix) - 2*mm + m(iy-1,ix) ) ... + ll * uu^2 - mm * uu^2; end end % Boundary conditions rl(1,:) = l(1,:) - l(2,:); rl(ny,:) = l(ny,:) - l(ny-1,:); rl(:,1) = l(:,1) - l(:,2); rl(:,nx) = l(:,nx) - l(:,nx-1); rm(1,:) = m(1,:) - m(2,:); rm(ny,:) = m(ny,:) - m(ny-1,:); rm(:,1) = m(:,1) - m(:,2); rm(:,nx) = m(:,nx) - m(:,nx-1); % Convert (rl,rm) to resB resB = UV2Y(rl,rm,data); % Return flag and pb. data flag = 0; new_data = []; % ==================================================================================== % 1D <-> 2D conversion functions % ==================================================================================== function y = UV2Y(u, v, data) nx = data.nx; ny = data.ny; u1 = reshape(u, 1, nx*ny); v1 = reshape(v, 1, nx*ny); y = reshape([u1;v1], 2*nx*ny,1); return function [u,v] = Y2UV(y, data) nx = data.nx; ny = data.ny; y2 = reshape(y, 2, nx*ny); u = reshape(y2(1,:), ny, nx); v = reshape(y2(2,:), ny, nx); return % ==================================================================================== % Plot (u,v) % ==================================================================================== function plotSol(t,Y,data) x = data.x; y = data.y; [u,v] = Y2UV(Y, data); figure; set(gcf,'position',[600 600 650 300]) subplot(1,2,1) surfc(x,y,u); shading interp %view(0,90) view(-15,35) axis tight box on grid off xlabel('x'); ylabel('y'); title(sprintf('u(x,y,%g)',t)) %colorbar('horiz'); subplot(1,2,2) surfc(x,y,v); shading interp %view(0,90) view(-15,35) axis tight box on grid off xlabel('x'); ylabel('y'); title(sprintf('v(x,y,%g)',t)) %colorbar('horiz'); return sundials-2.5.0/sundialsTB/idas/examples_ser/midasPendI1_dns.m0000600000175000017500000000754711741421121025020 0ustar sylvestresylvestrefunction midasPendI1_dns %midasPendI1_dns - Simple pendulum modeled as an index-1 DAE % The pendulum is modeled using the x and y positions with % the constraint x^2 + y^2 = L^2 % The index-1 DAE formulation (in first-order form) includes % differential equations for the positions and velocities and % the acceleration-level constraint. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ % x, y, vx, vy, lam neq = 5; t0 = 0.0; tf = 10.0; id = ones(neq,1); id(5) = 0; options = IDASetOptions('RelTol',1.e-6,... 'AbsTol',1.e-6,... 'VariableTypes',id,... 'MaxNumSteps', 1000,... 'LinearSolver','Dense',... 'JacobianFn',@pend_J); %mondata.update = 100; %options = IDASetOptions(options,'MonitorFn',@IDAMonitor,'MonitorData',mondata); y0 = zeros(neq,1); y0(1) = 1.0; y0(5) = 0.1; yp0 = zeros(neq,1); fprintf('Estimated IC\n'); disp([y0 yp0]) IDAInit(@pend_f,t0,y0,yp0,options); [status, y0_mod, yp0_mod] = IDACalcIC(tf, 'FindAlgebraic'); fprintf('Corrected IC\n'); disp([y0_mod yp0_mod]) it = 1; time(it) = t0; sol_y(it,:) = y0_mod'; [pc(it) vc(it)] = pend_constr(t0,y0_mod); %t = t0; %t_start = clock; %while t < tf % [status,t,y] = IDASolve(tf,'OneStep'); % it = it+1; % time(it) = t; % sol_y(it,:) = y'; % % Compute position and velocity constraint violations % [pc(it) vc(it)] = pend_constr(t,y); %end %runtime = etime(clock,t_start); dt = 0.1; nt = ceil((tf-t0)/dt); t_start = clock; for it = 1:nt tout = t0 + it*dt; [status,t,y] = IDASolve(tout,'Normal'); time(it) = t; sol_y(it,:) = y'; % Compute position and velocity constraint violations [pc(it) vc(it)] = pend_constr(t,y); end runtime = etime(clock,t_start); fprintf('Solver stats:\n'); disp(IDAGetStats); fprintf('Run time: %f\n',runtime); figure; subplot(3,1,1) hold on plot(time,sol_y(:,1),'b'); plot(time,sol_y(:,2),'r'); box on set(gca,'XLim',[t0 tf]) title('position'); legend('x','y'); subplot(3,1,2) hold on plot(time,sol_y(:,3),'b'); plot(time,sol_y(:,4),'r'); box on set(gca,'XLim',[t0 tf]) title('velocity'); legend('v_x', 'v_y'); subplot(3,1,3) plot(time,sol_y(:,5)); box on set(gca,'XLim',[t0 tf]) title('Lagrange multiplier'); figure plotyy(time, pc, time, vc); box on title('position and velocity constraint violations'); figure subplot(2,1,1) plot(sol_y(:,1),sol_y(:,2)); axis equal axis tight box on grid on xlabel('x'); ylabel('y'); title('trajectory'); phi = atan2( sol_y(:,1) , sol_y(:,2) ); phi_d = ( sol_y(:,1).*sol_y(:,4) - sol_y(:,2).*sol_y(:,3) ) ./ ( sol_y(:,1).^2 + sol_y(:,2).^2 ) ; subplot(2,1,2) plot3(time,phi, phi_d); xlabel('time'); ylabel('\phi'); zlabel('\phi^\prime'); view(-30,15); set(gca,'XLim',[t0 tf]) grid on box on title('phase plot'); IDAFree; % ================================================================================ function [res, flag, new_data] = pend_f(t,y,yp) % Residual function for a simple pendulum % mass = 1.0 % length = 1.0 % damping coeff. = 0.3 % g = 9.81 res = [ -yp(1) + y(3) -yp(2) + y(4) -yp(3) - 2*y(1)*y(5) - 0.3*y(3) -yp(4) + 9.81 - 2*y(2)*y(5) - 0.3*y(4) -2*y(5) + y(3)^2 - 0.3*y(1)*y(3) + y(4)^2 + y(2)*(9.81-0.3*y(4)) ]; flag = 0; new_data = []; % ================================================================================ function [J, flag, new_data] = pend_J(t,y,yp, rr, cj) J = [ -cj 0 1 0 0 0 -cj 0 1 0 -2*y(5) 0 -cj-0.3 0 -2*y(1) 0 -2*y(5) 0 -cj-0.3 -2*y(2) -0.3*y(3) 9.81-0.3*y(4) 2*y(3)-0.3*y(1) 2*y(4)-0.3*y(2) -2 ]; flag = 0; new_data = []; % ================================================================================ function [pc, vc] = pend_constr(t,y) % Position and velocity constraints % pc = y(1)^2 + y(2)^2 - 1.0; vc = y(1)*y(3) + y(2)*y(4);sundials-2.5.0/sundialsTB/idas/IDAMonitor_octave.m0000600000175000017500000003033011741421121022657 0ustar sylvestresylvestrefunction [new_data] = IDAMonitor(call, T, Y, YQ, YS, data) %IDAMonitor is the default IDAS monitoring function. % To use it, set the Monitor property in IDASetOptions to % 'IDAMonitor' or to @IDAMonitor and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to IDASetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see IDAGetStats) % o sol [ true | {false} ] % If true, plot solution components. % o sensi [ true | {false} ] % If true and if FSA is enabled, plot sensitivity components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also IDASetOptions, IDAMonitorFn % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to IDASetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:38:42 $ % NOTES: % - Unlike Matlab, Octave loads children in the normal order % - Unlike Matlab, Octave stores 'XData' and 'YData' as column vectors if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end if data.sol | data.sensi data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y and YS for additional initializations if data.first if isempty(YS) data.sensi = false; end if data.sol | data.sensi if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end if data.sensi data.Ns = size(YS,2); data.ys = zeros(data.N, data.Ns, data.updt); data.nps = data.nps + data.Ns; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; Ns = data.Ns; y = data.y; ys = data.ys; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = IDAGetStats; t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end if data.sensi for k = 1:Ns for j = 1:N ys(j,k,n) = YS(data.select(j),k); end end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol | data.sensi sol_init(n, hfs, nps, data.sol, data.sensi, ... N, Ns, t, y, ys); end data.initialized = true; else if (data.stats | data.cntr) graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, data.sensi, N, Ns, t, y, ys); end end if call == 2 if (data.stats | data.cntr) graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol | data.sensi sol_final(hfs, nps, data.sol, data.sensi, N, Ns); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.ys = ys; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'sensi') data.sensi = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end if ~data.sol & ~data.sensi data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.Ns = 0; data.y = 0; data.ys = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Time label and figure title tlab = '-> t ->'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; abs(h(1:n)')]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; q(1:n)']; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; yd = [get(hc(1),'YData') ; ncfn(1:n)']; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') ; netf(1:n)']; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') ; nni(1:n)']; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') ; nfe(1:n)']; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') ; nst(1:n)']; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); % Time label tlab = '-> t ->'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hold on; ys_crt = ys(:,is,1:n); for i = 1:N hp = plot(t(1:n),ys_crt(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); str = sprintf('s_{%d}',is); ylabel(str); str = sprintf('Sensitivity %d',is); title(str); end end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; y(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); ys_crt = ys(:,is,:); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; ys_crt(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, sensi, N, Ns) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('s%d_{%d}',is,i); end legend(cstring); end end drawnow sundials-2.5.0/sundialsTB/idas/IDASensToggleOff.m0000600000175000017500000000075011741421121022377 0ustar sylvestresylvestrefunction status = IDASensToggleOff() % IDASensToggleOff deactivates sensitivity calculations. % It does NOT deallocate sensitivity-related memory so that % sensitivity computations can be later toggled ON (through % IDASensReInit). % % Usage: IDASensToggleOff % % See also: IDASensInit, IDASensReInit % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:19 $ mode = 18; status = idm(mode); sundials-2.5.0/sundialsTB/idas/IDAQuadReInitB.m0000600000175000017500000000144611741421121022004 0ustar sylvestresylvestrefunction status = IDAQuadReInitB(idxB, yQB0, optionsB) %IDAQuadReInitB reinitializes memory for backward quadrature integration. % % Usage: IDAQuadReInitB ( IDXB, YS0 [, OPTIONS ] ) % % IDXB is the index of the backward problem, returned by % IDAInitB. % YQB0 is the final conditions vector yQB(tB0). % OPTIONS is an (optional) set of QUAD options, created with % the IDASetQuadOptions function. % % See also: IDASetQuadOptions, IDAReInitB, IDAQuadInitB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 16; if nargin < 2 error('Too few input arguments'); end if nargin < 3 optionsB = []; end idxB = idxB-1; status = idm(mode, idxB, yQB0, optionsB); sundials-2.5.0/sundialsTB/idas/IDAAdjReInit.m0000600000175000017500000000044711741421121021506 0ustar sylvestresylvestrefunction status = IDAAdjReInit() %IDAAdjReInit re-initializes memory for ASA with CVODES. % % Usage: IDAAdjReInit % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 14; status = idm(mode); sundials-2.5.0/sundialsTB/idas/IDAInitB.m0000600000175000017500000000227511741421121020703 0ustar sylvestresylvestrefunction [idxB, status] = IDAInitB(fctB, tB0, yyB0, ypB0, optionsB) %IDAInitB allocates and initializes backward memory for CVODES. % % Usage: IDXB = IDAInitB ( DAEFUNB, TB0, YYB0, YPB0 [, OPTIONSB] ) % % DAEFUNB is a function defining the adjoint DAE: F(t,y,y',yB,yB')=0 % This function must return a vector containing the current % value of the adjoint DAE residual. % TB0 is the final value of t. % YYB0 is the final condition vector yB(tB0). % YPB0 is the final condition vector yB'(tB0). % OPTIONSB is an (optional) set of integration options, created with % the IDASetOptions function. % % IDAInitB returns the index IDXB associated with this backward % problem. This index must be passed as an argument to any subsequent % functions related to this backward problem. % % See also: IDASetOptions, IDAResFnB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 5; if nargin < 4 error('Too few input arguments'); end if nargin < 5 optionsB = []; end [idxB, status] = idm(mode, fctB, tB0, yyB0, ypB0, optionsB); idxB = idxB+1; sundials-2.5.0/sundialsTB/idas/IDASet.m0000600000175000017500000000300711741421121020423 0ustar sylvestresylvestrefunction status = IDASet(varargin) %IDASet changes optional input values during the integration. % % Usage: IDASet('NAME1',VALUE1,'NAME2',VALUE2,...) % % IDASet can be used to change some of the optional inputs during % the integration, i.e., without need for a solver reinitialization. % The property names accepted by IDASet are a subset of those valid % for IDASetOptions. Any unspecified properties are left unchanged. % % IDASet with no input arguments displays all property names. % %IDASet properties %(See also the IDAS User Guide) % %UserData - problem data passed unmodified to all user functions. % Set VALUE to be the new user data. %RelTol - Relative tolerance % Set VALUE to the new relative tolerance %AbsTol - absolute tolerance % Set VALUE to be either the new scalar absolute tolerance or % a vector of absolute tolerances, one for each solution component. %StopTime - Stopping time % Set VALUE to be a new value for the independent variable past which % the solution is not to proceed. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ if (nargin == 0) fprintf(' UserData\n'); fprintf('\n'); fprintf(' RelTol\n'); fprintf(' AbsTol\n'); fprintf(' StopTime\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'RelTol' 'AbsTol' 'StopTime' }; options = idm_options(KeyNames,varargin{:}); mode = 33; status = idm(mode, options); sundials-2.5.0/sundialsTB/idas/IDACalcIC.m0000600000175000017500000000664411741421121020760 0ustar sylvestresylvestrefunction [status, varargout] = IDACalcIC(tout,icmeth) %IDACalcIC computes consistent initial conditions % % Usage: STATUS = IDACalcIC ( TOUT, ICMETH ) % [STATUS, YY0, YP0] = IDACalcIC ( TOUT, ICMETH ) % % IDACalcIC corrects the guess for initial conditions passed % to IDAInit or IDAReInit so that the algebraic constraints % are satisfied. % % The argument TOUT is the first value of t at which a soluton will be % requested (from IDASolve). This is needed here to determine the % direction of integration and rough scale in the independent variable. % % If ICMETH is 'FindAlgebraic', then IDACalcIC attempts to compute % the algebraic components of y and differential components of y', % given the differential components of y. % This option requires that the vector id was set through IDASetOptions % specifying the differential and algebraic components. % If ICMETH is 'FindAll', then IDACalcIC attempts to compute all % components of y, given y'. In this case, id is not required. % % On return, STATUS is one of the following: % SUCCESS IDACalcIC was successful. The corrected % initial value vectors are in y0 and yp0. % IDA_MEM_NULL The argument ida_mem was NULL. % IDA_ILL_INPUT One of the input arguments was illegal. % See printed message. % IDA_LINIT_FAIL The linear solver's init routine failed. % IDA_BAD_EWT Some component of the error weight vector % is zero (illegal), either for the input % value of y0 or a corrected value. % IDA_RES_FAIL The user's residual routine returned % a non-recoverable error flag. % IDA_FIRST_RES_FAIL The user's residual routine returned % a recoverable error flag on the first call, % but IDACalcIC was unable to recover. % IDA_LSETUP_FAIL The linear solver's setup routine had a % non-recoverable error. % IDA_LSOLVE_FAIL The linear solver's solve routine had a % non-recoverable error. % IDA_NO_RECOVERY The user's residual routine, or the linear % solver's setup or solve routine had a % recoverable error, but IDACalcIC was % unable to recover. % IDA_CONSTR_FAIL IDACalcIC was unable to find a solution % satisfying the inequality constraints. % IDA_LINESEARCH_FAIL The Linesearch algorithm failed to find a % solution with a step larger than steptol % in weighted RMS norm. % IDA_CONV_FAIL IDACalcIC failed to get convergence of the % Newton iterations. % % If the output arguments YY0 and YP0 are present, they will % contain the consistent initial conditions. % % See also: IDASetOptions, IDAInit, IDAReInit % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/08/21 17:38:42 $ mode = 25; if nargout == 1 status = idm(mode, tout, icmeth); elseif nargout == 3 [status, yy, yp] = idm(mode, tout, icmeth); varargout(1) = {yy}; varargout(2) = {yp}; else disp('IDACalcIC:: wrong number of output arguments'); end sundials-2.5.0/sundialsTB/idas/IDASensInit.m0000600000175000017500000000207011741421121021423 0ustar sylvestresylvestrefunction status = IDASensInit(Ns,fctS,yyS0,ypS0,options) %IDASensInit allocates and initializes memory for FSA with IDAS. % % Usage: IDASensInit ( NS, SFUN, YYS0, YPS0 [, OPTIONS ] ) % % NS is the number of parameters with respect to which sensitivities % are desired % SFUN is a function defining the residual of the sensitivity DAEs % fS(t,y,yp,yS,ypS). % YYS0, YPS0 Initial conditions for sensitivity variables. % YYS0 and YPS0 must be matrices with N rows and Ns columns, where N is % the problem dimension and Ns the number of sensitivity systems. % OPTIONS is an (optional) set of FSA options, created with % the IDASetFSAOptions function. % % See also IDASensSetOptions, IDAInit, IDASensResFn % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ mode = 3; if nargin < 4 error('Too few input arguments'); end if nargin < 5 options = []; end status = idm(mode, Ns, fctS, yyS0, ypS0, options); sundials-2.5.0/sundialsTB/idas/IDAMonitorB_octave.m0000600000175000017500000002435111741421121022767 0ustar sylvestresylvestrefunction [new_data] = IDAMonitorB(call, idxB, T, Y, YQ, data) %IDAMonitorB is the default IDAS monitoring function for backward problems. % To use it, set the Monitor property in IDASetOptions to % 'IDAMonitorB' or to @IDAMonitorB and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to IDASetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see IDAGetStats) % o sol [ true | {false} ] % If true, plot solution components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also IDASetOptions, IDAMonitorFnB % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to IDASetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:38:42 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end if data.sol data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y for additional initializations if data.first if data.sol if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; y = data.y; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = IDAGetStatsB(idxB); t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_init(n, hfs, nps, data.sol, ... N, t, y); end data.initialized = true; else if (data.stats | data.cntr) graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, N, t, y); end end if call == 2 if (data.stats | data.cntr) graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol sol_final(hfs, nps, data.sol, N); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end if ~data.sol data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.y = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Time label and figure title tlab = '<- t <-'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; abs(h(1:n)')]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; q(1:n)']; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; yd = [get(hc(5),'YData') ; ncfn(1:n)']; set(hc(5), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') ; netf(1:n)']; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') ; nni(1:n)']; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') ; nfe(1:n)']; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(1),'YData') ; nst(1:n)']; set(hc(1), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, N, t, y) figure(hfs); % Time label tlab = '<- t <-'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, N, t, y) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; y(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, N) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end drawnow sundials-2.5.0/sundialsTB/idas/IDAMonitorB.m0000600000175000017500000003446111741421121021431 0ustar sylvestresylvestrefunction [new_data] = IDAMonitorB(call, idxB, T, Y, YQ, data) %IDAMonitorB is the default IDAS monitoring function for backward problems. % To use it, set the Monitor property in IDASetOptions to % 'IDAMonitorB' or to @IDAMonitorB and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to IDASetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see IDAGetStats) % o mode [ {'graphical'} | 'text' | 'both' ] % In graphical mode, plot the evolutions of the above quantities. % In text mode, print a table. % o sol [ true | {false} ] % If true, plot solution components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also IDASetOptions, IDAMonitorFnB % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to IDASetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2009/04/22 04:25:06 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.grph if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end end if data.text if data.cntr | data.stats data.hft = figure; end end if data.sol data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y for additional initializations if data.first if data.sol if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; y = data.y; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = IDAGetStatsB(idxB); t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) & data.grph graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_init(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_init(n, hfs, nps, data.sol, ... N, t, y); end data.initialized = true; else if (data.stats | data.cntr) & data.grph graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_update(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, N, t, y); end end if call == 2 if (data.stats | data.cntr) & data.grph graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol sol_final(hfs, nps, data.sol, N); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'mode') data.mode = 'graphical'; end if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end data.grph = true; data.text = true; if strcmp(data.mode,'graphical') data.text = false; end if strcmp(data.mode,'text') data.grph = false; end if ~data.sol data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.y = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) fig_name = 'IDAS run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfg); set(hfg,'Name',fig_name); set(hfg,'color',[1 1 1]); pl = 0; % Time label and figure title tlab = '\leftarrow t \leftarrow'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') abs(h(1:n))]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') q(1:n)]; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); % Attention: Children are loaded in reverse order! xd = [get(hc(1),'XData') t(1:n)]; yd = [get(hc(1),'YData') ncfn(1:n)]; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') netf(1:n)]; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') nni(1:n)]; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') nfe(1:n)]; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') nst(1:n)]; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = text_init(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) fig_name = 'IDAS run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hft); set(hft,'Name',fig_name); set(hft,'color',[1 1 1]); set(hft,'MenuBar','none'); set(hft,'Resize','off'); % Create text box margins=[10 10 50 50]; % left, right, top, bottom pos=get(hft,'position'); tbpos=[margins(1) margins(4) pos(3)-margins(1)-margins(2) ... pos(4)-margins(3)-margins(4)]; tbpos(tbpos<1)=1; htb=uicontrol(hft,'style','listbox','position',tbpos,'tag','textbox'); set(htb,'BackgroundColor',[1 1 1]); set(htb,'SelectionHighlight','off'); set(htb,'FontName','courier'); % Create table head tpos = [tbpos(1) tbpos(2)+tbpos(4)+10 tbpos(3) 20]; ht=uicontrol(hft,'style','text','position',tpos,'tag','text'); set(ht,'BackgroundColor',[1 1 1]); set(ht,'HorizontalAlignment','left'); set(ht,'FontName','courier'); newline = ' time step order | nst nfe nni netf ncfn'; set(ht,'String',newline); % Create OK button bsize=[60,28]; badjustpos=[0,25]; bpos=[pos(3)/2-bsize(1)/2+badjustpos(1) -bsize(2)/2+badjustpos(2)... bsize(1) bsize(2)]; bpos=round(bpos); bpos(bpos<1)=1; hb=uicontrol(hft,'style','pushbutton','position',bpos,... 'string','Close','tag','okaybutton'); set(hb,'callback','close'); % Save handles handles=guihandles(hft); guidata(hft,handles); for i = 1:n newline = ''; if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = text_update(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) figure(hft); handles=guidata(hft); for i = 1:n if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, N, t, y) fig_name = 'IDAS solution'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfs); set(hfs,'Name',fig_name); set(hfs,'color',[1 1 1]); % Time label tlab = '\leftarrow t \leftarrow'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, N, t, y) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') y(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, N) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end drawnow sundials-2.5.0/sundialsTB/idas/IDASolve.m0000600000175000017500000000444511741421121020767 0ustar sylvestresylvestrefunction [varargout] = IDASolve(tout,itask) %IDASolve integrates the DAE. % % Usage: [STATUS, T, Y] = IDASolve ( TOUT, ITASK ) % [STATUS, T, Y, YQ] = IDASolve (TOUT, ITASK ) % [STATUS, T, Y, YS] = IDASolve ( TOUT, ITASK ) % [STATUS, T, Y, YQ, YS] = IDASolve ( TOUT, ITASK ) % % If ITASK is 'Normal', then the solver integrates from its current internal % T value to a point at or beyond TOUT, then interpolates to T = TOUT and returns % Y(TOUT). If ITASK is 'OneStep', then the solver takes one internal time step % and returns in Y the solution at the new internal time. In this case, TOUT % is used only during the first call to IDASolve to determine the direction of % integration and the rough scale of the problem. In either case, the time % reached by the solver is returned in T. % % If quadratures were computed (see IDAQuadInit), IDASolve will return their % values at T in the vector YQ. % % If sensitivity calculations were enabled (see IDASensInit), IDASolve will % return their values at T in the matrix YS. Each row in the matrix YS % represents the sensitivity vector with respect to one of the problem parameters. % % In ITASK =' Normal' mode, to obtain solutions at specific times T0,T1,...,TFINAL % (all increasing or all decreasing) use TOUT = [T0 T1 ... TFINAL]. In this case % the output arguments Y and YQ are matrices, each column representing the solution % vector at the corresponding time returned in the vector T. If computed, the % sensitivities are eturned in the 3-dimensional array YS, with YS(:,:,I) representing % the sensitivity vectors at the time T(I). % % On return, STATUS is one of the following: % 0: IDASolve succeeded and no roots were found. % 1: IDASolve succeded and returned at tstop. % 2: IDASolve succeeded, and found one or more roots. % -1: An error occurred (see printed message). % % See also IDASetOptions, IDAGetStats % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.5 $Date: 2011/06/01 22:05:01 $ mode = 20; if nargin ~= 2 error('Wrong number of input arguments'); end if nargout < 3 || nargout > 5 error('Wrong number of output arguments'); end varargout = cell (nargout, 1); [varargout{:}] = idm(mode,tout,itask); sundials-2.5.0/sundialsTB/idas/function_types/0000755000175000017500000000000011767174700022275 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/idas/function_types/IDAGcommFn.m0000600000175000017500000000305011741421121024265 0ustar sylvestresylvestre%IDAGcommFn - type for communication function (BBDPre). % % The function GCOMFUN must be defined as % FUNCTION FLAG = GCOMFUN(T, YY, YP) % and can be used to perform all interprocess communication necessary % to evaluate the approximate residual function for the BBDPre % preconditioner module. % If a user data structure DATA was specified in IDAInit, then % GCOMFUN must be defined as % FUNCTION [FLAG, NEW_DATA] = GCOMFUN(T, YY, YP, DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then the GCOMFUN function must also % set NEW_DATA. Otherwise, it should set NEW_DATA=[] (do not set % NEW_DATA = DATA as it would lead to unnecessary copying). % % The function GCOMFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAGlocalFn, IDASetOptions % % NOTES: % GCOMFUN is specified through the GcommFn property in IDASetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % % Each call to GCOMFUN is preceded by a call to the residual function % DAEFUN with the same arguments T, YY, and YP. % Thus GCOMFUN can omit any communication done by DAEFUN if relevant % to the evaluation of G by GLOCFUN. If all necessary communication % was done by DAEFUN, GCOMFUN need not be provided. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAPrecSetupFn.m0000600000175000017500000000525211741421121025143 0ustar sylvestresylvestre%IDAPrecSetupFn - type for preconditioner setup function. % % The user-supplied preconditioner setup function PSETFUN and % the user-supplied preconditioner solve function PSOLFUN % together must define a preconditoner matrix P which is an % approximation to the Newton matrix M = J_yy - cj*J_yp. % Here J_yy = df/dyy, J_yp = df/dyp, and cj is a scalar proportional % to the integration step size h. The solution of systems P z = r, % is to be carried out by the PrecSolve function, and PSETFUN % is to do any necessary setup operations. % % The user-supplied preconditioner setup function PSETFUN % is to evaluate and preprocess any Jacobian-related data % needed by the preconditioner solve function PSOLFUN. % This might include forming a crude approximate Jacobian, % and performing an LU factorization on the resulting % approximation to M. This function will not be called in % advance of every call to PSOLFUN, but instead will be called % only as often as necessary to achieve convergence within the % Newton iteration. If the PSOLFUN function needs no % preparation, the PSETFUN function need not be provided. % % Each call to the PSETFUN function is preceded by a call to % DAEFUN with the same (t,yy,yp) arguments. Thus the PSETFUN % function can use any auxiliary data that is computed and % saved by the DAEFUN function and made accessible to PSETFUN. % % The function PSETFUN must be defined as % FUNCTION FLAG = PSETFUN(T,YY,YP,RR,CJ) % If successful, it must return FLAG=0. For a recoverable error (in % which case the setup will be retried) it must set FLAG to a positive % integer value. If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the integration will be halted. % The input argument RR contains the current value of f(t,yy,yp). % % If a user data structure DATA was specified in IDASetUserData, then % PSETFUN must be defined as % FUNCTION [FLAG,NEW_DATA] = PSETFUN(T,YY,YP,RR,CJ,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the flag % FLAG, the PSETFUN function must also set NEW_DATA. Otherwise, it % should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead % to unnecessary copying). % % See also IDAPrecSolveFn, IDASetOptions % % NOTE: PSETFUN and PSETFUNB are specified through the property % PrecSetupFn to IDASetOptions and are used only if the property % LinearSolver was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/18 23:55:40 $ sundials-2.5.0/sundialsTB/idas/function_types/IDABandJacFn.m0000600000175000017500000000253411741421121024513 0ustar sylvestresylvestre%IDABandJacFn - type for banded Jacobian function. % % The function BJACFUN must be defined as % FUNCTION [J, FLAG] = BJACFUN(T, YY, YP, RR, CJ) % and must return a matrix J corresponding to the banded Jacobian % (df/dyy + cj*df/dyp). % The input argument RR contains the current value of f(t,yy,yp). % If a user data structure DATA was specified in IDAInit, then % BJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = BJACFUN(T, YY, YP, RR, CJ, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J, % the BJACFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function BJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDASetOptions % % See the IDAS user guide for more information on the structure of % a banded Jacobian. % % NOTE: BJACFUN is specified through the property JacobianFn to % IDASetOptions and is used only if the property LinearSolver % was set to 'Band'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAMonitorFn.m0000600000175000017500000000551611741421121024663 0ustar sylvestresylvestre%IDAMonitorFn - type for monitoring function. % % The function MONFUN must be defined as % FUNCTION [] = MONFUN(CALL, T, YY, YP, YQ, YYS, YPS) % % To enable monitoring using a given monitor function MONFUN, % use IDASetOptions to set the property 'MonitorFn" to 'MONFUN' % (or to @MONFUN). % % MONFUN is called with the following input arguments: % % o CALL indicates the phase during the integration process at which % MONFUN is called: % CALL=1 : MONFUN was called at the initial time; this can be either % after IDAInit or after IDAReInit. % (typically, MONFUN should perform its own initialization) % CALL=2 : MONFUN was called right before a solver reinitializtion. % (typically, MONFUN should decide whether to initialize % itself or else to continue monitoring) % CALL=3 : MONFUN was called during solver finalization. % (typically, MONFUN should finalize monitoring) % CALL=0 : MONFUN was called after the solver took a successful % internal step. % (typically, MONFUN should collect and/or display data) % % o T is the current integration time % % o YY and YP are vectors containing the solution and solution % derivative at time T % % o YQ is a vector containing the quadrature variables at time T % % o YYS and YPS are matrices containing the forward sensitivities % and their derivatives, respectively, at time T. % % If additional data is needed inside a MONFUN function, then it must % be defined as % FUNCTION NEW_MONDATA = MONFUN(CALL, T, YY, YP, YQ, YYS, YPS, MONDATA) % % In this case, the MONFUN function is passed the additional argument % MONDATA, the same as that specified through the property 'MonitorData' % in IDASetOptions. If the local modifications to the monitor data structure % need to be saved (e.g. for future calls to MONFUN), then MONFUN must set % NEW_MONDATA. Otherwise, it should set NEW_MONDATA=[] (do not set % NEW_MONDATA = DATA as it would lead to unnecessary copying). % % NOTES: % % 1. MONFUN is specified through the MonitorFn property in IDASetOptions. % If this property is not set, or if it is empty, MONFUN is not used. % MONDATA is specified through the MonitorData property in IDASetOptions. % % 2. If quadrature integration is not enabled, YQ is empty. Similarly, if % forward sensitivity analysis is not enabled, YYS and YPS are empty. % % 3. When CALL = 2 or 3, all arguments YY, YP, YQ, YYS, and YPS are empty. % Moreover, when CALL = 3, T = 0.0 % % 4. If MONFUN is used on the backward integration phase, YYS and YPS are % always empty. % % See also IDASetOptions, IDAMonitor % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDARootFn.m0000600000175000017500000000211511741421121024147 0ustar sylvestresylvestre%IDARootFn - type for user provided root-finding function. % % The function ROOTFUN must be defined as % FUNCTION [G, FLAG] = ROOTFUN(T,YY,YP) % and must return a vector G corresponding to g(t,yy,yp). % If a user data structure DATA was specified in IDAInit, then % ROOTFUN must be defined as % FUNCTION [G, FLAG, NEW_DATA] = ROOTFUN(T,YY,YP,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector G, % the ROOTFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function ROOTFUN must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also IDASetOptions % % NOTE: ROOTFUN is specified through the RootsFn property in % IDASetOptions and is used only if the property NumRoots is a % positive integer. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAPrecSolveFnB.m0000600000175000017500000000170111741421121025230 0ustar sylvestresylvestre%IDAPrecSolveFnB - type for preconditioner solve function. % % The user-supplied preconditioner solve function PSOLFUNB % is to solve a linear system P z = r, where P is the % preconditioner matrix. % % The function PSOLFUNB must be defined either as % FUNCTION [ZB,FLAG] = PSOLFUNB(T,YY,YP,YYB,YPB,RRB,RB) % or as % FUNCTION [ZB,FLAG,NEW_DATA] = PSOLFUNB(T,YY,YP,YYB,YPB,RRB,RB,DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the vector ZB and the % flag FLAG. % % See also IDAPrecSetupFnB, IDAPrecSolveFn, IDASetOptions % % NOTE: PSOLFUN and PSOLFUNB are specified through the property % PrecSolveFn to IDASetOptions and are used only if the property % LinearSolver was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAGcommFnB.m0000600000175000017500000000230311741421121024367 0ustar sylvestresylvestre%IDAGcommFnB - type for communication function (BBDPre) for backward problems. % % The function GCOMFUNB must be defined either as % FUNCTION FLAG = GCOMFUNB(T, YY, YP, YYB, YPB) % or as % FUNCTION [FLAG, NEW_DATA] = GCOMFUNB(T, YY, YP, YYB, YPB, DATA) % depending on whether a user data structure DATA was specified in % IDAInit. % % The function GCOMFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAGlocalFnB, IDAGcommFn, IDASetOptions % % NOTES: % GCOMFUNB is specified through the GcommFn property in IDASetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % % Each call to GCOMFUNB is preceded by a call to the residual function % DAEFUN with the same arguments T, YY, YP and YYB and YPB. % Thus GCOMFUNB can omit any communication done by DAEFUNB if relevant % to the evaluation of G by GLOCFUNB. If all necessary communication % was done by DAEFUNB, GCOMFUNB need not be provided. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAQuadRhsFn.m0000600000175000017500000000204011741421121024570 0ustar sylvestresylvestre%IDAQuadRhsFn - type for user provided quadrature RHS function. % % The function QFUN must be defined as % FUNCTION [YQD, FLAG] = QFUN(T, YY, YP) % and must return a vector YQD corresponding to fQ(t,yy,yp), the % integrand for the integral to be evaluated. % If a user data structure DATA was specified in IDAInit, then % QFUN must be defined as % FUNCTION [YQD, FLAG, NEW_DATA] = QFUN(T, YY, YP, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector YQD, % the QFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function QFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAQuadInit % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDADenseJacFnB.m0000600000175000017500000000201611741421121025002 0ustar sylvestresylvestre%IDADenseJacFnb - type for dense Jacobian function for backward problems. % % The function DJACFUNB must be defined either as % FUNCTION [JB, FLAG] = DJACFUNB(T, YY, YP, YYB, YPB, RRB, CJB) % or as % FUNCTION [JB,FLAG,NEW_DATA] = DJACFUNB(T,YY,YP,YYB,YPB,RRB,CJB,DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the matrix JB, the % Jacobian (dfB/dyyB + cjb*dfB/dypB). The input argument RRB contains % the current value of f(t,yy,yp,yyB,ypB). % % The function DJACFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDADenseJacFn, IDASetOptions % % NOTE: DJACFUNB is specified through the property JacobianFn to % IDASetOptions and is used only if the property LinearSolver was % set to 'Dense'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAGlocalFnB.m0000600000175000017500000000174411741421121024536 0ustar sylvestresylvestre%IDAGlocalFnB - type for RES approximation function (BBDPre) for backward problems. % % The function GLOCFUNB must be defined either as % FUNCTION [GLOCB, FLAG] = GLOCFUNB(T,YY,YP,YYB,YPB) % or as % FUNCTION [GLOCB, FLAG, NEW_DATA] = GLOCFUNB(T,YY,YP,YYB,YPB,DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the vector GLOCB % corresponding to an approximation to fB(t,yy,yp,yyB,ypB). % % The function GLOCFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAGcommFnB, IDAGlocalFn, IDASetOptions % % NOTE: GLOCFUN and GLOCFUNB are specified through the GlocalFn property % in IDASetOptions and are used only if the property PrecModule % is set to 'BBDPre'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAJacTimesVecFnB.m0000600000175000017500000000200111741421121025455 0ustar sylvestresylvestre%IDAJacTimesVecFn - type for Jacobian times vector function for backward problems. % % The function JTVFUNB must be defined either as % FUNCTION [JVB,FLAG] = JTVFUNB(T,YY,YP,YYB,YPB,RRB,VB,CJB) % or as % FUNCTION [JVB,FLAG,NEW_DATA] = JTVFUNB(T,YY,YP,YYB,YPB,RRB,VB,CJB,DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the vector JVB, the % product of the Jacobian (dfB/dyyB + cj * dfB/dypB) and a vector % vB. The input argument RRB contains the current value of f(t,yy,yp,yyB,ypB). % % The function JTVFUNB must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also IDASetOptions % % NOTE: JTVFUNB is specified through the property JacobianFn to IDASetOptions % and is used only if the property LinearSolver was set to 'GMRES', 'BiCGStab', % or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAGlocalFn.m0000600000175000017500000000247411741421121024435 0ustar sylvestresylvestre%IDAGlocalFn - type for RES approximation function (BBDPre). % % The function GLOCFUN must be defined as % FUNCTION [GLOC, FLAG] = GLOCFUN(T,YY,YP) % and must return a vector GLOC corresponding to an approximation to f(t,yy,yp) % which will be used in the BBDPRE preconditioner module. The case where % G is mathematically identical to F is allowed. % If a user data structure DATA was specified in IDAInit, then % GLOCFUN must be defined as % FUNCTION [GLOC, FLAG, NEW_DATA] = GLOCFUN(T,YY,YP,DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector G, % the GLOCFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function GLOCFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAGcommFn, IDASetOptions % % NOTE: GLOCFUN and GLOCFUNB are specified through the GlocalFn property % in IDASetOptions and are used only if the property PrecModule % is set to 'BBDPre'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAPrecSolveFn.m0000600000175000017500000000307511741421121025134 0ustar sylvestresylvestre%IDAPrecSolveFn - type for preconditioner solve function. % % The user-supplied preconditioner solve function PSOLFUN % is to solve a linear system P z = r, where P is the % preconditioner matrix. % % The function PSOLFUN must be defined as % FUNCTION [Z, FLAG] = PSOLFUN(T,YY,YP,RR,R) % and must return a vector Z containing the solution of Pz=r. % If PSOLFUN was successful, it must return FLAG=0. For a recoverable % error (in which case the step will be retried) it must set FLAG to a % positive value. If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the integration will be halted. % The input argument RR contains the current value of f(t,yy,yp). % % If a user data structure DATA was specified in IDAInit, then % PSOLFUN must be defined as % FUNCTION [Z, FLAG, NEW_DATA] = PSOLFUN(T,YY,YP,RR,R,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector Z and % the flag FLAG, the PSOLFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would % lead to unnecessary copying). % % See also IDAPrecSetupFn, IDASetOptions % % NOTE: PSOLFUN and PSOLFUNB are specified through the property % PrecSolveFn to IDASetOptions and are used only if the property % LinearSolver was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAJacTimesVecFn.m0000600000175000017500000000237411741421121025370 0ustar sylvestresylvestre%IDAJacTimesVecFn - type for Jacobian times vector function. % % The function JTVFUN must be defined as % FUNCTION [JV, FLAG] = JTVFUN(T,YY,YP,RR,V,CJ) % and must return a vector JV corresponding to the product of the % Jacobian ( df/dyy + cj * df/dyp ) with the vector v. % The input argument RR contains the current value of f(t,yy,yp). % If a user data structure DATA was specified in IDAInit, then % JTVFUN must be defined as % FUNCTION [JV, FLAG, NEW_DATA] = JTVFUN(T,YY,YP,RR,V,CJ,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector JV, % the JTVFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function JTVFUN must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also IDASetOptions % % NOTE: JTVFUN is specified through the property JacobianFn to % IDASetOptions and is used only if the property LinearSolver % was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAResFnB.m0000600000175000017500000000137211741421121024063 0ustar sylvestresylvestre%IDAResFnb - type for residual function for backward problems % % The function DAEFUNB must be defined either as % FUNCTION [RB, FLAG] = DAEFUNB(T, YY, YP, YYB, YPB) % or as % FUNCTION [RB, FLAG, NEW_DATA] = DAEFUNB(T, YY, YP, YYB, YPB, DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the vector RB % corresponding to fB(t,yy,yp,yyB,ypB). % % The function DAEFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAInitB, IDARhsFn % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAPrecSetupFnB.m0000600000175000017500000000140211741421121025236 0ustar sylvestresylvestre%IDAPrecSetupFnB - type for preconditioner setup function for backward problems. % % The function PSETFUNB must be defined either as % FUNCTION FLAG = PSETFUNB(T,YY,YP,YYB,YPB,RRB,CJB) % or as % FUNCTION [FLAG,NEW_DATA] = PSETFUNB(T,YY,YP,YYB,YPB,RRB,CJB,DATA) % depending on whether a user data structure DATA was specified in % IDASetUserData. % % See also IDAPrecSolveFnB, IDAPrecSetupFn, IDASetOptions % % NOTE: PSETFUN and PSETFUNB are specified through the property % PrecSetupFn to IDASetOptions and are used only if the property % LinearSolver was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAResFn.m0000600000175000017500000000172311741421121023761 0ustar sylvestresylvestre%IDAResFn - type for residual function % % The function DAEFUN must be defined as % FUNCTION [R, FLAG] = DAEFUN(T, YY, YP) % and must return a vector R corresponding to f(t,yy,yp). % If a user data structure DATA was specified in IDAInit, then % DAEFUN must be defined as % FUNCTION [R, FLAG, NEW_DATA] = DAEFUN(T, YY, YP, DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector YD, % the DAEFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function DAEFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAMonitorFnB.m0000600000175000017500000000322111741421121024754 0ustar sylvestresylvestre%IDAMonitorFnB - type of monitoring function for backward problems. % % The function MONFUNB must be defined as % FUNCTION [] = MONFUNB(CALL, IDXB, T, Y, YQ) % It is called after every internal IDASolveB step and can be used to % monitor the progress of the solver. MONFUNB is called with CALL=0 % from IDAInitB at which time it should initialize itself and it % is called with CALL=2 from IDAFree. Otherwise, CALL=1. % % It receives as arguments the index of the backward problem (as % returned by IDAInitB), the current time T, solution vector Y, % and, if it was computed, the quadrature vector YQ. If quadratures % were not computed for this backward problem, YQ is empty here. % % If additional data is needed inside MONFUNB, it must be defined % as % FUNCTION NEW_MONDATA = MONFUNB(CALL, IDXB, T, Y, YQ, MONDATA) % If the local modifications to the user data structure need to be % saved (e.g. for future calls to MONFUNB), then MONFUNB must set % NEW_MONDATA. Otherwise, it should set NEW_MONDATA=[] % (do not set NEW_MONDATA = DATA as it would lead to unnecessary copying). % % A sample monitoring function, IDAMonitorB, is provided with CVODES. % % See also IDASetOptions, IDAMonitorB % % NOTES: % % MONFUNB is specified through the MonitorFn property in IDASetOptions. % If this property is not set, or if it is empty, MONFUNB is not used. % MONDATA is specified through the MonitorData property in IDASetOptions. % % See IDAMonitorB for an implementation example. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:38:44 $ sundials-2.5.0/sundialsTB/idas/function_types/IDASensResFn.m0000600000175000017500000000216311741421121024611 0ustar sylvestresylvestre%IDASensRhsFn - type for user provided sensitivity RHS function. % % The function DAESFUN must be defined as % FUNCTION [RS, FLAG] = DAESFUN(T,YY,YP,YYS,YPS) % and must return a matrix RS corresponding to fS(t,yy,yp,yyS,ypS). % If a user data structure DATA was specified in IDAInit, then % DAESFUN must be defined as % FUNCTION [RS, FLAG, NEW_DATA] = DAESFUN(T,YY,YP,YYS,YPS,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix YSD, % the ODESFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function DAESFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDASetFSAOptions % % NOTE: DAESFUN is specified through the property FSAResFn to % IDASetFSAOptions. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDADenseJacFn.m0000600000175000017500000000237011741421121024703 0ustar sylvestresylvestre%IDADenseJacFn - type for dense Jacobian function. % % The function DJACFUN must be defined as % FUNCTION [J, FLAG] = DJACFUN(T, YY, YP, RR, CJ) % and must return a matrix J corresponding to the Jacobian % (df/dyy + cj*df/dyp). % The input argument RR contains the current value of f(t,yy,yp). % If a user data structure DATA was specified in IDAInit, then % DJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = DJACFUN(T, YY, YP, RR, CJ, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J, % the DJACFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function DJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDASetOptions % % NOTE: DJACFUN is specified through the property JacobianFn to % IDASetOptions and is used only if the property LinearSolver % was set to 'Dense'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDABandJacFnB.m0000600000175000017500000000214411741421121024612 0ustar sylvestresylvestre%IDABandJacFnB - type for banded Jacobian function for backward problems. % % The function BJACFUNB must be defined either as % FUNCTION [JB, FLAG] = BJACFUNB(T, YY, YP, YYB, YPB, RRB, CJB) % or as % FUNCTION [JB,FLAG,NEW_DATA] = BJACFUNB(T,YY,YP,YYB,YPB,RRB,CJB) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the matrix JB, the % Jacobian (dfB/dyyB + cjB*dfB/dypB)of fB(t,y,yB). The input argument % RRB contains the current value of f(t,yy,yp,yyB,ypB). % % The function BJACFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDASetOptions % % See the IDAS user guide for more information on the structure of % a banded Jacobian. % % NOTE: BJACFUNB is specified through the property JacobianFn to % IDASetOptions and is used only if the property LinearSolver % was set to 'Band'. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/function_types/IDAQuadRhsFnB.m0000600000175000017500000000151011741421121024673 0ustar sylvestresylvestre%IDAQuadRhsFnB - type for quadrature RHS function for backward problems % % The function QFUNB must be defined either as % FUNCTION [YQBD, FLAG] = QFUNB(T, YY, YP, YYB, YPB) % or as % FUNCTION [YQBD, FLAG, NEW_DATA] = QFUNB(T, YY, YP, YYB, YPB, DATA) % depending on whether a user data structure DATA was specified in % IDAInit. In either case, it must return the vector YQBD % corresponding to fQB(t,yy,yp,yyB,ypB), the integrand for the integral to be % evaluated on the backward phase. % % The function QFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also IDAQuadInitB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/05/26 00:01:23 $ sundials-2.5.0/sundialsTB/idas/IDAInit.m0000600000175000017500000000164611741421121020602 0ustar sylvestresylvestrefunction status = IDAInit(fct,t0,yy0,yp0,options) %IDAInit allocates and initializes memory for IDAS. % % Usage: IDAInit ( DAEFUN, T0, YY0, YP0 [, OPTIONS ] ) % % DAEFUN is a function defining the DAE residual: f(t,yy,yp). % This function must return a vector containing the current % value of the residual. % T0 is the initial value of t. % YY0 is the initial condition vector y(t0). % YP0 is the initial condition vector y'(t0). % OPTIONS is an (optional) set of integration options, created with % the IDASetOptions function. % % See also: IDASetOptions, IDAResFn % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2011/05/26 00:05:36 $ mode = 1; if nargin < 4 error('Too few input arguments'); end if nargin < 5 options = []; end status = idm(mode, fct, t0, yy0, yp0, options); sundials-2.5.0/sundialsTB/idas/IDAQuadReInit.m0000600000175000017500000000136311741421121021700 0ustar sylvestresylvestrefunction status = IDAQuadReInit(yQ0, options) %IDAQuadReInit reinitializes IDAS's quadrature-related memory % assuming it has already been allocated in prior calls to IDAInit % and IDAQuadInit. % % Usage: IDAQuadReInit ( YQ0 [, OPTIONS ] ) % % YQ0 Initial conditions for quadrature variables yQ(t0). % OPTIONS is an (optional) set of QUAD options, created with % the IDASetQuadOptions function. % % See also: IDASetQuadOptions, IDAQuadInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 12; if nargin < 1 error('Too few input arguments'); end if nargin < 2 options = []; end status = idm(mode, yQ0, options); sundials-2.5.0/sundialsTB/idas/IDAFree.m0000600000175000017500000000040611741421121020551 0ustar sylvestresylvestrefunction [] = IDAFree() %IDAFree deallocates memory for the IDAS solver. % % Usage: IDAFree % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/08/21 17:38:42 $ mode = 40; idm(mode); sundials-2.5.0/sundialsTB/idas/IDASensReInit.m0000600000175000017500000000201711741421121021713 0ustar sylvestresylvestrefunction status = IDASensReInit(yyS0,ypS0,options) %IDASensReInit reinitializes IDAS's FSA-related memory % assuming it has already been allocated in prior calls to IDAInit % and IDASensInit. % The number of sensitivities Ns is assumed to be unchanged since the % previous call to IDASensInit. % % Usage: IDASensReInit ( YYS0, YPS0 [, OPTIONS ] ) % % YYS0, YPS0 Initial conditions for sensitivity variables. % YYS0 and YPS0 must be matrices with N rows and Ns columns, where N is % the problem dimension and Ns the number of sensitivity systems. % OPTIONS is an (optional) set of FSA options, created with % the IDASetFSAOptions function. % % See also: IDASensSetOptions, IDAReInit, IDASensInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:19 $ mode = 13; if nargin < 2 error('Too few input arguments'); end if nargin < 3 options = []; end status = idm(mode, yyS0, ypS0, options); sundials-2.5.0/sundialsTB/idas/IDAQuadInitB.m0000600000175000017500000000165511741421121021517 0ustar sylvestresylvestrefunction status = IDAQuadInitB(idxB, fctQB, yQB0, optionsB) %IDAQuadInitB allocates and initializes memory for backward quadrature integration. % % Usage: IDAQuadInitB ( IDXB, QBFUN, YQB0 [, OPTIONS ] ) % % IDXB is the index of the backward problem, returned by % IDAInitB. % QBFUN is a function defining the righ-hand sides of the % backward ODEs yQB' = fQB(t,y,yB). % YQB0 is the final conditions vector yQB(tB0). % OPTIONS is an (optional) set of QUAD options, created with % the IDASetQuadOptions function. % % See also: IDAInitB, IDASetQuadOptions, IDAQuadRhsFnB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 6; if nargin < 3 error('Too few input arguments'); end if nargin < 4 optionsB = []; end idxB = idxB-1; status = idm(mode, idxB, fctQB, yQB0, optionsB); sundials-2.5.0/sundialsTB/idas/IDAAdjInit.m0000600000175000017500000000147211741421121021216 0ustar sylvestresylvestrefunction status = IDAAdjInit(steps, interp) %IDAAdjInit allocates and initializes memory for ASA with IDAS. % % Usage: IDAAdjInit(STEPS, INTEPR) % % STEPS specifies the (maximum) number of integration steps between two % consecutive check points. % INTERP Specifies the type of interpolation used for estimating the forward % solution during the backward integration phase. INTERP should be % 'Hermite', indicating cubic Hermite interpolation, or 'Polynomial', % indicating variable order polynomial interpolation. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 4; if nargin ~= 2 error('Wrong number of input arguments'); end status = idm(mode,steps,interp); sundials-2.5.0/sundialsTB/Contents.m0000600000175000017500000000031411741421121020225 0ustar sylvestresylvestre% sundialsTB v.2.4.0 - Matlab interfaces to SUNDIALS solvers % % sundialsTB provides interfaces to the CVODES, IDAS, and KINSOL % solvers in SUNDIALS. % % See also cvodes, idas, kinsol, nvector, putils sundials-2.5.0/sundialsTB/cvodes/0000755000175000017500000000000011767174700017567 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/CVodeReInit.m0000600000175000017500000000172011741421121022030 0ustar sylvestresylvestrefunction status = CVodeReInit(t0, y0, options) %CVodeReInit reinitializes memory for CVODES % where a prior call to CVodeInit has been made with the same % problem size N. CVodeReInit performs the same input checking % and initializations that CVodeInit does, but it does no % memory allocation, assuming that the existing internal memory % is sufficient for the new problem. % % Usage: CVodeReInit ( T0, Y0 [, OPTIONS ] ) % % T0 is the initial value of t. % Y0 is the initial condition vector y(t0). % OPTIONS is an (optional) set of integration options, created with % the CVodeSetOptions function. % % See also: CVodeSetOptions, CVodeInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:18 $ mode = 11; if nargin < 2 error('Too few input arguments'); end if nargin < 3 options = []; end status = cvm(mode, t0, y0, options); sundials-2.5.0/sundialsTB/cvodes/examples_par/0000755000175000017500000000000011767174700022247 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/examples_par/mcvsDecoupl_non_p.m0000600000175000017500000000355211741421121026057 0ustar sylvestresylvestrefunction [] = mcvsDecoupl_non_p(comm) %mcvsDecoupl_non_p - CVODES example problem % (parallel, Adams, Functional) % This is a simple test for the CVODES solver. It solves a % set of decoupled ODEs. % % See also: mpirun % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ [status npes] = MPI_Comm_size(comm); [status mype] = MPI_Comm_rank(comm); nlocal = 20; neq = npes * nlocal; alpha = 10.0/neq; data.alpha = alpha; data.comm = comm; data.nlocal = nlocal; data.mype = mype; t0 = 0.0; for i = 1:nlocal y0(i,1) = 1.0; end rtol = 1.0e-5; atol = 1.0e-10; fprintf('\nPVNX example problem\n\n'); fprintf(' Processor %d/%d\n',mype,npes); fprintf(' Global problem size: %d\n',neq); fprintf(' Local problem size: %d\n\n',nlocal); if mype == 0 fprintf(' alpha = %f\n',alpha); fprintf(' rtol = %e atol = %e\n\n',rtol,atol); end options = CVodeSetOptions('Reltol',rtol,'AbsTol',atol); mondata = struct; if mype == 0 mondata.mode = 'both'; mondata.sol = true; else % mondata.post = false; mondata.sol = true; mondata.cntr = false; mondata.stats = false; end options = CVodeSetOptions(options,... 'MonitorFn','CVodeMonitor',... 'MonitorData',mondata); CVodeInit(@rhsfn,'Adams','Functional',t0,y0,options,data); nout = 10; dtout = 0.1; tout = dtout; for i = 1:nout [status,t,y] = CVode(tout,'Normal'); if mype == 0 si = CVodeGetStats; fprintf('t = %f nst = %d nfe = %d\n',t,si.nst,si.nfe); end tout = tout + dtout; end CVodeFree; % %--------------------------------------------------------- % function [yd, flag, new_data] = rhsfn(t, y, data) alpha = data.alpha; nlocal = data.nlocal; mype = data.mype; for i = 1:nlocal yd(i) = -alpha * (mype*nlocal + i) * y(i); end flag = 0; new_data = []; sundials-2.5.0/sundialsTB/cvodes/examples_par/mcvsAtmDisp_kry_bbd_p.m0000600000175000017500000003023311741421121026643 0ustar sylvestresylvestrefunction [] = mcvsAtmDisp_kry_bbd_p(comm) %mcvsAtmDisp_kry_bbd_p - CVODES example problem % (parallel, BDF, Newton, GMRES, BBDP) % This example solves a 3D advection-diffusion PDE with a % distributed source to simulate atmospheric dispersion. % % This example uses the BBDP preconditioner module in CVODES. % % See also: mpirun % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ %--------------------------------- % Domain definition % xmin - left boundary % xmax - right boundary % m - number of intervals % np - number of processes %--------------------------------- xmin(1) = 0.0; xmax(1) = 20.0; m(1) = 20; np(1) = 2; xmin(2) = 0.0; xmax(2) = 20.0; m(2) = 40; np(2) = 2; xmin(3) = 0.0; xmax(3) = 20.0; m(3) = 20; np(3) = 1; %--------------------------------- % Get MPI id and no. of processes %--------------------------------- [status npes] = MPI_Comm_size(comm); [status myId] = MPI_Comm_rank(comm); if npes ~= prod(np) error('Wrong number of processes'); end %--------------------------------- % Set-up problem data %--------------------------------- data = SetData(comm, npes, myId, xmin, xmax, m, np); %-------------------------------- % Problem dimensions %-------------------------------- nlocal = prod(data.ml); neq = prod(data.m); fprintf('\nPVKX example problem\n\n'); fprintf(' Processor %d/%d\n',myId,npes); fprintf(' Global problem size: %d\n',neq); fprintf(' Local problem size: %d\n\n',nlocal); %-------------------------------- % Initial conditions %-------------------------------- % Initial time t0 = 0.0; % Initial states (concentrations) y0 = zeros(nlocal,1); % TEST communication pattern fprintf('Local data structure\n'); fprintf(' myId = %d\n',data.myId); fprintf(' xmin = %g %g %g\n',data.xmin); fprintf(' xmax = %g %g %g\n',data.xmax); fprintf(' dx = %g %g %g\n',data.dx); fprintf(' start = %3d %3d %3d\n',data.start); fprintf(' m = %3d %3d %3d\n',data.m); fprintf(' ml = %3d %3d %3d\n',data.ml); fprintf(' |yext| = %3d %3d %3d\n\n',size(data.yext)); %-------------------------------- % CVODES setup %-------------------------------- % Tolerances options = CVodeSetOptions('RelTol',1.e-8,... 'AbsTol',1.e-6); % Linear solver mldq = data.ml(1)+1; mudq = data.ml(1)+1; mlkeep = 2; mukeep = 2; options = CVodeSetOptions(options,... 'LinearSolver','GMRES',... 'PrecType','Left',... 'PrecModule','BBDPre',... 'GlocalFn',@pvkx_fl,... 'LowerBwidthDQ',mldq,... 'UpperBwidthDQ',mudq,... 'LowerBwidth',mlkeep,... 'UpperBwidth',mukeep); % Monitoring mondata = struct; if myId ==0 mondata.mode = 'text'; else mondata.post = false; end options = CVodeSetOptions(options,... 'MonitorFn','CVodeMonitor',... 'MonitorData',mondata); % Memory allocation and initialization CVodeInit(@rhsfn,'BDF','Newton',t0,y0,options,data); %-------------------------------- % CVODES solution %-------------------------------- tf = 0.01; [status,t,y] = CVode(tf,'Normal'); if myId == 0 si = CVodeGetStats end CVodeFree; % % =========================================================== % function d = SetData(comm, npes, myId, xmin, xmax, m, np) %--------------------------------- % MPI stuff %--------------------------------- d.comm = comm; d.myId = myId; d.np = np; %--------------------------------- % Domain boundaries %--------------------------------- d.xmin = xmin; d.xmax = xmax; %-------------------------------------- % Diffusion coefficient %-------------------------------------- d.Dc = 1.0; %-------------------------------------- % Velocity parameters: Poiseuille flow % across y direction, max. velocity=1 % v(y) = Vc*(L-y)*(L+y) %-------------------------------------- d.L = 0.5 * ( xmax(2) - xmin(2) ); d.Vc = 1.0/d.L^2; %-------------------------------------- % Grid spacing and differential volume % d.m -> number of internal points %-------------------------------------- d.dx = (d.xmax - d.xmin) ./ m; d.m = m - [1 1 1]; d.dOmega = prod(d.dx); %------------------------------------------------ % Partitioning % d.left -> left neighbours % d.right -> right neighbours % d.start -> left border in global index space % d.ml -> length of subdomain %----------------------------------------------- npd = floor(d.m ./ np); % in x direction test = mod( myId , np(1) ); d.left(1) = myId-1; d.right(1) = myId+1; d.start(1) = npd(1) * test + 1; d.ml(1) = npd(1); if test == 0 d.left(1) = myId; end if test == np(1)-1 d.right(1) = myId; d.ml(1) = d.m(1) - d.start(1) + 1; end % in y direction test = mod( floor(myId/np(1)) , np(2) ); d.left(2) = myId - np(1); d.right(2) = myId + np(1); d.start(2) = npd(2) * test + 1; d.ml(2) = npd(2); if test == 0 d.left(2) = myId; end if test == np(2)-1 d.right(2) = myId; d.ml(2) = d.m(2) - d.start(2) + 1; end % in z direction test = mod( floor(myId/np(1)/np(2)) , np(3) ); d.left(3) = myId - np(1)*np(2); d.right(3) = myId + np(1)*np(2); d.start(3) = npd(3) * test + 1; d.ml(3) = npd(3); if test == 0 d.left(3) = myId; end if test == np(3)-1 d.right(3) = myId; d.ml(3) = d.m(3) - d.start(3) +1; end %-------------------------------------- % Space for extended local solution % 3D matrix %-------------------------------------- d.yext = zeros([d.ml(1)+2 d.ml(2)+2 d.ml(3)+2]); %-------------------------------------- % Source parameters: Gaussians with % - A: amplitude % - S: sigma^2 % - X: position %-------------------------------------- d.A1 = 1.0; d.S1 = 1.7^2; d.X1 = 4.0; d.Y1 = 8.0; d.Z1 = 8.0; d.A2 = 0.8; d.S2 = 3.0^2; d.X2 = 16.0; d.Y2 = 12.0; d.Z2 = 12.0; d.GMIN = 1.0e-5; A1 = 1.0; S1 = 1.7^2; X1 = [ 4.0 8.0 8.0]; A2 = 0.8; S2 = 3.0^2; X2 = [ 16.0 12.0 12.0]; GMIN = 1.0e-5; d.s = zeros(d.ml); for i = 1:d.ml(1) for j = 1:d.ml(2) for k = 1:d.ml(3) x = d.xmin + (d.start + [i-2 j-2 k-2] ) .* d.dx; s = A1 * prod( exp( -(X1-x).^2 / S1 ) ) + ... A2 * prod( exp( -(X2-x).^2 / S2 ) ) ; if s < GMIN s = 0.0; end d.s(i,j,k) = s; end end end % =========================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Do all inter-process communication % After this, data.yext contains all data needed for Finite Differences data = rhsfn_comm(y, data); % Compute right-hand side locally [yd, flag, new_data] = rhsfn_local(t, y, data); new_data = data; %================================================================= function [data] = rhsfn_comm(y, data) %rhsfn_comm loads the local extended 3D solution matrix, by: % a) using the local solution in the interior of the local grid % b) communicating with neighbouring processes to obtain solution % on the internal boundaries % c) setting 0-flux B.C. on the external boundaries. ml = data.ml; comm = data.comm; myId = data.myId; left = data.left; right = data.right; % Reshape local solution into a cube c = reshape(y,ml); % Load local solution into extended matrix data.yext(2:end-1,2:end-1,2:end-1) = c; % Internal boundaries: loop over each dimension and exchange data. % The processor with lower ID always sends first. % External boundaries: impose homogeneous Neumann B.C. for dim = 1:3 N = prod(ml)/ml(dim); % dimension of communication buffers % to the left nbr = left(dim); % left neighbour bufS = reshape( get_slice(c,dim,1), N, 1); % send buffer bufR = zeros(N, 1); % receive buffer if nbr == myId % external BC data.yext = set_slice(data.yext,dim,1,bufS); else % internal BC if myId < nbr % fprintf(' left send/recv %d N = %d\n',nbr,N); info = MPI_Send(bufS, nbr, 0, comm); if info ~= 0 fprintf('Send to left: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end [info, stat] = MPI_Recv(bufR, nbr, 0, comm); if info ~= 0 fprintf('Receive from left: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end else % fprintf(' left recv/send %d N = %d\n',nbr,N); [info, stat] = MPI_Recv(bufR, nbr, 0, comm); if info ~= 0 fprintf('Receive from left: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end info = MPI_Send(bufS, nbr, 0, comm); if info ~= 0 fprintf('Send to left: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end end data.yext = set_slice(data.yext,dim,1,bufR); end % to the right nbr = right(dim); % right neighbour bufS = reshape( get_slice(c,dim,ml(dim)), N, 1); % send buffer bufR = zeros(N, 1); % receive buffer if nbr == myId % external BC data.yext = set_slice(data.yext,dim,ml(dim)+2,bufS); else % internal BC if myId < nbr % fprintf(' right send/recv %d N = %d\n',nbr,N); info = MPI_Send(bufS, nbr, 0, comm); if info ~= 0 fprintf('Send to right: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end [info, stat] = MPI_Recv(bufR, nbr, 0, comm); if info ~= 0 fprintf('Receive from right: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end else % fprintf(' right recv/send %d N = %d\n',nbr,N); [info, stat] = MPI_Recv(bufR, nbr, 0, comm); if info ~= 0 fprintf('Receive from right: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end info = MPI_Send(bufS, nbr, 0, comm); if info ~= 0 fprintf('Send to right: myId %d nbr %d info %d',myId,nbr,info); MPI_Abort(comm, 0); end end data.yext = set_slice(data.yext,dim,ml(dim)+2,bufR); end end function b = get_slice(a, dim, indx) %get_slice extracts from the 3D matrix A, the 2D matrix slice B at % index INDX in the dimension DIM switch dim case 1 b = a(indx,:,:); case 2 b = a(:,indx,:); case 3 b = a(:,:,indx); end function a = set_slice(a, dim, indx, b) %set_slice loads the 2D matrix B at index INDX in the dimension DIM % into the 3D matrix A. A has 2 more components than B in each % dimension [nr, nc] = size(b); % number of rows and columns in B switch dim case 1 nr = size(a,2)-2; nc = size(a,3)-2; a(indx,2:end-1,2:end-1) = reshape(b,nr,nc); case 2 nr = size(a,1)-2; nc = size(a,3)-2; a(2:end-1,indx,2:end-1) = reshape(b,nr,nc); case 3 nr = size(a,1)-2; nc = size(a,2)-2; a(2:end-1,2:end-1,indx) = reshape(b,nr,nc); end % =========================================================== function [yd, flag, new_data] = rhsfn_local(t, y, data) %rhsfn_local - local RHS computation xmin = data.xmin; ml = data.ml; start = data.start; dx = data.dx; Dc = data.Dc; yext = data.yext; for i = 2:ml(1)+1 for j = 2:ml(2)+1 for k = 2:ml(3)+1 x = xmin + (start + [i-2 j-2 k-2] ) .* dx; v = velocity(x, data); s = source(x,data); [c, cl, cr] = stencil(yext,i,j,k); adv = v .* (cr-cl) ./ (2.0*dx); dif = Dc * (cr - 2.0*c + cl) / dx.^2; yd(i-1,j-1,k-1) = s + sum(dif-adv); end end end yd = reshape(yd,prod(ml),1); flag = 0; new_data = []; function [c,cl,cr] = stencil(yext,i,j,k) c = yext(i,j,k) * ones(1,3); cl(1) = yext(i-1,j, k ); cr(1) = yext(i+1,j, k ); cl(2) = yext(i, j-1,k ); cr(2) = yext(i, j+1,k ); cl(3) = yext(i, j, k-1); cr(3) = yext(i, j, k+1); function v = velocity(x, data) L = data.L; Vc = data.Vc; xmin = data.xmin; y = x(2) - xmin(2) - L; v(1) = Vc * (L+y) * (L-y); v(2) = 0.0; v(3) = 0.0; function s = source(x, data) A1 = data.A1; A2 = data.A2; S1 = data.S1; S2 = data.S2; X1 = data.X1; X2 = data.X2; Y1 = data.Y1; Y2 = data.Y2; Z1 = data.Z1; Z2 = data.Z2; s1 = A1 * exp(-(X1-x(1))^2/S1) * exp(-(Y1-x(2))^2/S1) * exp(-(Z1-x(3))^2/S1); s2 = A2 * exp(-(X2-x(1))^2/S2) * exp(-(Y2-x(2))^2/S2) * exp(-(Z2-x(3))^2/S2); s = s1 + s2; if s < data.GMIN s = 0.0; end sundials-2.5.0/sundialsTB/cvodes/examples_par/mcvsAdvDiff_FSA_non_p.m0000600000175000017500000001072111741421121026454 0ustar sylvestresylvestrefunction [] = mcvsAdvDiff_FSA_non_p(comm) %mcvsAdvDiff_FSA_non_p - CVODES forward sensitivity example % (parallel, Adams, Functional) % Semi-discrete form of the advection-diffusion equation in 1-D: % du/dt = q1 * d^2 u / dx^2 + q2 * du/dx % on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. % Homogeneous Dirichlet boundary conditions are posed, and the % initial condition is: % u(x,y,t=0) = x(2-x)exp(2x). % The PDE is discretized on a uniform grid of size MX+2 with % central differencing, and with boundary values eliminated, % leaving an ODE system of size NEQ = MX. % % Optionally, sensitivities with respect to q1 and q2 are also computed. % % This program solves the problem with the option for nonstiff % systems: ADAMS method and functional iteration. % It uses scalar relative and absolute tolerances. % Output is printed at t = .5, 1.0, ..., 5. % % See also: mpirun % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ sensi = true; xmax = 2.0; mx = 10; dx = xmax/(mx+1); neq = mx; [status npes] = MPI_Comm_size(comm); [status mype] = MPI_Comm_rank(comm); nperpe = floor(neq/npes); nrem = neq - npes*nperpe; if mype < nrem nlocal = nperpe+1; my_base = mype * nlocal; else nlocal = nperpe; my_base = mype * nperpe + nrem; end data.comm = comm; data.nlocal = nlocal; data.npes = npes; data.mype = mype; data.dx = dx; data.p = [1.0 ; 0.5]; t0 = 0.0; for i = 1:nlocal iglobal = my_base + i; x = iglobal * dx; u0(i,1) = x *(xmax-x)*exp(2.0*x); end rtol = 0.0; atol = 1.0e-5; options = CVodeSetOptions('Reltol',rtol,'AbsTol',atol); CVodeInit(@rhsfn,'Adams','Functional',t0,u0,options,data); if sensi Ns = 2; uS0 = zeros(nlocal,Ns); pbar = data.p; plist = [1;2]; FSAoptions = CVodeSensSetOptions('method','Simultaneous',... 'ErrControl', 'on',... 'ParamField', 'p',... 'ParamList', plist,... 'ParamScales', pbar); CVodeSensInit(Ns, [], uS0, FSAoptions); end if mype == 0 fprintf('============================================================\n'); fprintf(' T Q H NST Max norm \n'); fprintf('============================================================\n'); end nout = 10; dtout = 0.5; tout = dtout; for i = 1:nout if sensi [status,t,u,uS] = CVode(tout,'Normal'); PrintOutput(mype, comm, t, u, uS); else [status,t,u] = CVode(tout,'Normal'); PrintOutput(mype, comm, t, u, []); end tout = tout + dtout; end CVodeFree; %% %%------------------------------------------------------------------- %% function [ud, flag, new_data] = rhsfn(t, u, data) % Extract needed problem constants from data dx = data.dx; hordc = data.p(1) / dx^2; horac = data.p(2) / (2.0*dx); % Extract parameters for parallel computation comm = data.comm; npes = data.npes; mype = data.mype; nlocal = length(u); % Compute related parameters mype_m1 = mype-1; mype_p1 = mype+1; last_pe = npes-1; % Local copy of state y = [0.0 ; u ; 0.0]; % Pass needed data to processes before and after current one if mype ~= 0 MPI_Send(u(1), mype_m1, 0, comm); end if mype ~= last_pe MPI_Send(u(nlocal), mype_p1, 0, comm); end % Receive needed data from processes before and after current one buf = 0.0; if mype ~= 0 MPI_Recv(buf, mype_m1, 0, comm); y(1) = buf; else y(1) = 0.0; % zero BC end if mype ~= last_pe MPI_Recv(buf, mype_p1, 0, comm); y(nlocal+2) = buf; else y(nlocal+2) = 0.0; % zero BC end for i = 2:nlocal+1 ui = y(i); ul = y(i-1); ur = y(i+1); hdiff = hordc*(ul - 2.0*ui + ur); hadv = horac * (ur-ul); ud(i-1) = hdiff + hadv; end flag = 0; new_data = []; %% %%------------------------------------------------------------------- %% function [] = PrintOutput(mype, comm, t, u, uS) umax = N_VMaxNorm(u,comm); if ~isempty(uS) smax1 = N_VMaxNorm(uS(:,1),comm); smax2 = N_VMaxNorm(uS(:,2),comm); end if mype == 0 si = CVodeGetStats; fprintf('%8.3e %2d %8.3e %5ld\n', t,si.qlast,si.hlast,si.nst); fprintf(' Solution '); fprintf('%12.4e \n', umax); if ~isempty(uS) fprintf(' Sensitivity 1 '); fprintf('%12.4e \n', smax1); fprintf(' Sensitivity 2 '); fprintf('%12.4e \n', smax2); end endsundials-2.5.0/sundialsTB/cvodes/CVodeMonitorB_octave.m0000600000175000017500000002437611741421121023744 0ustar sylvestresylvestrefunction [new_data] = CVodeMonitorB(call, idxB, T, Y, YQ, data) %CVodeMonitorB is the default CVODES monitoring function for backward problems. % To use it, set the Monitor property in CVodeSetOptions to % 'CVodeMonitorB' or to @CVodeMonitorB and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to CVodeSetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see CVodeGetStats) % o sol [ true | {false} ] % If true, plot solution components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also CVodeSetOptions, CVMonitorFnB % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to CVodeSetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:42:38 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end if data.sol data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y for additional initializations if data.first if data.sol if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; y = data.y; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = CVodeGetStatsB(idxB); t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_init(n, hfs, nps, data.sol, ... N, t, y); end data.initialized = true; else if (data.stats | data.cntr) graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, N, t, y); end end if call == 2 if (data.stats | data.cntr) graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol sol_final(hfs, nps, data.sol, N); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end if ~data.sol data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.y = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Time label and figure title tlab = '<- t <-'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; abs(h(1:n)')]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; q(1:n)']; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; yd = [get(hc(5),'YData') ; ncfn(1:n)']; set(hc(5), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') ; netf(1:n)']; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') ; nni(1:n)']; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') ; nfe(1:n)']; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(1),'YData') ; nst(1:n)']; set(hc(1), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, N, t, y) figure(hfs); % Time label tlab = '<- t <-'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, N, t, y) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; y(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, N) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end drawnow sundials-2.5.0/sundialsTB/cvodes/CVodeSensInit.m0000600000175000017500000000205211741421121022371 0ustar sylvestresylvestrefunction status = CVodeSensInit(Ns,fctS,yS0,options) %CVodeSensInit allocates and initializes memory for FSA with CVODES. % % Usage: CVodeSensInit ( NS, SFUN, YS0 [, OPTIONS ] ) % % NS is the number of parameters with respect to which sensitivities % are desired % SFUN is a function defining the righ-hand sides of the sensitivity % ODEs yS' = fS(t,y,yS). % YS0 Initial conditions for sensitivity variables. % YS0 must be a matrix with N rows and Ns columns, where N is the problem % dimension and Ns the number of sensitivity systems. % OPTIONS is an (optional) set of FSA options, created with % the CVodeSetFSAOptions function. % % See also CVodeSensSetOptions, CVodeInit, CVSensRhsFn % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 3; if nargin < 3 error('Too few input arguments'); end if nargin < 4 options = []; end status = cvm(mode, Ns, fctS, yS0, options); sundials-2.5.0/sundialsTB/cvodes/CVodeAdjReInit.m0000600000175000017500000000045511741421121022453 0ustar sylvestresylvestrefunction status = CVodeAdjReInit() %CVodeAdjReInit re-initializes memory for ASA with CVODES. % % Usage: CVodeAdjReInit % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:17 $ mode = 14; status = cvm(mode); sundials-2.5.0/sundialsTB/cvodes/Contents.m0000600000175000017500000001354311741421121021520 0ustar sylvestresylvestre% CVODES, an ODE integrator with sensitivity analysis capabilities % % The Matlab interface to the SUNDIALS solver CVODES provides access % to all functionality of the underlying solver, including IVP simulation % and sensitvity analysis (both forward and adjoint). % % The interface consists of several user-callable functions. In addition, % the user must provide several required and optional user-supplied % functions which define the problem to be solved. The user-callable % functions and the types of user-supplied functions are listed below. % For completness, some functions appear more than once. % % Functions for ODE integration % % CVodeSetOptions - create an options structure for an ODE problem. % CVodeQuadSetOptions - create an options structure for quadrature integration. % CVodeInit - allocate and initialize memory for CVODES. % CVodeQuadInit - allocate and initialize memory for quadrature integration. % CVodeReInit - reinitialize memory for CVODES. % CVodeQuadReInit - reinitialize memory for quadrature integration. % CVode - integrate the ODE problem. % CVodeGetStats - return statistics for the CVODES solver. % CVodeGet - extract data from CVODES memory. % CVodeFree - deallocate memory for the CVODES solver. % % Functions for forward sensitivity analysis % % CVodeSetOptions - create an options structure for an ODE problem. % CVodeQuadSetOptions - create an options structure for quadrature integration. % CVodeSensSetOptions - create an options structure for FSA. % CVodeInit - allocate and initialize memory for CVODES. % CVodeQuadInit - allocate and initialize memory for quadrature integration. % CVodeSensInit - allocate and initialize memory for FSA. % CVodeReInit - reinitialize memory for CVODES. % CVodeQuadReInit - reinitialize memory for quadrature integration. % CVodeSensReInit - reinitialize memory for FSA. % CVodeSensToggleOff - temporarily deactivates FSA. % CVode - integrate the ODE problem. % CVodeGetStats - return statistics for the CVODES solver. % CVodeGet - extract data from CVODES memory. % CVodeFree - deallocate memory for the CVODES solver. % % Functions for adjoint sensitivity analysis % % CVodeSetOptions - create an options structure for an ODE problem. % CVodeQuadSetOptions - create an options structure for quadrature integration. % CVodeInit - allocate and initialize memory for the forward problem. % CVodeQuadInit - allocate and initialize memory for forward quadrature integration. % CVodeQuadReInit - reinitialize memory for forward quadrature integration. % CVodeReInit - reinitialize memory for the forward problem. % CVodeAdjInit - allocate and initialize memory for ASA. % CVodeInitB - allocate and initialize a backward problem. % CVodeAdjReInit - reinitialize memory for ASA. % CVodeReInitB - reinitialize a backward problem. % CVode - integrate the forward ODE problem. % CVodeB - integrate the backward problems. % CVodeGetStats - return statistics for the integration of the forward problem. % CVodeGetStatsB - return statistics for the integration of a backward problem. % CVodeGet - extract data from CVODES memory. % CVodeFree - deallocate memory for the CVODES solver. % % User-supplied function types for forward problems % % CVRhsFn - RHS function % CVRootFn - root-finding function % CVQuadRhsFn - quadrature RHS function % CVSensRhsFn - sensitivity RHS function % CVDenseJacFn - dense Jacobian function % CVBandJacFn - banded Jacobian function % CVJacTimesVecFn - Jacobian times vector function % CVPrecSetupFn - preconditioner setup function % CVPrecSolveFn - preconditioner solve function % CVGlocalFn - RHS approximation function (BBDPre) % CVGcomFn - communication function (BBDPre) % CVMonitorFn - monitoring function % % User-supplied function types for backward problems % % CVRhsFnB - RHS function % CVQuadRhsFnB - quadrature RHS function % CVDenseJacFnB - dense Jacobian function % CVBandJacFnB - banded Jacobian function % CVJacTimesVecFnB - Jacobian times vector function % CVPrecSetupFnB - preconditioner setup function % CVPrecSolveFnB - preconditioner solve function % CVGlocalFnB - RHS approximation function (BBDPre) % CVGcomFnB - communication function (BBDPre) % CVMonitorFnB - monitoring function % % Serial examples provided with the toolbox % % mcvsRoberts_dns - chemical kinetics problem % mcvsRoberts_FSA_dns - FSA for the robertson problem % mcvsRoberts_ASAi_dns - ASA for the robertson problem % mcvsAdvDiff_bnd - advection-diffusion PDE % mcvsDiurnal_kry - 2D, 2-species, time dependent PDE % mcvsPleiades_non - nonstiff celestial mechanics problem % mcvsVanDPol_dns - Van der Pol problem % mcvsPollut_FSA_dns - FSA for pollution chemical kinetics % mcvsOzone_FSA_dns - FSA for ozone chemical kinetics % mcvsDiscRHS_dns - integration over RHS discontinuities % mcvsDiscSOL_dns - integration over solution discontinuities % mcvsHessian_FSA_ASA - illustration for computing Hessian information % (forward-over-adjoint approach) % % Parallel examples provided with the toolbox % % mcvsDecoupl_non_p - diagonal ODE example % mcvsAdvDiff_FSA_non_p - FSA for 1D adv-diff problem (Adams, Functional) % mcvsAtmDisp_kry_bbd_p - 3D adv-diff with distributed source problem % (BDF, Newton, GMRES, BBDPre preconditioner) % Use the mpirun function to run any of the parallel examples % % See also nvector, putils sundials-2.5.0/sundialsTB/cvodes/CVodeReInitB.m0000600000175000017500000000214211741421121022131 0ustar sylvestresylvestrefunction status = CVodeReInitB(idxB, tB0, yB0, optionsB) %CVodeReInitB re-initializes backward memory for CVODES. % where a prior call to CVodeInitB has been made with the same % problem size NB. CVodeReInitB performs the same input checking % and initializations that CVodeInitB does, but it does no % memory allocation, assuming that the existing internal memory % is sufficient for the new problem. % % Usage: CVodeReInitB ( IDXB, TB0, YB0 [, OPTIONSB] ) % % IDXB is the index of the backward problem, returned by % CVodeInitB. % TB0 is the final value of t. % YB0 is the final condition vector yB(tB0). % OPTIONSB is an (optional) set of integration options, created with % the CVodeSetOptions function. % % See also: CVodeSetOptions, CVodeInitB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:18 $ mode = 15; if nargin < 3 error('Too few input arguments'); end if nargin < 4 optionsB = []; end idxB = idxB-1; status = cvm(mode,idxB,tB0,yB0,optionsB); sundials-2.5.0/sundialsTB/cvodes/CVodeAdjInit.m0000600000175000017500000000150211741421121022156 0ustar sylvestresylvestrefunction status = CVodeAdjInit(steps, interp) %CVodeAdjInit allocates and initializes memory for ASA with CVODES. % % Usage: CVodeAdjInit(STEPS, INTEPR) % % STEPS specifies the (maximum) number of integration steps between two % consecutive check points. % INTERP Specifies the type of interpolation used for estimating the forward % solution during the backward integration phase. INTERP should be % 'Hermite', indicating cubic Hermite interpolation, or 'Polynomial', % indicating variable order polynomial interpolation. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:17 $ mode = 4; if nargin ~= 2 error('Wrong number of input arguments'); end status = cvm(mode,steps,interp); sundials-2.5.0/sundialsTB/cvodes/cvm/0000755000175000017500000000000011767174700020354 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/cvm/cvm_jtvB.m0000600000175000017500000000042511741421121022255 0ustar sylvestresylvestrefunction [JvB, flag, new_data] = cvm_jtvB(t, y, yB, fyB, vB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [JvB, flag] = feval(fct,t,y,yB,fyB,vB); new_data =[]; else [JvB, flag, new_data] = feval(fct,t,y,yB,fyB,vB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_gcom.m0000600000175000017500000000034411741421121022275 0ustar sylvestresylvestrefunction [flag, new_data] = cvm_gcom(t, y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,y); new_data = []; else [flag, new_data] = feval(fct,t,y,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_glocB.m0000600000175000017500000000040011741421121022367 0ustar sylvestresylvestrefunction [flB, flag, new_data] = cvm_glocB(t, y, yB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [flB, flag] = feval(fct,t,y,yB); new_data = []; else [flB, flag, new_data] = feval(fct,t,y,yB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/Contents.m0000600000175000017500000000011111741421121022270 0ustar sylvestresylvestre% MEX binding of CVODES functions % %-- Radu Serban @ LLNL -- April 2005 sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_rhsS.m0000600000175000017500000000051711741421121022271 0ustar sylvestresylvestrefunction [ySd, flag, new_data] = cvm_rhsS(t, y, yd, Ns, yS, fct, data) % % Wrapper around the actual user-provided Matlab function % N = length(y); yS = reshape(yS,N,Ns); if isempty(data) [ySd, flag] = feval(fct,t,y,yd,yS); new_data = []; else [ySd, flag, new_data] = feval(fct,t,y,yd,yS,data); end ySd = reshape(ySd,N*Ns,1);sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_djac.m0000600000175000017500000000037211741421121022252 0ustar sylvestresylvestrefunction [J, flag, new_data] = cvm_djac(t, y, fy, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [J, flag] = feval(fct,t,y,fy); new_data = []; else [J, flag, new_data] = feval(fct,t,y,fy,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_psolB.m0000600000175000017500000000042411741421121022426 0ustar sylvestresylvestrefunction [zB, flag, new_data] = cvm_psolB(t, y, yB, fyB, rB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [zB, flag] = feval(fct,t,y,yB,fyB,rB); new_data = []; else [zB, flag, new_data] = feval(fct,t,y,yB,fyB,rB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_jtv.m0000600000175000017500000000040211741421121022146 0ustar sylvestresylvestrefunction [Jv, flag, new_data] = cvm_jtv(t, y, fy, v, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [Jv, flag] = feval(fct,t,y,fy,v); new_data = []; else [Jv, flag, new_data] = feval(fct,t,y,fy,v,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_bjac.m0000600000175000017500000000037111741421121022247 0ustar sylvestresylvestrefunction [J, flag, new_data] = cvm_bjac(t, y, fy, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [J, flag] = feval(fct,t,y,fy); new_data = []; else [J, flag, new_data] = feval(fct,t,y,fy,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_options.m0000600000175000017500000000235311741421121023045 0ustar sylvestresylvestrefunction options = cvm_options(KeyNames, varargin) m = length(KeyNames); % Initialize the output options structure options = []; for i = 1:m options.(KeyNames{i}) = []; end % If the first argument is an options structure, read its non-empty fields % and update options. Store in j the start of key-value pairs. arg = varargin{1}; if isa(arg,'struct') for i = 1:m if isfield(arg,KeyNames{i}) options.(KeyNames{i}) = arg.(KeyNames{i}); end end j = 2; else j = 1; end % The remaining input arguments must be key-value pairs if rem(nargin-j,2) ~= 0 error('Arguments must be key-value pairs.'); end % Process each key-value pair np = (nargin-j)/2; keynames = lower(KeyNames); for i = 1:np % Get the key key = varargin{j}; % key must be a string if ~isstr(key) error(sprintf('Argument %d is not a string property name.', j)); end % Get the index in keynames that exactly matches the current key % (modulo the case) ik = strmatch(lower(key), keynames, 'exact'); if isempty(ik) error(sprintf('Unrecognized property "%s"', key)); end % Get the value val = varargin{j+1}; % Set the proper field in options options.(KeyNames{ik}) = val; % move to next pair j = j+2; end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_bjacB.m0000600000175000017500000000041211741421121022345 0ustar sylvestresylvestrefunction [JB, flag, new_data] = cvm_bjacB(t, y, yB, fyB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [JB, flag] = feval(fct,t,y,yB,fyB); new_data = []; else [JB, flag, new_data] = feval(fct,t,y,yB,fyB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_psol.m0000600000175000017500000000040011741421121022316 0ustar sylvestresylvestrefunction [z, flag, new_data] = cvm_psol(t, y, fy, r, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [z, flag] = feval(fct,t,y,fy,r); new_data = []; else [z, flag, new_data] = feval(fct,t,y,fy,r,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_pset.m0000600000175000017500000000043111741421121022320 0ustar sylvestresylvestrefunction [jcur, flag, new_data] = cvm_pset(t, y, fy, jok, gm, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [jcur, flag] = feval(fct,t,y,fy,jok,gm); new_data = []; else [jcur, flag, new_data] = feval(fct,t,y,fy,jok,gm,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_djacB.m0000600000175000017500000000041211741421121022347 0ustar sylvestresylvestrefunction [JB, flag, new_data] = cvm_djacB(t, y, yB, fyB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [JB, flag] = feval(fct,t,y,yB,fyB); new_data = []; else [JB, flag, new_data] = feval(fct,t,y,yB,fyB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_monitor.m0000600000175000017500000000047611741421121023045 0ustar sylvestresylvestrefunction new_mondata = cvm_monitor(call, t, y, yQ, Ns, yS, fct, mondata) % % Wrapper around the actual user-provided Matlab function % N = length(y); yS = reshape(yS,N,Ns); if isempty(mondata) feval(fct, call, t, y, yQ, yS); new_mondata = []; else new_mondata = feval(fct, call, t, y, yQ, yS, mondata); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_gcomB.m0000600000175000017500000000035711741421121022403 0ustar sylvestresylvestrefunction [flag, new_data] = cvm_gcomB(t, y, yB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,t,y,yB); new_data = []; else [flag, new_data] = feval(fct,t,y,yB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_rhs.m0000600000175000017500000000036211741421121022144 0ustar sylvestresylvestrefunction [yd, flag, new_data] = cvm_rhs(t, y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [yd, flag] = feval(fct,t,y); new_data = []; else [yd, flag, new_data] = feval(fct,t,y,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_rhsQB.m0000600000175000017500000000145511741421121022373 0ustar sylvestresylvestrefunction [qBd, flag, new_data] = cvm_rhsQB(type, varargin) % % Wrapper around the actual user-provided Matlab function % switch type case 0 % Not dependent on yS t = varargin{1}; y = varargin{2}; yB = varargin{3}; fct = varargin{4}; data = varargin{5}; if isempty(data) [qBd, flag] = feval(fct,t,y,yB); new_data = []; else [qBd, flag, new_data] = feval(fct,t,y,yB,data); end case 1 % Dependent on yS t = varargin{1}; y = varargin{2}; Ns = varargin{3}; yS = varargin{4}; yB = varargin{5}; fct = varargin{6}; data = varargin{7}; N = length(y); yS = reshape(yS,N,Ns); if isempty(data) [qBd, flag] = feval(fct,t,y,yS,yB); new_data = []; else [qBd, flag, new_data] = feval(fct,t,y,yS,yB,data); end endsundials-2.5.0/sundialsTB/cvodes/cvm/cvm_psetB.m0000600000175000017500000000046011741421121022424 0ustar sylvestresylvestrefunction [jcurB, flag, new_data] = cvm_psetB(t, y, yB, fyB, jokB, gmB, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [jcurB, flag] = feval(fct,t,y,yB,fyB,jokB,gmB); new_data = []; else [jcurB, flag, new_data] = feval(fct,t,y,yB,fyB,jokB,gmB,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_rhsB.m0000600000175000017500000000147111741421121022250 0ustar sylvestresylvestrefunction [yBd, flag, new_data] = cvm_rhsB(type, varargin) % % Wrapper around the actual user-provided Matlab function % switch type case 0 % Not dependent on yS t = varargin{1}; y = varargin{2}; yB = varargin{3}; fct = varargin{4}; data = varargin{5}; if isempty(data) [yBd, flag] = feval(fct,t,y,yB); new_data = []; else [yBd, flag, new_data] = feval(fct,t,y,yB,data); end case 1 % Dependent on yS t = varargin{1}; y = varargin{2}; Ns = varargin{3}; yS = varargin{4}; yB = varargin{5}; fct = varargin{6}; data = varargin{7}; N = length(y); yS = reshape(yS,N,Ns); if isempty(data) [yBd, flag] = feval(fct,t,y,yS,yB); new_data = []; else [yBd, flag, new_data] = feval(fct,t,y,yS,yB,data); end end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_rhsQ.m0000600000175000017500000000036211741421121022265 0ustar sylvestresylvestrefunction [qd, flag, new_data] = cvm_rhsQ(t, y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [qd, flag] = feval(fct,t,y); new_data =[]; else [qd, flag, new_data] = feval(fct,t,y,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_monitorB.m0000600000175000017500000000047111741421121023142 0ustar sylvestresylvestrefunction [new_mondata] = cvm_monitorB(call, idxB, t, y, yQ, fct, mondata) % % Wrapper around the actual user-provided Matlab function % N = length(y); idxB = idxB+1; if isempty(mondata) feval(fct, call, idxB, t, y, yQ); new_mondata = []; else new_mondata = feval(fct, call, idxB, t, y, yQ, mondata); end sundials-2.5.0/sundialsTB/cvodes/cvm/cvm_root.m0000600000175000017500000000036011741421121022331 0ustar sylvestresylvestrefunction [g, flag, new_data] = cvm_root(t, y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [g, flag] = feval(fct,t,y); new_data = []; else [g, flag, new_data] = feval(fct,t,y,data); end sundials-2.5.0/sundialsTB/cvodes/cvm/src/0000755000175000017500000000000011767174700021143 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/cvm/src/cvm.h0000600000175000017500000002327611741421121022063 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.14 $ * $Date: 2012/03/07 21:44:21 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/cvodes/LICENSE. * ----------------------------------------------------------------- * Header file for the CVODES Matlab interface. * ----------------------------------------------------------------- */ #ifndef _CVM_H #define _CVM_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include "mex.h" #include #include #include #include #include #include #include #include #include /* * --------------------------------------------------------------------------------- * Constants * --------------------------------------------------------------------------------- */ /* Tolerance types */ enum {CV_SS, CV_SV, CV_EE}; /* Linear solver types */ enum {LS_NONE, LS_DENSE, LS_DIAG, LS_BAND, LS_SPGMR, LS_SPBCG, LS_SPTFQMR}; /* Preconditioner modules */ enum {PM_NONE, PM_BANDPRE, PM_BBDPRE}; /* * --------------------------------------------------------------------------------- * Types for global data structures * --------------------------------------------------------------------------------- */ typedef struct cvmPbData_ { long int n; /* problem dimension */ N_Vector Y; /* solution vector */ booleantype Quadr; /* integrate quadratures? */ long int nq; /* number of quadratures */ N_Vector YQ; /* quadratures vector */ booleantype Fsa; /* integrate sensitivities? */ int ns; /* number of sensitivities */ N_Vector *YS; /* sensitivity vectors */ booleantype RootSet; /* rootfinding active? */ int ng; /* number of root functions */ booleantype TstopSet; /* tstop active? */ int LS; /* linear solver type */ int PM; /* preconditioner module */ booleantype Mon; /* monitoring? */ /* Matlab functions and data associated with this problem */ mxArray *RHSfct; mxArray *QUADfct; mxArray *JACfct; mxArray *PSETfct; mxArray *PSOLfct; mxArray *GLOCfct; mxArray *GCOMfct; mxArray *Gfct; mxArray *SRHSfct; mxArray *MONfct; mxArray *MONdata; /* Pointer to the global Matlab user data */ mxArray *mtlb_data; /* Information for backward problems only */ struct cvmPbData_ *fwd; int index; /* index of this problem */ struct cvmPbData_ *next; /* pointer to next problem in linked list */ } *cvmPbData; typedef struct cvmInterfaceData_ { void *cvode_mem; /* CVODES solver memory */ booleantype asa; /* Perform ASA? */ int Nd; /* number of data points */ int Nc; /* number of check points */ struct cvmPbData_ *fwdPb; struct cvmPbData_ *bckPb; int NbckPb; /* Number of backward problems in the linked list bckPb */ booleantype errMsg; /* post error/warning messages? */ } *cvmInterfaceData; /* * --------------------------------------------------------------------------------- * Error handler function * --------------------------------------------------------------------------------- */ void cvmErrHandler(int error_code, const char *module, const char *function, char *msg, void *eh_data); /* * --------------------------------------------------------------------------------- * Wrapper functions * --------------------------------------------------------------------------------- */ int mxW_CVodeRhs(realtype t, N_Vector y, N_Vector yd, void *user_data); int mxW_CVodeGfct(realtype t, N_Vector y, double *g, void *user_data); int mxW_CVodeQUADfct(realtype t, N_Vector y, N_Vector yQd, void *user_data); int mxW_CVodeSensRhs1(int Ns, realtype t, N_Vector y, N_Vector ydot, int iS, N_Vector yS, N_Vector ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); int mxW_CVodeSensRhs(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); int mxW_CVodeDenseJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_CVodeBandJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_CVodeSpilsJac(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); int mxW_CVodeSpilsPset(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int mxW_CVodeSpilsPsol(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector tmp); int mxW_CVodeBBDgloc(long int Nlocal, realtype t, N_Vector y, N_Vector g, void *user_data); int mxW_CVodeBBDgcom(long int Nlocal, realtype t, N_Vector y, void *user_data); void mxW_CVodeMonitor(int call, double t, N_Vector y, N_Vector yQ, N_Vector *yS, cvmPbData fwdPb); int mxW_CVodeRhsB(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB); int mxW_CVodeRhsBS(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBd, void *user_dataB); int mxW_CVodeQUADfctB(realtype t, N_Vector y, N_Vector yB, N_Vector qBdot, void *user_dataB); int mxW_CVodeQUADfctBS(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yQBd, void *user_dataB); int mxW_CVodeDenseJacB(long int nB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_CVodeBandJacB(long int nB, long int mupperB, long int mlowerB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_CVodeSpilsJacB(N_Vector vB, N_Vector JvB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, void *user_dataB, N_Vector tmpB); int mxW_CVodeSpilsPsetB(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); int mxW_CVodeSpilsPsolB(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *user_dataB, N_Vector tmpB); int mxW_CVodeBBDglocB(long int NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector gB, void *user_dataB); int mxW_CVodeBBDgcomB(long int NlocalB, realtype t, N_Vector y, N_Vector yB, void *user_dataB); void mxW_CVodeMonitorB(int call, int idxB, double tB, N_Vector yB, N_Vector yQB, cvmPbData bckPb); /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_IntgrOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, int lmm, int *maxord, booleantype *sld, booleantype *errmsg, long int *mxsteps, int *itol, realtype *reltol, double *Sabstol, double **Vabstol, double *hin, double *hmax, double *hmin, double *tstop, booleantype *rhs_s); int get_LinSolvOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, long int *mupper, long int *mlower, long int *mudq, long int *mldq, double *dqrely, int *ptype, int *gstype, int *maxl); int get_QuadOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, long int Nq, booleantype *rhs_s, booleantype *errconQ, int *itolQ, double *reltolQ, double *SabstolQ, double **VabstolQ); int get_FSAOptions(const mxArray *options, cvmPbData thisPb, int *ism, char **pfield_name, int **plist, double **pbar, int *dqtype, double *rho, booleantype *errconS, int *itolS, double *reltolS, double **SabstolS, double **VabstolS); #ifdef __cplusplus } #endif #endif sundials-2.5.0/sundialsTB/cvodes/cvm/src/cvm.c0000600000175000017500000026043311741421121022054 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.26 $ * $Date: 2012/03/07 21:48:00 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/cvodes/LICENSE. * ----------------------------------------------------------------- * MEX implementation for CVODES Matlab interface. * ----------------------------------------------------------------- */ #include #include #include "cvm.h" #include "nvm.h" /* * --------------------------------------------------------------------------------- * Global interface data variable * --------------------------------------------------------------------------------- */ cvmInterfaceData cvmData = NULL; /* * --------------------------------------------------------------------------------- * Static function prototypes * --------------------------------------------------------------------------------- */ static void cvmInitCVODESdata(); static void cvmPersistCVODESdata(); static void cvmFinalCVODESdata(); static void cvmInitPbData(cvmPbData pb); static void cvmPersistPbData(cvmPbData pb); static void cvmFinalPbData(cvmPbData pb); static int CVM_Initialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_QuadInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_SensInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_AdjInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_InitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_QuadInitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_SensToggleOff(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_SolveB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int cvmSolveB_one(mxArray *plhs[], int NtoutB, double *toutB, int itaskB); static int cvmSolveB_more(mxArray *plhs[], int NtoutB, double *toutB, int itaskB, booleantype any_quadrB, booleantype any_monB); static int CVM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_StatsB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_SetB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int CVM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); /* * --------------------------------------------------------------------------------- * Main entry point * --------------------------------------------------------------------------------- */ void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[] ) { int mode; /* Modes: 1 - initialize CVODES solver 2 - initialize quadratures 3 - initialize forward sensitivity calculations 4 - initialize adjoint sensitivity calculations 5 - initialize backward solver 6 - initialize backward quadratures 11 - reinitialize CVODES solver 12 - reinitialize quadratures 13 - reinitialize forward sensitivity calculations 14 - reinitialize adjoint sensitivity calculations 15 - reinitialize backward solver 16 - reinitialize backward quadratures 18 - toggle FSA off 20 - solve problem 21 - solve backward problem 30 - get integrator stats 31 - get backward integrator stats 32 - extract data from cvode_mem 33 - set one optional input at a time 34 - set one optional input at a time for backward problems 40 - finalize */ mode = (int)mxGetScalar(prhs[0]); mexUnlock(); if ( (mode != 1) && (cvmData == NULL) ) { mexErrMsgTxt("CVODES - Illegal attempt to call before CVodeInit."); } switch(mode) { /* Initialization functions */ case 1: if (cvmData != NULL) { CVM_Free(nlhs, plhs, nrhs-1, &prhs[1]); cvmFinalCVODESdata(); } cvmInitCVODESdata(); CVM_Initialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 2: CVM_QuadInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 3: CVM_SensInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 4: CVM_AdjInitialization(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 5: CVM_InitializationB(0, nlhs, plhs, nrhs-1, &prhs[1]); break; case 6: CVM_QuadInitializationB(0, nlhs, plhs, nrhs-1, &prhs[1]); break; /* Re-initialization functions */ case 11: CVM_Initialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 12: CVM_QuadInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 13: CVM_SensInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 14: CVM_AdjInitialization(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 15: CVM_InitializationB(1, nlhs, plhs, nrhs-1, &prhs[1]); break; case 16: CVM_QuadInitializationB(1, nlhs, plhs, nrhs-1, &prhs[1]); break; /* Sensitivity toggle function */ case 18: CVM_SensToggleOff(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Solve functions */ case 20: CVM_Solve(nlhs, plhs, nrhs-1, &prhs[1]); break; case 21: CVM_SolveB(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Optional output extraction functions */ case 30: CVM_Stats(nlhs, plhs, nrhs-1, &prhs[1]); break; case 31: CVM_StatsB(nlhs, plhs, nrhs-1, &prhs[1]); break; case 32: CVM_Get(nlhs, plhs, nrhs-1, &prhs[1]); break; case 33: CVM_Set(nlhs, plhs, nrhs-1, &prhs[1]); break; case 34: CVM_SetB(nlhs, plhs, nrhs-1, &prhs[1]); break; /* Memory deallocation function */ case 40: CVM_Free(nlhs, plhs, nrhs-1, &prhs[1]); cvmFinalCVODESdata(); return; } /* Unless this was the CVodeFree call, * make data persistent and lock the MEX file */ if (mode != 40) { cvmPersistCVODESdata(); mexLock(); } return; } /* * --------------------------------------------------------------------------------- * Private functions * --------------------------------------------------------------------------------- */ static void cvmInitCVODESdata() { /* Allocate space for global CVODES data structure */ cvmData = (cvmInterfaceData) mxMalloc(sizeof(struct cvmInterfaceData_)); /* Initialize global CVODES data */ cvmData->cvode_mem = NULL; cvmData->fwdPb = NULL; cvmData->bckPb = NULL; cvmData->NbckPb = 0; cvmData->Nd = 0; cvmData->Nc = 0; cvmData->asa = FALSE; cvmData->errMsg = TRUE; return; } static void cvmInitPbData(cvmPbData pb) { mxArray *empty; pb->n = 0; pb->nq = 0; pb->ng = 0; pb->ns = 0; pb->Y = NULL; pb->YQ = NULL; pb->YS = NULL; pb->Quadr = FALSE; pb->Fsa = FALSE; pb->Mon = FALSE; pb->LS = LS_DENSE; pb->PM = PM_NONE; empty = mxCreateDoubleMatrix(0,0,mxREAL); pb->RHSfct = mxDuplicateArray(empty); pb->Gfct = mxDuplicateArray(empty); pb->QUADfct = mxDuplicateArray(empty); pb->SRHSfct = mxDuplicateArray(empty); pb->JACfct = mxDuplicateArray(empty); pb->PSETfct = mxDuplicateArray(empty); pb->PSOLfct = mxDuplicateArray(empty); pb->GLOCfct = mxDuplicateArray(empty); pb->GCOMfct = mxDuplicateArray(empty); pb->MONfct = mxDuplicateArray(empty); pb->MONdata = mxDuplicateArray(empty); pb->mtlb_data = mxDuplicateArray(empty); pb->fwd = cvmData->fwdPb; pb->index = 0; pb->next = NULL; mxDestroyArray(empty); } static void cvmPersistCVODESdata() { cvmPbData tmpPb; /* Make global memory persistent */ if (cvmData->fwdPb != NULL) { cvmPersistPbData(cvmData->fwdPb); mexMakeMemoryPersistent(cvmData->fwdPb); } tmpPb = cvmData->bckPb; while(tmpPb != NULL) { cvmPersistPbData(tmpPb); mexMakeMemoryPersistent(tmpPb); tmpPb = tmpPb->next; } mexMakeMemoryPersistent(cvmData); return; } static void cvmPersistPbData(cvmPbData pb) { mexMakeArrayPersistent(pb->mtlb_data); mexMakeArrayPersistent(pb->RHSfct); mexMakeArrayPersistent(pb->Gfct); mexMakeArrayPersistent(pb->QUADfct); mexMakeArrayPersistent(pb->SRHSfct); mexMakeArrayPersistent(pb->JACfct); mexMakeArrayPersistent(pb->PSETfct); mexMakeArrayPersistent(pb->PSOLfct); mexMakeArrayPersistent(pb->GLOCfct); mexMakeArrayPersistent(pb->GCOMfct); mexMakeArrayPersistent(pb->MONfct); mexMakeArrayPersistent(pb->MONdata); } static void cvmFinalCVODESdata() { cvmPbData tmpPb; if (cvmData == NULL) return; if (cvmData->fwdPb != NULL) { cvmFinalPbData(cvmData->fwdPb); mxFree(cvmData->fwdPb); cvmData->fwdPb = NULL; } while(cvmData->bckPb != NULL) { tmpPb = cvmData->bckPb->next; mxFree(cvmData->bckPb); cvmData->bckPb = tmpPb; } mxFree(cvmData); cvmData = NULL; return; } static void cvmFinalPbData(cvmPbData pb) { if (pb->Y != NULL) N_VDestroy(pb->Y); if (pb->YQ != NULL) N_VDestroy(pb->YQ); if (pb->YS != NULL) N_VDestroyVectorArray(pb->YS, pb->ns); mxDestroyArray(pb->mtlb_data); mxDestroyArray(pb->RHSfct); mxDestroyArray(pb->Gfct); mxDestroyArray(pb->QUADfct); mxDestroyArray(pb->SRHSfct); mxDestroyArray(pb->JACfct); mxDestroyArray(pb->PSETfct); mxDestroyArray(pb->PSOLfct); mxDestroyArray(pb->GLOCfct); mxDestroyArray(pb->GCOMfct); mxDestroyArray(pb->MONfct); mxDestroyArray(pb->MONdata); } /* * --------------------------------------------------------------------------------- * Error handler function. * * This function is both passed as the CVODES error handler and used throughout * the Matlab interface. * * If called directly by one of the interface functions, error_code = -999 to * indicate an error and err_code = +999 to indicate a warning. Otherwise, * err_code is set by the calling CVODES function. * * NOTE: mexErrMsgTxt will end the execution of the MEX file. Therefore we do * not have to intercept any of the CVODES error return flags. * The only return flags we intercept are those from CVode() and CVodeB() * which are passed back to the user (only positive values will make it). * --------------------------------------------------------------------------------- */ void cvmErrHandler(int error_code, const char *module, const char *function, char *msg, void *eh_data) { char err_msg[256]; if (!(cvmData->errMsg)) return; if (error_code > 0) { sprintf(err_msg,"Warning in ==> %s\n%s",function,msg); mexWarnMsgTxt(err_msg); } else if (error_code < 0) { /*mexUnlock(); cvmFinalCVODESdata();*/ sprintf(err_msg,"Error using ==> %s\n%s",function,msg); mexErrMsgTxt(err_msg); } return; } /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define cvode_mem (cvmData->cvode_mem) #define asa (cvmData->asa) #define Nd (cvmData->Nd) #define Nc (cvmData->Nc) #define NbckPb (cvmData->NbckPb) #define fsa (fwdPb->Fsa) #define quadr (fwdPb->Quadr) #define mon (fwdPb->Mon) #define rootSet (fwdPb->RootSet) #define tstopSet (fwdPb->TstopSet) #define y (fwdPb->Y) #define yQ (fwdPb->YQ) #define yS (fwdPb->YS) #define N (fwdPb->n) #define Nq (fwdPb->nq) #define Ng (fwdPb->ng) #define Ns (fwdPb->ns) #define ls (fwdPb->LS) #define pm (fwdPb->PM) #define mtlb_data (fwdPb->mtlb_data) #define mtlb_RHSfct (fwdPb->RHSfct) #define mtlb_QUADfct (fwdPb->QUADfct) #define mtlb_JACfct (fwdPb->JACfct) #define mtlb_PSETfct (fwdPb->PSETfct) #define mtlb_PSOLfct (fwdPb->PSOLfct) #define mtlb_GLOCfct (fwdPb->GLOCfct) #define mtlb_GCOMfct (fwdPb->GCOMfct) #define mtlb_Gfct (fwdPb->Gfct) #define mtlb_SRHSfct (fwdPb->SRHSfct) #define mtlb_MONfct (fwdPb->MONfct) #define mtlb_MONdata (fwdPb->MONdata) #define indexB (bckPb->index) #define quadrB (bckPb->Quadr) #define monB (bckPb->Mon) #define yB (bckPb->Y) #define yQB (bckPb->YQ) #define NB (bckPb->n) #define NqB (bckPb->nq) #define lsB (bckPb->LS) #define pmB (bckPb->PM) #define mtlb_dataB (bckPb->mtlb_data) #define mtlb_RHSfctB (bckPb->RHSfct) #define mtlb_QUADfctB (bckPb->QUADfct) #define mtlb_JACfctB (bckPb->JACfct) #define mtlb_PSETfctB (bckPb->PSETfct) #define mtlb_PSOLfctB (bckPb->PSOLfct) #define mtlb_GLOCfctB (bckPb->GLOCfct) #define mtlb_GCOMfctB (bckPb->GCOMfct) #define mtlb_MONfctB (bckPb->MONfct) #define mtlb_MONdataB (bckPb->MONdata) /* * --------------------------------------------------------------------------------- * Exported procedures * --------------------------------------------------------------------------------- */ /* CVM_Initialization * * action = 0 -> CVodeCreate + CVodeInit * prhs contains: * fct * lmm * iter * t0 * y0 * options * data * * action = 1 -> CVodeReInit * prhs contains: * t0 * y0 * options * */ static int CVM_Initialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; const mxArray *options; double t0, *y0; int lmm, iter, maxord; long int mxsteps; int itol; realtype reltol, Sabstol, *Vabstol; N_Vector NV_abstol; double hin, hmax, hmin; double tstop; booleantype sld; booleantype errmsg; booleantype rhs_s; /* ignored */ long int mupper, mlower; int ptype, gstype, maxl; long int mudq, mldq; double dqrely; char *bufval; int buflen, status; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* SOLVER INITIALIZATION */ /* Create and initialize a new problem */ fwdPb = (cvmPbData) mxMalloc(sizeof(struct cvmPbData_)); cvmInitPbData(fwdPb); cvmData->fwdPb = fwdPb; /* Initialize appropriate vector module */ InitVectors(); /* Extract user-provided RHS function */ mxDestroyArray(mtlb_RHSfct); mtlb_RHSfct = mxDuplicateArray(prhs[0]); /* Extract lmm */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", "CVodeInit", "Cannot parse LMM input argument.", NULL); goto error_return; } if(!strcmp(bufval,"Adams")) { lmm = CV_ADAMS; } else if(!strcmp(bufval,"BDF")) { lmm = CV_BDF; } else { cvmErrHandler(-999, "CVODES", "CVodeInit", "LMM has an illegal value.", NULL); goto error_return; } mxFree(bufval); /* Extract iter */ buflen = mxGetM(prhs[2]) * mxGetN(prhs[2]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[2], bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", "CVodeInit", "Cannot parse NLS input argument.", NULL); goto error_return; } if(!strcmp(bufval,"Functional")) { iter = CV_FUNCTIONAL; } else if(!strcmp(bufval,"Newton")) { iter = CV_NEWTON; } else { cvmErrHandler(-999, "CVODES", "CVodeInit", "NLS has an illegal value.", NULL); goto error_return; } mxFree(bufval); /* Extract initial time */ t0 = (double)mxGetScalar(prhs[3]); /* Extract initial conditions */ y0 = mxGetPr(prhs[4]); N = mxGetM(prhs[4]); /* Create the solution N_Vector */ y = NewVector(N); /* Load initial conditions */ PutData(y, y0, N); /* Extract options structure */ options = prhs[5]; break; case 1: /* SOLVER RE-INITIALIZATION */ fwdPb = cvmData->fwdPb; /* If monitoring was enabled, finalize it now. */ if (mon) mxW_CVodeMonitor(2, 0.0, NULL, NULL, NULL, fwdPb); /* Extract initial time */ t0 = (double)mxGetScalar(prhs[0]); /* Extract initial conditions */ y0 = mxGetPr(prhs[1]); if (mxGetM(prhs[1]) != N) { cvmErrHandler(-999, "CVODES", "CVodeReInit", "Size of y0 changed from CVodeInit call.", NULL); goto error_return; } /* Load initial conditions */ PutData(y, y0, N); /* Extract options structure */ options = prhs[2]; break; } /* Process the options structure */ status = get_IntgrOptions(options, fwdPb, TRUE, lmm, &maxord, &sld, &errmsg, &mxsteps, &itol, &reltol, &Sabstol, &Vabstol, &hin, &hmax, &hmin, &tstop, &rhs_s); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate CVODES functions * * If action = 0 * Create CVODES object and allocate memory * Attach error handler function * Redirect output * If action = 1 * Reinitialize solver * ---------------------------------------- */ switch (action) { case 0: /* Create CVODES object */ cvode_mem = CVodeCreate(lmm, iter); if (cvode_mem == NULL) goto error_return; /* Attach the global CVODES data as 'user-data' */ status = CVodeSetUserData(cvode_mem, fwdPb); if (status != CV_SUCCESS) goto error_return; /* Attach error handler function */ status = CVodeSetErrHandlerFn(cvode_mem, cvmErrHandler, NULL); if (status != CV_SUCCESS) goto error_return; /* Call CVodeInit */ status = CVodeInit(cvode_mem, mxW_CVodeRhs, t0, y); if (status != CV_SUCCESS) goto error_return; /* Redirect output */ status = CVodeSetErrFile(cvode_mem, stdout); if (status != CV_SUCCESS) goto error_return; break; case 1: /* Reinitialize solver */ status = CVodeReInit(cvode_mem, t0, y); if (status != CV_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances * ---------------------------------------- */ switch (itol) { case CV_SS: status = CVodeSStolerances(cvode_mem, reltol, Sabstol); if (status != CV_SUCCESS) goto error_return; break; case CV_SV: NV_abstol = N_VClone(y); PutData(NV_abstol, Vabstol, N); status = CVodeSVtolerances(cvode_mem, reltol, NV_abstol); if (status != CV_SUCCESS) goto error_return; N_VDestroy(NV_abstol); break; } /* * -------------------------------- * Set various optional inputs * -------------------------------- */ /* set maxorder (default is consistent with LMM) */ status = CVodeSetMaxOrd(cvode_mem, maxord); if (status != CV_SUCCESS) goto error_return; /* set initial step size (the default value of 0.0 is ignored by CVODES) */ status = CVodeSetInitStep(cvode_mem, hin); if (status != CV_SUCCESS) goto error_return; /* set max step (default is infinity) */ status = CVodeSetMaxStep(cvode_mem, hmax); if (status != CV_SUCCESS) goto error_return; /* set min step (default is 0) */ status = CVodeSetMinStep(cvode_mem, hmin); if (status != CV_SUCCESS) goto error_return; /* set number of max steps */ status = CVodeSetMaxNumSteps(cvode_mem, mxsteps); if (status != CV_SUCCESS) goto error_return; /* set tstop? */ if (tstopSet) { status = CVodeSetStopTime(cvode_mem, tstop); if (status != CV_SUCCESS) goto error_return; } /* set stability limit detection (default is FALSE) */ status = CVodeSetStabLimDet(cvode_mem, sld); if (status != CV_SUCCESS) goto error_return; /* Rootfinding? */ if ( !mxIsEmpty(mtlb_Gfct) && (Ng > 0) ) { status = CVodeRootInit(cvode_mem, Ng, mxW_CVodeGfct); if (status != CV_SUCCESS) goto error_return; rootSet = TRUE; } else { rootSet = FALSE; } /* * ---------------------------------------- * Need a linear solver? * ---------------------------------------- */ if (iter == CV_NEWTON) { status = get_LinSolvOptions(options, fwdPb, TRUE, &mupper, &mlower, &mudq, &mldq, &dqrely, &ptype, &gstype, &maxl); if (status != 0) goto error_return; switch (ls) { case LS_DENSE: status = CVDense(cvode_mem, N); if (status != CV_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = CVDlsSetDenseJacFn(cvode_mem, mxW_CVodeDenseJac); if (status != CV_SUCCESS) goto error_return; } break; case LS_DIAG: status = CVDiag(cvode_mem); if (status != CV_SUCCESS) goto error_return; break; case LS_BAND: status = CVBand(cvode_mem, N, mupper, mlower); if (status != CV_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = CVDlsSetBandJacFn(cvode_mem, mxW_CVodeBandJac); if (status != CV_SUCCESS) goto error_return; } break; case LS_SPGMR: status = CVSpgmr(cvode_mem, ptype, maxl); if (status != CV_SUCCESS) goto error_return; status = CVSpilsSetGSType(cvode_mem, gstype); if (status != CV_SUCCESS) goto error_return; break; case LS_SPBCG: status = CVSpbcg(cvode_mem, ptype, maxl); if (status != CV_SUCCESS) goto error_return; break; case LS_SPTFQMR: status = CVSptfqmr(cvode_mem, ptype, maxl); if (status != CV_SUCCESS) goto error_return; break; } /* Jacobian * vector and preconditioner for SPILS linear solvers */ if ( (ls==LS_SPGMR) || (ls==LS_SPBCG) || (ls==LS_SPTFQMR) ) { if (!mxIsEmpty(mtlb_JACfct)) { status = CVSpilsSetJacTimesVecFn(cvode_mem, mxW_CVodeSpilsJac); if (status != CV_SUCCESS) goto error_return; } switch (pm) { case PM_NONE: if (!mxIsEmpty(mtlb_PSOLfct)) { if (!mxIsEmpty(mtlb_PSETfct)) status = CVSpilsSetPreconditioner(cvode_mem, mxW_CVodeSpilsPset, mxW_CVodeSpilsPsol); else status = CVSpilsSetPreconditioner(cvode_mem, NULL, mxW_CVodeSpilsPsol); if (status != CV_SUCCESS) goto error_return; } break; case PM_BANDPRE: status = CVBandPrecInit(cvode_mem, N, mupper, mlower); if (status != CV_SUCCESS) goto error_return; break; case PM_BBDPRE: if (!mxIsEmpty(mtlb_GCOMfct)) status = CVBBDPrecInit(cvode_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_CVodeBBDgloc, mxW_CVodeBBDgcom); else status = CVBBDPrecInit(cvode_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_CVodeBBDgloc, NULL); if (status != CV_SUCCESS) goto error_return; break; } } } else { ls = LS_NONE; } /* Do we monitor? */ if (mon) mxW_CVodeMonitor(0, t0, NULL, NULL, NULL, fwdPb); /* Set errMsg field in global data * (all error messages from here on will respect this) */ cvmData->errMsg = errmsg; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* CVM_QuadInitialization * * action = 0 -> CVodeQuadInit * prhs contains: * fQ * y0 * options * * action = 1 -> CVodeQuadReInit * prhs contains: * y0 * options * */ static int CVM_QuadInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; const mxArray *options; double *yQ0; booleantype rhs_s; /* ignored */ booleantype errconQ; int itolQ; realtype reltolQ, SabstolQ, *VabstolQ; N_Vector NV_abstolQ; int status; fwdPb = cvmData->fwdPb; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* QUADRATURE INITIALIZATION */ /* Extract user-provided quadrature RHS function */ mxDestroyArray(mtlb_QUADfct); mtlb_QUADfct = mxDuplicateArray(prhs[0]); /* Extract quadrature initial conditions */ yQ0 = mxGetPr(prhs[1]); Nq = mxGetM(prhs[1]); /* Create the quadrature N_Vector */ yQ = NewVector(Nq); /* Load quadrature initial conditions */ PutData(yQ, yQ0, Nq); /* Extract quadrature options structure */ options = prhs[2]; break; case 1: /* QUADRATURE RE-INITIALIZATION */ /* Extract quadrature initial conditions */ yQ0 = mxGetPr(prhs[0]); if (mxGetM(prhs[0]) != Nq) { cvmErrHandler(-999, "CVODES", "CVodeQuadReInit", "Size of yQ0 changed from CVodeQuadInit call.", NULL); goto error_return; } /* Load quadrature initial conditions */ PutData(yQ, yQ0, Nq); /* Extract quadrature options structure */ options = prhs[1]; break; } /* Process the options structure */ status = get_QuadOptions(options, fwdPb, TRUE, Nq, &rhs_s, &errconQ, &itolQ, &reltolQ, &SabstolQ, &VabstolQ); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate CVODES functions * * If action = 0 * Initialize quadratures * If action = 1 * Reinitialize quadratures * ---------------------------------------- */ switch (action) { case 0: status = CVodeQuadInit(cvode_mem, mxW_CVodeQUADfct, yQ); if (status != CV_SUCCESS) goto error_return; break; case 1: status = CVodeQuadReInit(cvode_mem, yQ); if (status != CV_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances for quadrature variables * ---------------------------------------- */ status = CVodeSetQuadErrCon(cvode_mem, errconQ); if (status != CV_SUCCESS) goto error_return; if (errconQ) { switch (itolQ) { case CV_SS: status = CVodeQuadSStolerances(cvode_mem, reltolQ, SabstolQ); if (status != CV_SUCCESS) goto error_return; break; case CV_SV: NV_abstolQ = N_VClone(yQ); PutData(NV_abstolQ, VabstolQ, Nq); status = CVodeQuadSVtolerances(cvode_mem, reltolQ, NV_abstolQ); if (status != CV_SUCCESS) goto error_return; N_VDestroy(NV_abstolQ); break; } } /* Quadratures will be integrated */ quadr = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* CVM_SensInitialization * * action = 0 -> CVodeSensInit * prhs contains: * Ns * fS * yS0 * options * action = 1 -> CVodeSensReInit * yS0 * options * */ static int CVM_SensInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; const mxArray *options; booleantype fS_DQ; CVSensRhsFn rhsS; double *yS0; int ism; mxArray *pfield; char *pfield_name; booleantype errconS; int itolS; realtype reltolS; realtype *SabstolS, *VabstolS; N_Vector *NV_abstolS; int *plist, dqtype; double *p, *pbar, rho; int is, status; p = NULL; plist = NULL; pbar = NULL; fwdPb = cvmData->fwdPb; /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* FSA INITIALIZATION */ /* Extract number of sensitivities */ Ns = (int)mxGetScalar(prhs[0]); /* Extract user-provided sensitivity RHS function */ if ( mxIsEmpty(prhs[1]) ) { rhsS = NULL; fS_DQ = TRUE; } else { mxDestroyArray(mtlb_SRHSfct); mtlb_SRHSfct = mxDuplicateArray(prhs[1]); rhsS = mxW_CVodeSensRhs; fS_DQ = FALSE; } /* Extract sensitivity initial condition */ yS0 = mxGetPr(prhs[2]); /* Create the sensitivity N_Vectors */ yS = N_VCloneVectorArray(Ns, y); /* Load sensitivity initial conditions */ for (is=0;isfwdPb; status = CVodeSensToggleOff(cvode_mem); if (status != CV_SUCCESS) { status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } fsa = FALSE; status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); } /* CVM_AdjInitialization * * prhs contains: * Nd - number of interpolatin data points (i.e. steps between check points) * interp - type of interpolation * */ static int CVM_AdjInitialization(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { int interp; int buflen, status; char *bufval; switch (action) { case 0: /* Number of steps */ Nd = (int)mxGetScalar(prhs[0]); /* Interpolation method */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", "CVodeAdjInit", "Could not parse InterpType.", NULL); goto error_return; } if(!strcmp(bufval,"Hermite")) { interp = CV_HERMITE; } else if(!strcmp(bufval,"Polynomial")) { interp = CV_POLYNOMIAL; } else { cvmErrHandler(-999, "CVODES", "CVodeAdjInit", "Interp. type has an illegal value.", NULL); goto error_return; } status = CVodeAdjInit(cvode_mem, Nd, interp); if (status != CV_SUCCESS) goto error_return; break; case 1: status = CVodeAdjReInit(cvode_mem); if (status != CV_SUCCESS) goto error_return; break; } asa = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* CVM_InitializationB * * action = 0 -> CVodeCreateB + CVodeInitB * prhs contains: * fctB * lmmB * iterB * tF * yB0 * options * plhs contains: * indexB * * action = 1 -> CVodeReInitB * prhs contains: * indexB * tF * yB0 * options * */ static int CVM_InitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData bckPb; const mxArray *options; int idxB; double tB0, *yB0; int lmmB, iterB, maxordB; long int mxstepsB; int itolB; realtype reltolB, SabstolB, *VabstolB; N_Vector NV_abstolB; double hinB, hmaxB, hminB; double tstopB; /* ignored */ booleantype sldB; /* ignored */ booleantype errmsgB; /* ignored */ booleantype rhs_s; long int mupperB, mlowerB; int ptypeB, gstypeB, maxlB; long int mudqB, mldqB; double dqrelyB; booleantype found_bck; char *bufval; int buflen; int status; int i_status; /* Set output containing status */ i_status = (action == 0) ? 1 : 0; /* * ----------------------------- * Finalize Forward monitoring * ----------------------------- */ if (cvmData->fwdPb->Mon) { mxW_CVodeMonitor(2, 0.0, NULL, NULL, NULL, cvmData->fwdPb); cvmData->fwdPb->Mon = FALSE; } /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* BACKWARD SOLVER INITIALIZATION */ /* Create and initialize a new problem */ bckPb = (cvmPbData) mxMalloc(sizeof(struct cvmPbData_)); cvmInitPbData(bckPb); bckPb->next = cvmData->bckPb; cvmData->bckPb = bckPb; /* Extract user-provided RHS function */ mxDestroyArray(mtlb_RHSfctB); mtlb_RHSfctB = mxDuplicateArray(prhs[0]); /* Extract lmmB */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", "CVodeInitB", "Cannot parse LMM input argument.", NULL); goto error_return; } if(!strcmp(bufval,"Adams")) { lmmB = CV_ADAMS; } else if(!strcmp(bufval,"BDF")) { lmmB = CV_BDF; } else { cvmErrHandler(-999, "CVODES", "CVodeInitB", "LMM has an illegal value.", NULL); goto error_return; } mxFree(bufval); /* Extract iterB */ buflen = mxGetM(prhs[2]) * mxGetN(prhs[2]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[2], bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", "CVodeInitB", "Cannot parse NLS input argument.", NULL); goto error_return; } if(!strcmp(bufval,"Functional")) { iterB = CV_FUNCTIONAL; } else if(!strcmp(bufval,"Newton")) { iterB = CV_NEWTON; } else { cvmErrHandler(-999, "CVODES", "CVodeInitB", "NLS has an illegal value.", NULL); goto error_return; } mxFree(bufval); /* Extract final time */ tB0 = (double)mxGetScalar(prhs[3]); /* Extract final conditions */ yB0 = mxGetPr(prhs[4]); NB = mxGetM(prhs[4]); /* Create the solution N_Vector */ yB = NewVector(NB); /* Load final conditions */ PutData(yB, yB0, NB); /* Extract options structure */ options = prhs[5]; break; case 1: /* BACKWARD SOLVER RE-INITIALIZATION */ /* Extract index of current backward problem */ idxB = (int)mxGetScalar(prhs[0]); /* Find current backward problem */ found_bck = FALSE; bckPb = cvmData->bckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) { cvmErrHandler(-999, "CVODES", "CVodeReInitB", "idxB has an illegal value.", NULL); goto error_return; } /* If backward monitoring was enabled, finalize it now. */ if (monB) mxW_CVodeMonitorB(2, indexB, 0.0, NULL, NULL, bckPb); /* Extract final time */ tB0 = (double)mxGetScalar(prhs[1]); /* Extract final conditions */ yB0 = mxGetPr(prhs[2]); if (mxGetM(prhs[2]) != NB) { cvmErrHandler(-999, "CVODES", "CVodeReInitB", "Size of yB0 changed from CVodeInitB call.", NULL); goto error_return; } /* Load final conditions */ PutData(yB, yB0, NB); /* Extract options structure */ options = prhs[3]; break; } /* Process the options structure */ status = get_IntgrOptions(options, bckPb, FALSE, lmmB, &maxordB, &sldB, &errmsgB, &mxstepsB, &itolB, &reltolB, &SabstolB, &VabstolB, &hinB, &hmaxB, &hminB, &tstopB, &rhs_s); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate CVODES functions * * If action = 0 * Create CVODES object and allocate memory * Initialize and allocate memory * If action = 1 * Reinitialize solver * ---------------------------------------- */ switch (action) { case 0: status = CVodeCreateB(cvode_mem, lmmB, iterB, &idxB); if (status != CV_SUCCESS) goto error_return; status = CVodeSetUserDataB(cvode_mem, idxB, bckPb); if (status != CV_SUCCESS) goto error_return; if (rhs_s) { status = CVodeInitBS(cvode_mem, idxB, mxW_CVodeRhsBS, tB0, yB); } else { status = CVodeInitB(cvode_mem, idxB, mxW_CVodeRhsB, tB0, yB); } if (status != CV_SUCCESS) goto error_return; /* Load idxB in the 1st output (status is 2nd one for this action) */ plhs[0] = mxCreateDoubleScalar((double)idxB); indexB = idxB; NbckPb++; break; case 1: status = CVodeReInitB(cvode_mem, idxB, tB0, yB); if (status != CV_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances * ---------------------------------------- */ switch (itolB) { case CV_SS: status = CVodeSStolerancesB(cvode_mem, idxB, reltolB, SabstolB); if (status != CV_SUCCESS) goto error_return; break; case CV_SV: NV_abstolB = N_VClone(yB); PutData(NV_abstolB, VabstolB, NB); status = CVodeSVtolerancesB(cvode_mem, idxB, reltolB, NV_abstolB); if (status != CV_SUCCESS) goto error_return; N_VDestroy(NV_abstolB); break; } /* * -------------------------------- * Set various optional inputs * -------------------------------- */ /* set maxorder (default is consistent with LMM) */ status = CVodeSetMaxOrdB(cvode_mem, idxB, maxordB); if (status != CV_SUCCESS) goto error_return; /* set initial step size (the default value of 0.0 is ignored by CVODES) */ status = CVodeSetInitStepB(cvode_mem, idxB, hinB); if (status != CV_SUCCESS) goto error_return; /* set max step (default is infinity) */ status = CVodeSetMaxStepB(cvode_mem, idxB, hmaxB); if (status != CV_SUCCESS) goto error_return; /* set min step (default is 0) */ status = CVodeSetMinStepB(cvode_mem, idxB, hminB); if (status != CV_SUCCESS) goto error_return; /* set number of max steps */ status = CVodeSetMaxNumStepsB(cvode_mem, idxB, mxstepsB); if (status != CV_SUCCESS) goto error_return; /* * ---------------------------------------- * Need a linear solver? * ---------------------------------------- */ if (iterB == CV_NEWTON) { status = get_LinSolvOptions(options, bckPb, FALSE, &mupperB, &mlowerB, &mudqB, &mldqB, &dqrelyB, &ptypeB, &gstypeB, &maxlB); if (status != 0) goto error_return; switch(lsB) { case LS_DENSE: status = CVDenseB(cvode_mem, idxB, NB); if (status != CV_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfctB)) { status = CVDlsSetDenseJacFnB(cvode_mem, idxB, mxW_CVodeDenseJacB); if (status != CV_SUCCESS) goto error_return; } break; case LS_DIAG: status = CVDiagB(cvode_mem, idxB); if (status != CV_SUCCESS) goto error_return; break; case LS_BAND: status = CVBandB(cvode_mem, idxB, NB, mupperB, mlowerB); if (status != CV_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfctB)) { status = CVDlsSetBandJacFnB(cvode_mem, idxB, mxW_CVodeBandJacB); if (status != CV_SUCCESS) goto error_return; } break; case LS_SPGMR: status = CVSpgmrB(cvode_mem, idxB, ptypeB, maxlB); if (status != CV_SUCCESS) goto error_return; status = CVSpilsSetGSTypeB(cvode_mem, idxB, gstypeB); if (status != CV_SUCCESS) goto error_return; break; case LS_SPBCG: status = CVSpbcgB(cvode_mem, idxB, ptypeB, maxlB); if (status != CV_SUCCESS) goto error_return; break; case LS_SPTFQMR: status = CVSptfqmrB(cvode_mem, idxB, ptypeB, maxlB); if (status != CV_SUCCESS) goto error_return; break; } /* Jacobian * vector and preconditioner for SPILS linear solvers */ if ( (lsB==LS_SPGMR) || (lsB==LS_SPBCG) || (lsB==LS_SPTFQMR) ) { if (!mxIsEmpty(mtlb_JACfctB)) { status = CVSpilsSetJacTimesVecFnB(cvode_mem, idxB, mxW_CVodeSpilsJacB); if (status != CV_SUCCESS) goto error_return; } switch (pmB) { case PM_NONE: if (!mxIsEmpty(mtlb_PSOLfctB)) { if (!mxIsEmpty(mtlb_PSETfctB)) status = CVSpilsSetPreconditionerB(cvode_mem, idxB, mxW_CVodeSpilsPsetB, mxW_CVodeSpilsPsolB); else status = CVSpilsSetPreconditionerB(cvode_mem, idxB, NULL, mxW_CVodeSpilsPsolB); } if (status != CV_SUCCESS) goto error_return; break; case PM_BANDPRE: status = CVBandPrecInitB(cvode_mem, idxB, NB, mupperB, mlowerB); if (status != CV_SUCCESS) goto error_return; break; case PM_BBDPRE: if (!mxIsEmpty(mtlb_GCOMfctB)) status = CVBBDPrecInitB(cvode_mem, idxB, NB, mudqB, mldqB, mupperB, mlowerB, dqrelyB, mxW_CVodeBBDglocB, mxW_CVodeBBDgcomB); else status = CVBBDPrecInitB(cvode_mem, idxB, NB, mudqB, mldqB, mupperB, mlowerB, dqrelyB, mxW_CVodeBBDglocB, NULL); if (status != CV_SUCCESS) goto error_return; break; } } } else { lsB = LS_NONE; } /* Do we monitor? */ if (monB) mxW_CVodeMonitorB(0, idxB, tB0, NULL, NULL, bckPb); /* Successful return */ status = 0; plhs[i_status] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[i_status] = mxCreateDoubleScalar((double)status); return(-1); } /* CVM_QuadInitializationB * * action = 0 -> CVodeQuadInitB * prhs contains: * idxB * fQB * yQB0 * options * * action = 1 -> CVodeQuadReInitB * idxB * yQB0 * options * */ static int CVM_QuadInitializationB(int action, int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData bckPb; const mxArray *options; int idxB; double *yQB0; booleantype rhs_s; booleantype errconQB; int itolQB; realtype reltolQB, SabstolQB, *VabstolQB; N_Vector NV_abstolQB; booleantype found_bck; int status; /* Extract index of current backward problem */ idxB = (int)mxGetScalar(prhs[0]); /* Find current backward problem */ found_bck = FALSE; bckPb = cvmData->bckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) { cvmErrHandler(-999, "CVODES", "CVodeQuadInitB/CVodeQuadReInitB", "idxB has an illegal value.", NULL); goto error_return; } /* * ------------------------------------ * Process inputs based on action * ------------------------------------ */ switch (action) { case 0: /* BACKWARD QUADRATURE INITIALIZATION */ /* Extract user-provided quadrature RHS function */ mxDestroyArray(mtlb_QUADfctB); mtlb_QUADfctB = mxDuplicateArray(prhs[1]); /* Extract quadrature final conditions */ yQB0 = mxGetPr(prhs[2]); NqB = mxGetM(prhs[2]); /* Create the backward quadrature N_Vector */ yQB = NewVector(NqB); /* Load quadrature final conditions */ PutData(yQB, yQB0, NqB); /* Extract quadrature options structure */ options = prhs[3]; break; case 1: /* BACKWARD QUADRATURE RE-INITIALIZATION */ /* Extract quadrature final conditions */ yQB0 = mxGetPr(prhs[1]); if (mxGetM(prhs[1]) != NqB) cvmErrHandler(-999, "CVODES", "CVodeQuadReInitB", "Size of yQB0 changed from CVodeQuadInitB call.", NULL); /* Load quadrature final conditions */ PutData(yQB, yQB0, NqB); /* Extract quadrature options structure */ options = prhs[2]; break; } /* Process the options structure */ status = get_QuadOptions(options, bckPb, FALSE, NqB, &rhs_s, &errconQB, &itolQB, &reltolQB, &SabstolQB, &VabstolQB); if (status != 0) goto error_return; /* * ---------------------------------------- * Call appropriate CVODES functions * * If action = 0 * Initialize backward quadratures * If action = 1 * Reinitialize backward quadratures * ---------------------------------------- */ switch (action) { case 0: if (rhs_s) status = CVodeQuadInitBS(cvode_mem, idxB, mxW_CVodeQUADfctBS, yQB); else status = CVodeQuadInitB(cvode_mem, idxB, mxW_CVodeQUADfctB, yQB); if (status != CV_SUCCESS) goto error_return; break; case 1: status = CVodeQuadReInitB(cvode_mem, idxB, yQB); if (status != CV_SUCCESS) goto error_return; break; } /* * ---------------------------------------- * Set tolerances for quadrature variables * ---------------------------------------- */ status = CVodeSetQuadErrConB(cvode_mem, idxB, errconQB); if (status != CV_SUCCESS) goto error_return; if (errconQB) { switch (itolQB) { case CV_SS: status = CVodeQuadSStolerancesB(cvode_mem, idxB, reltolQB, SabstolQB); if (status != CV_SUCCESS) goto error_return; break; case CV_SV: NV_abstolQB = N_VClone(yQB); PutData(NV_abstolQB, VabstolQB, NqB); status = CVodeQuadSVtolerancesB(cvode_mem, idxB, reltolQB, NV_abstolQB); if (status != CV_SUCCESS) goto error_return; N_VDestroy(NV_abstolQB); break; } } quadrB = TRUE; /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } /* * CVM_Solve - Main solution function * */ static int CVM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; int buflen; char *bufval; int nlhs_bad, dims[3]; int status, cv_status; int itask, is, Ntout, itout, s_idx; double *tout, tret, h; double *tdata, *ydata, *yQdata, *ySdata; long int nst; fwdPb = cvmData->fwdPb; /* Set index of output corresponding to FSA */ if (fsa) { s_idx = quadr ? 4 : 3; } /* * ---------------------------------------------------------------- * Verify if number of output arguments agrees with current options * ---------------------------------------------------------------- */ nlhs_bad = 0; if (nlhs < 3) nlhs_bad = -1; if (nlhs > 5) nlhs_bad = 1; if ( (nlhs == 3) && (quadr || fsa) ) nlhs_bad = -1; if ( (nlhs == 4) && (quadr && fsa) ) nlhs_bad = -1; if ( (nlhs == 5) && (!quadr || !fsa) ) nlhs_bad = 1; if (nlhs_bad < 0) { cvmErrHandler(-999, "CVODES", "CVode", "Too few output arguments.", NULL); goto error_return; } if (nlhs_bad > 0) { cvmErrHandler(-999, "CVODES", "CVode", "Too many output arguments.", NULL); goto error_return; } /* * ---------------------------------------------------------------- * Extract input arguments * ---------------------------------------------------------------- */ /* Extract tout */ Ntout = mxGetM(prhs[0]) * mxGetN(prhs[0]); tout = mxGetPr(prhs[0]); /* If rootfinding or tstop are enabled, we do not allow multiple output times */ if (rootSet && (Ntout>1)) { cvmErrHandler(-999, "CVODES", "CVode", "More than one tout value prohibited with rootfinding enabled.", NULL); goto error_return; } if (tstopSet && (Ntout>1)) { cvmErrHandler(-999, "CVODES", "CVode", "More than one tout value prohibited with tstop enabled.", NULL); goto error_return; } /* Extract itask */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"Normal")) { itask = CV_NORMAL; } else if(!strcmp(bufval,"OneStep")) { itask = CV_ONE_STEP; } else { cvmErrHandler(-999, "CVODES", "CVode", "Illegal value for itask.", NULL); goto error_return; } if (itask == CV_ONE_STEP) { /* If itask==CV_ONE_STEP, we do not allow multiple output times and we do not monitor */ if (Ntout > 1) { cvmErrHandler(-999, "CVODES", "CVode", "More than one tout value prohibited in ONE_STEP mode.", NULL); goto error_return; } if (mon) { cvmErrHandler(+999, "CVODES", "CVode", "Monitoring disabled in ONE_STEP mode.", NULL); mon = FALSE; } } else { /* Check if tout values are legal */ status = CVodeGetCurrentTime(cvode_mem, &tret); if (status != CV_SUCCESS) goto error_return; status = CVodeGetNumSteps(cvode_mem, &nst); if (status != CV_SUCCESS) goto error_return; /* h is used throughout this function as integration direction only */ if (nst == 0) { h = tout[0] - tret; } else { status = CVodeGetLastStep(cvode_mem, &h); if (status != CV_SUCCESS) goto error_return; if ( (tout[0] - tret + h)*h < 0.0 ) { cvmErrHandler(-999, "CVODES", "CVode", "Illegal value of tout.", NULL); goto error_return; } } for (itout=1; itout0) && ((tret - tout[itout])*h >= 0.0) ) { /* No need to take an additional step */ cv_status = CV_SUCCESS; } else { /* Take additional steps */ while(1) { if (!asa) cv_status = CVode(cvode_mem, tout[itout], y, &tret, CV_ONE_STEP); else cv_status = CVodeF(cvode_mem, tout[itout], y, &tret, CV_ONE_STEP, &Nc); if (cv_status < 0) goto error_return; /* Call the monitoring function */ if (quadr) { status = CVodeGetQuad(cvode_mem, &tret, yQ); if (status != CV_SUCCESS) goto error_return; } if (fsa) { status = CVodeGetSens(cvode_mem, &tret, yS); if (status != CV_SUCCESS) goto error_return; } mxW_CVodeMonitor(1, tret, y, yQ, yS, fwdPb); /* If a root was found or tstop was reached, break out of while loop */ if (cv_status == CV_TSTOP_RETURN || cv_status == CV_ROOT_RETURN) break; /* If current tout was reached break out of while loop */ if ( (tret - tout[itout])*h >= 0.0 ) break; } } /* On a tstop or root return, return solution at tret. * Otherwise (cv_status=CV_SUCCESS), return solution at tout[itout]. */ if (cv_status == CV_TSTOP_RETURN || cv_status == CV_ROOT_RETURN) { if (quadr) { status = CVodeGetQuad(cvode_mem, &tret, yQ); if (status != CV_SUCCESS) goto error_return; } if (fsa) { status = CVodeGetSens(cvode_mem, &tret, yS); if (status != CV_SUCCESS) goto error_return; } } else { tret = tout[itout]; status = CVodeGetDky(cvode_mem, tret, 0, y); if (status != CV_SUCCESS) goto error_return; if (quadr) { status = CVodeGetQuadDky(cvode_mem, tret, 0, yQ); if (status != CV_SUCCESS) goto error_return; } if (fsa) { status = CVodeGetSensDky(cvode_mem, tret, 0, yS); if (status != CV_SUCCESS) goto error_return; } } tdata[itout] = tret; GetData(y, &ydata[itout*N], N); if (quadr) GetData(yQ, &yQdata[itout*Nq], Nq); if (fsa) for (is=0; isbckPb; while(bckPb != NULL) { if (quadrB) any_quadrB = TRUE; if (monB) any_monB = TRUE; bckPb = bckPb->next; } /* * ---------------------------------------------------------------- * Verify if number of output arguments agrees with current options * ---------------------------------------------------------------- */ nlhs_bad = 0; if (nlhs < 3) nlhs_bad = -1; if (nlhs > 4) nlhs_bad = 1; if ( (nlhs == 3) && any_quadrB ) nlhs_bad = -1; if (nlhs_bad < 0) { cvmErrHandler(-999, "CVODES", "CVodeB", "Too few output arguments.", NULL); goto error_return; } if (nlhs_bad > 0) { cvmErrHandler(-999, "CVODES", "CVodeB", "Too many output arguments.", NULL); goto error_return; } /* * ---------------------------------------------------------------- * Extract input arguments * ---------------------------------------------------------------- */ /* Extract tout */ NtoutB = mxGetM(prhs[0]) * mxGetN(prhs[0]); toutB = mxGetPr(prhs[0]); /* Check if first tout value is in the right direction */ status = CVodeGetLastStep(cvode_mem, &h); if (status != CV_SUCCESS) goto error_return; status = CVodeGetCurrentTime(cvode_mem, &tret); if (status != CV_SUCCESS) goto error_return; /* The stepsize of the forward problem is used to indicate the integration direction */ if ( (tret - toutB[0])*h < 0.0 ) { cvmErrHandler(-999, "CVODES", "CVodeB", "tout value in wrong direction.", NULL); goto error_return; } /* Extract itaskB */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"Normal")) { itaskB = CV_NORMAL; } else if(!strcmp(bufval,"OneStep")) { itaskB = CV_ONE_STEP; } else { cvmErrHandler(-999, "CVODES", "CVodeB", "Illegal value for itask.", NULL); goto error_return; } /* If itask == CV_ONE_STEP, then * - we do not allow multiple output times * - we disable monitoring */ if ( itaskB == CV_ONE_STEP ) { if (NtoutB > 1) { cvmErrHandler(-999, "CVODES", "CVodeB", "More than one tout value prohibited in ONE_STEP mode.", NULL); goto error_return; } if (any_monB) { cvmErrHandler(+999, "CVODES", "CVodeB", "Monitoring disabled in itask=CV_ONE_STEP", NULL); bckPb = cvmData->bckPb; while(bckPb != NULL) { monB = FALSE; bckPb = bckPb->next; } any_monB = FALSE; } } /* Call the appropriate function to do all the work. * Note: if we made it here, we rely on the functions cvmSolveB_one and cvmSolveB_more * to set the output arrays in plhs appropriately. */ if (NbckPb == 1) cv_status = cvmSolveB_one(plhs, NtoutB, toutB, itaskB); else cv_status = cvmSolveB_more(plhs, NtoutB, toutB, itaskB, any_quadrB, any_monB); if (cv_status < 0) return(-1); else return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } return(-1); } static int cvmSolveB_one(mxArray *plhs[], int NtoutB, double *toutB, int itaskB) { cvmPbData bckPb; void *cvode_memB; double tretB, hB; double *tdata, *ydata, *yQdata; int itout; long int nstB; int status, cv_status; bckPb = cvmData->bckPb; cvode_memB = CVodeGetAdjCVodeBmem(cvode_mem, indexB); /* Check if tout values are legal */ CVodeGetCurrentTime(cvode_memB, &tretB); CVodeGetNumSteps(cvode_memB, &nstB); /* hB is used throughout this function as integration direction only */ if (nstB == 0) { hB = toutB[0] - tretB; } else { CVodeGetLastStep(cvode_memB, &hB); if ( (toutB[0] - tretB + hB)*hB < 0.0 ) { cvmErrHandler(-999, "CVODES", "CVodeB", "Illegal value of tout.", NULL); goto error_return; } } for (itout=1; itout0) && ((tretB - toutB[itout])*hB >= 0.0) ) { /* No need to take an additional step */ cv_status = CV_SUCCESS; } else { /* Take additional steps */ while(1) { cv_status = CVodeB(cvode_mem, toutB[itout], CV_ONE_STEP); if (cv_status < 0) goto error_return; /* Call the monitoring function */ status = CVodeGetB(cvode_mem, indexB, &tretB, yB); if (status != CV_SUCCESS) goto error_return; if (quadrB) { CVodeGetQuadB(cvode_mem, indexB, &tretB, yQB); if (status != CV_SUCCESS) goto error_return; } mxW_CVodeMonitorB(1, indexB, tretB, yB, yQB, bckPb); /* If current tout was reached break out of while loop */ if ( (tretB - toutB[itout])*hB >= 0.0 ) break; } } tretB = toutB[itout]; tdata[itout] = tretB; status = CVodeGetDky(cvode_memB, tretB, 0, yB); if (status != CV_SUCCESS) goto error_return; GetData(yB, &ydata[itout*NB], NB); if (quadrB) { status = CVodeGetQuadDky(cvode_memB, tretB, 0, yQB); if (status != CV_SUCCESS) goto error_return; GetData(yQB, &yQdata[itout*NqB], NqB); } } } /* CVodeB return flag (only non-negative values make it here) */ plhs[0] = mxCreateDoubleScalar((double)cv_status); return(0); error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } return(-1); } static int cvmSolveB_more(mxArray *plhs[], int NtoutB, double *toutB, int itaskB, booleantype any_quadrB, booleantype any_monB) { cvmPbData bckPb; mxArray *cell; void *cvode_memB; double tretB, h, hB; double **tdata, **ydata, **yQdata; int itout; long int nstB; char err_msg[80]; int status, cv_status; /* Check if tout values are legal */ CVodeGetLastStep(cvode_mem, &h); bckPb = cvmData->bckPb; while (bckPb != NULL) { cvode_memB = CVodeGetAdjCVodeBmem(cvode_mem, indexB); status = CVodeGetCurrentTime(cvode_memB, &tretB); if (status != CV_SUCCESS) goto error_return; status = CVodeGetNumSteps(cvode_memB, &nstB); if (status != CV_SUCCESS) goto error_return; if (nstB > 0) { status = CVodeGetLastStep(cvode_memB, &hB); if (status != CV_SUCCESS) goto error_return; if ( (toutB[0] - tretB + hB)*hB < 0.0 ) { sprintf(err_msg, "CVodeB:: illegal value of tout (pb. %d).",indexB+1); cvmErrHandler(-999, "CVODES", "CVodeB", err_msg, NULL); goto error_return; } } for (itout=1; itout 0.0 ) { sprintf(err_msg, "CVodeB:: tout values are not monotonic (pb. %d).", indexB+1); cvmErrHandler(-999, "CVODES", "CVodeB", err_msg, NULL); goto error_return; } } bckPb = bckPb->next; } /* * ---------------------------------------------------------------- * Prepare the output arrays * ---------------------------------------------------------------- */ plhs[1] = mxCreateCellMatrix(NbckPb,1); tdata = (double **) mxMalloc(NbckPb*sizeof(double *)); plhs[2] = mxCreateCellMatrix(NbckPb,1); ydata = (double **) mxMalloc(NbckPb*sizeof(double *)); if (any_quadrB) { plhs[3] = mxCreateCellMatrix(NbckPb,1); yQdata = (double **) mxMalloc(NbckPb*sizeof(double *)); } bckPb = cvmData->bckPb; while (bckPb != NULL) { /* Return time(s) */ cell = mxCreateDoubleMatrix(1,NtoutB,mxREAL); tdata[indexB] = mxGetPr(cell); mxSetCell(plhs[1], indexB, cell); /* Solution vector(s) */ cell = mxCreateDoubleMatrix(NB,NtoutB,mxREAL); ydata[indexB] = mxGetPr(cell); mxSetCell(plhs[2], indexB, cell); /* Quadrature vector(s) */ if (any_quadrB) { if (quadrB) { cell = mxCreateDoubleMatrix(NqB,NtoutB,mxREAL); yQdata[indexB] = mxGetPr(cell); } else { cell = mxCreateDoubleMatrix(0,0,mxREAL); } mxSetCell(plhs[3], indexB, cell); } bckPb = bckPb->next; } /* * ---------------------------------------------------------------- * Call the CVodeB main solver function * ---------------------------------------------------------------- */ if (!any_monB) { /* No monitoring. itaskB can be either CV_ONE_STEP or CV_NORMAL */ for (itout=0; itoutbckPb; while (bckPb != NULL) { status = CVodeGetB(cvode_mem, indexB, &tretB, yB); if (status != CV_SUCCESS) goto error_return; tdata[indexB][itout] = tretB; GetData(yB, &ydata[indexB][itout*NB], NB); if (quadrB) { status = CVodeGetQuadB(cvode_mem, indexB, &tretB, yQB); if (status != CV_SUCCESS) goto error_return; GetData(yQB, &yQdata[indexB][itout*NqB], NqB); } bckPb = bckPb->next; } } } else { /* Monitoring for at least one backward problem. itask = CV_NORMAL */ cvmErrHandler(-999, "CVODES", "CVodeB", "Monitoring currently prohibited with more than one backward problem defined .", NULL); goto error_return; } /* CVODE return flag (only non-negative values make it here) */ plhs[0] = mxCreateDoubleScalar((double)cv_status); return(0); error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); plhs[2] = mxCreateDoubleMatrix(0,0,mxREAL); if (quadrB) { plhs[3] = mxCreateDoubleMatrix(0,0,mxREAL); } return(-1); } static int CVM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; const char *fnames_intgr[]={ "nst", "nfe", "nge", "nsetups", "netf", "nni", "ncfn", "qlast", "qcur", "h0used", "hlast", "hcur", "tcur", "RootInfo", "QuadInfo", "LSInfo", "FSAInfo" }; const char *fnames_root[]={ "nge", "roots" }; const char *fnames_dense[]={ "name", "njeD", "nfeD" }; const char *fnames_diag[]={ "name", "nfeDI" }; const char *fnames_band[]={ "name", "njeB", "nfeB" }; const char *fnames_spils[]={ "name", "nli", "npe", "nps", "ncfl", "njeSG", "nfeSG" }; const char *fnames_quad[]={ "nfQe", "netfQ" }; const char *fnames_sens[]={ "nfSe", "nfeS", "nsetupsS", "netfS", "nniS", "ncfnS", }; long int nst, nfe, nsetups, nni, ncfn, netf, nge; int qlast, qcur; double h0used, hlast, hcur, tcur; int *rootsfound; long int njeD, nfeD; long int nfeDI; long int njeB, nfeB; long int nli, npe, nps, ncfl, njeSG, nfeSG; long int nfQe, netfQ; long int nfSe, nfeS, netfS, nsetupsS; long int nniS, ncfnS; int i, status; mxArray *mxS_root, *mxS_ls, *mxS_quad, *mxS_fsa; mxArray *mxS_rootsfound; double *tmp; int nfields; if (cvmData == NULL) return(0); fwdPb = cvmData->fwdPb; status = CVodeGetIntegratorStats(cvode_mem, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0used, &hlast, &hcur, &tcur); if (status != CV_SUCCESS) goto error_return; status = CVodeGetNonlinSolvStats(cvode_mem, &nni, &ncfn); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_intgr)/sizeof(*fnames_intgr); plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_intgr); mxSetField(plhs[0], 0, "nst", mxCreateDoubleScalar((double)nst)); mxSetField(plhs[0], 0, "nfe", mxCreateDoubleScalar((double)nfe)); mxSetField(plhs[0], 0, "nsetups", mxCreateDoubleScalar((double)nsetups)); mxSetField(plhs[0], 0, "netf", mxCreateDoubleScalar((double)netf)); mxSetField(plhs[0], 0, "nni", mxCreateDoubleScalar((double)nni)); mxSetField(plhs[0], 0, "ncfn", mxCreateDoubleScalar((double)ncfn)); mxSetField(plhs[0], 0, "qlast", mxCreateDoubleScalar((double)qlast)); mxSetField(plhs[0], 0, "qcur", mxCreateDoubleScalar((double)qcur)); mxSetField(plhs[0], 0, "h0used", mxCreateDoubleScalar(h0used)); mxSetField(plhs[0], 0, "hlast", mxCreateDoubleScalar(hlast)); mxSetField(plhs[0], 0, "hcur", mxCreateDoubleScalar(hcur)); mxSetField(plhs[0], 0, "tcur", mxCreateDoubleScalar(tcur)); /* Root Finding Statistics */ if (Ng > 0) { status = CVodeGetNumGEvals(cvode_mem, &nge); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_root)/sizeof(*fnames_root); mxS_root = mxCreateStructMatrix(1, 1, nfields, fnames_root); mxSetField(mxS_root, 0, "nge", mxCreateDoubleScalar((double)nge)); rootsfound = (int *) malloc(Ng*sizeof(int)); status = CVodeGetRootInfo(cvode_mem, rootsfound); if (status != CV_SUCCESS) goto error_return; mxS_rootsfound = mxCreateDoubleMatrix(Ng,1,mxREAL); tmp = mxGetPr(mxS_rootsfound); for (i=0;ibckPb; while (bckPb != NULL) { if (indexB == idxB) { found_bck = TRUE; break; } bckPb = bckPb->next; } if (!found_bck) cvmErrHandler(-999, "CVODES", "CVodeGetStatsB", "idxB has an illegal value.", NULL); cvode_memB = CVodeGetAdjCVodeBmem(cvode_mem, indexB); status = CVodeGetIntegratorStats(cvode_memB, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0used, &hlast, &hcur, &tcur); if (status != CV_SUCCESS) goto error_return; status = CVodeGetNonlinSolvStats(cvode_memB, &nni, &ncfn); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_intgr)/sizeof(*fnames_intgr); plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_intgr); mxSetField(plhs[0], 0, "nst", mxCreateDoubleScalar((double)nst)); mxSetField(plhs[0], 0, "nfe", mxCreateDoubleScalar((double)nfe)); mxSetField(plhs[0], 0, "nsetups", mxCreateDoubleScalar((double)nsetups)); mxSetField(plhs[0], 0, "netf", mxCreateDoubleScalar((double)netf)); mxSetField(plhs[0], 0, "nni", mxCreateDoubleScalar((double)nni)); mxSetField(plhs[0], 0, "ncfn", mxCreateDoubleScalar((double)ncfn)); mxSetField(plhs[0], 0, "qlast", mxCreateDoubleScalar((double)qlast)); mxSetField(plhs[0], 0, "qcur", mxCreateDoubleScalar((double)qcur)); mxSetField(plhs[0], 0, "h0used", mxCreateDoubleScalar(h0used)); mxSetField(plhs[0], 0, "hlast", mxCreateDoubleScalar(hlast)); mxSetField(plhs[0], 0, "hcur", mxCreateDoubleScalar(hcur)); mxSetField(plhs[0], 0, "tcur", mxCreateDoubleScalar(tcur)); /* Quadrature Statistics */ if (quadrB) { status = CVodeGetQuadStats(cvode_memB, &nfQe, &netfQ); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_quad)/sizeof(*fnames_quad); mxS_quad = mxCreateStructMatrix(1, 1, nfields, fnames_quad); mxSetField(mxS_quad, 0, "nfQe", mxCreateDoubleScalar((double)nfQe)); mxSetField(mxS_quad, 0, "netfQ", mxCreateDoubleScalar((double)netfQ)); } else { mxS_quad = mxCreateDoubleMatrix(0,0,mxREAL); } mxSetField(plhs[0], 0, "QuadInfo", mxS_quad); /* Linear Solver Statistics */ switch(lsB){ case LS_NONE: mxS_ls = mxCreateDoubleMatrix(0,0,mxREAL); break; case LS_DENSE: status = CVDlsGetNumJacEvals(cvode_memB, &njeD); if (status != CV_SUCCESS) goto error_return; status = CVDlsGetNumRhsEvals(cvode_memB, &nfeD); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_dense)/sizeof(*fnames_dense); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_dense); mxSetField(mxS_ls, 0, "name", mxCreateString("Dense")); mxSetField(mxS_ls, 0, "njeD", mxCreateDoubleScalar((double)njeD)); mxSetField(mxS_ls, 0, "nfeD", mxCreateDoubleScalar((double)nfeD)); break; case LS_DIAG: status = CVDiagGetNumRhsEvals(cvode_memB, &nfeDI); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_diag)/sizeof(*fnames_diag); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_diag); mxSetField(mxS_ls, 0, "name", mxCreateString("Diag")); mxSetField(mxS_ls, 0, "nfeDI", mxCreateDoubleScalar((double)nfeDI)); break; case LS_BAND: status = CVDlsGetNumJacEvals(cvode_memB, &njeB); if (status != CV_SUCCESS) goto error_return; status = CVDlsGetNumRhsEvals(cvode_memB, &nfeB); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_band)/sizeof(*fnames_band); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_band); mxSetField(mxS_ls, 0, "name", mxCreateString("Band")); mxSetField(mxS_ls, 0, "njeB", mxCreateDoubleScalar((double)njeB)); mxSetField(mxS_ls, 0, "nfeB", mxCreateDoubleScalar((double)nfeB)); break; case LS_SPGMR: case LS_SPBCG: case LS_SPTFQMR: status = CVSpilsGetNumLinIters(cvode_memB, &nli); if (status != CV_SUCCESS) goto error_return; status = CVSpilsGetNumPrecEvals(cvode_memB, &npe); if (status != CV_SUCCESS) goto error_return; status = CVSpilsGetNumPrecSolves(cvode_memB, &nps); if (status != CV_SUCCESS) goto error_return; status = CVSpilsGetNumConvFails(cvode_memB, &ncfl); if (status != CV_SUCCESS) goto error_return; status = CVSpilsGetNumJtimesEvals(cvode_memB, &njeSG); if (status != CV_SUCCESS) goto error_return; status = CVSpilsGetNumRhsEvals(cvode_memB, &nfeSG); if (status != CV_SUCCESS) goto error_return; nfields = sizeof(fnames_spils)/sizeof(*fnames_spils); mxS_ls = mxCreateStructMatrix(1, 1, nfields, fnames_spils); if (lsB == LS_SPGMR) mxSetField(mxS_ls, 0, "name", mxCreateString("GMRES")); else if (lsB == LS_SPBCG) mxSetField(mxS_ls, 0, "name", mxCreateString("BiCGStab")); else mxSetField(mxS_ls, 0, "name", mxCreateString("TFQMR")); mxSetField(mxS_ls, 0, "nli", mxCreateDoubleScalar((double)nli)); mxSetField(mxS_ls, 0, "npe", mxCreateDoubleScalar((double)npe)); mxSetField(mxS_ls, 0, "nps", mxCreateDoubleScalar((double)nps)); mxSetField(mxS_ls, 0, "ncfl", mxCreateDoubleScalar((double)ncfl)); mxSetField(mxS_ls, 0, "njeSG", mxCreateDoubleScalar((double)njeSG)); mxSetField(mxS_ls, 0, "nfeSG", mxCreateDoubleScalar((double)nfeSG)); break; } mxSetField(plhs[0], 0, "LSInfo", mxS_ls); /* Successful return */ status = 0; plhs[1] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[1] = mxCreateDoubleScalar((double)status); return(-1); } static int CVM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; const mxArray *options; mxArray *opt; double tstop; int status; fwdPb = cvmData->fwdPb; options = prhs[0]; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* User data */ opt = mxGetField(options,0,"UserData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_data); mtlb_data = mxDuplicateArray(opt); } /* Stopping time */ opt = mxGetField(options,0,"StopTime"); if ( !mxIsEmpty(opt) ) { tstop = (double)mxGetScalar(opt); status = CVodeSetStopTime(cvode_mem, tstop); if (status != CV_SUCCESS) goto error_return; } /* Successful return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } static int CVM_SetB(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { return(0); } static int CVM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb; double t; N_Vector ewt; double *this, *next; int key, k, i, nfields; CVadjCheckPointRec *ckpnt; const char *fnames_ckpnt[]={ "t0", "t1", "nstep", "order", "step" }; int status; fwdPb = cvmData->fwdPb; key = (int) (*mxGetPr(prhs[0])); switch (key) { case 1: /* DerivSolution */ t = *mxGetPr(prhs[1]); k = (int) (*mxGetPr(prhs[2])); plhs[0] = mxCreateDoubleMatrix(N,1,mxREAL); status = CVodeGetDky(cvode_mem, t, k, y); if (status != CV_SUCCESS) goto error_return; GetData(y, mxGetPr(plhs[0]), N); break; case 2: /* ErrorWeights */ ewt = N_VClone(y); plhs[0] = mxCreateDoubleMatrix(N,1,mxREAL); status = CVodeGetErrWeights(cvode_mem, ewt); if (status != CV_SUCCESS) goto error_return; GetData(ewt, mxGetPr(plhs[0]), N); N_VDestroy(ewt); break; case 3: /* not used */ break; case 4: /* CheckPointsInfo */ ckpnt = (CVadjCheckPointRec *) malloc ( (Nc+1)*sizeof(CVadjCheckPointRec)); status = CVodeGetAdjCheckPointsInfo(cvode_mem, ckpnt); if (status != CV_SUCCESS) { free(ckpnt); goto error_return; } nfields = sizeof(fnames_ckpnt)/sizeof(*fnames_ckpnt); plhs[0] = mxCreateStructMatrix(Nc+1, 1, nfields, fnames_ckpnt); for (i=0; i<=Nc; i++) { this = (double *)(ckpnt[Nc-i].my_addr); next = (double *)(ckpnt[Nc-i].next_addr); mxSetField(plhs[0], i, "t0", mxCreateDoubleScalar((double)(ckpnt[Nc-i].t0))); mxSetField(plhs[0], i, "t1", mxCreateDoubleScalar((double)(ckpnt[Nc-i].t1))); mxSetField(plhs[0], i, "nstep", mxCreateDoubleScalar((double)(ckpnt[Nc-i].nstep))); mxSetField(plhs[0], i, "order", mxCreateDoubleScalar((double)(ckpnt[Nc-i].order))); mxSetField(plhs[0], i, "step", mxCreateDoubleScalar((double)(ckpnt[Nc-i].step))); } free(ckpnt); break; } /* Successful return */ status = 0; plhs[1] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[1] = mxCreateDoubleScalar((double)status); return(-1); } static int CVM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { cvmPbData fwdPb, bckPb; if (cvmData == NULL) return(0); fwdPb = cvmData->fwdPb; if (mon) mxW_CVodeMonitor(2, 0.0, NULL, NULL, NULL, fwdPb); bckPb = cvmData->bckPb; while (bckPb != NULL) { if (monB) mxW_CVodeMonitorB(2, indexB, 0.0, NULL, NULL, bckPb); bckPb = bckPb->next; } CVodeFree(&cvode_mem); return(0); } sundials-2.5.0/sundialsTB/cvodes/cvm/src/cvmWrap.c0000600000175000017500000010532511741421121022704 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2012/03/07 21:44:21 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/cvodes/LICENSE. * ----------------------------------------------------------------- * CVODES wrapper functions. * ----------------------------------------------------------------- */ #include "cvm.h" #include "nvm.h" static void UpdateUserData(mxArray *new_mtlb_data, cvmPbData pb); static void UpdateMonitorData(mxArray *new_mtlb_data, cvmPbData pb); /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define fsa (fwdPb->Fsa) #define quadr (fwdPb->Quadr) #define N (fwdPb->n) #define Nq (fwdPb->nq) #define Ng (fwdPb->ng) #define Ns (fwdPb->ns) #define quadrB (bckPb->Quadr) #define NB (bckPb->n) #define NqB (bckPb->nq) /* * --------------------------------------------------------------------------------- * FORWARD PROBLEMS * --------------------------------------------------------------------------------- */ int mxW_CVodeRhs(realtype t, N_Vector y, N_Vector yd, void *user_data) { cvmPbData fwdPb; mxArray *mx_in[4], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = fwdPb->RHSfct; /* matlab function handle */ mx_in[3] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"cvm_rhs"); PutData(yd, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeQUADfct(realtype t, N_Vector y, N_Vector yQd, void *user_data) { cvmPbData fwdPb; mxArray *mx_in[4], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = fwdPb->QUADfct; /* matlab function handle */ mx_in[3] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"cvm_rhsQ"); PutData(yQd, mxGetPr(mx_out[0]), Nq); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeGfct(realtype t, N_Vector y, double *g, void *user_data) { cvmPbData fwdPb; double *gdata; int i, ret; mxArray *mx_in[4], *mx_out[3]; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = fwdPb->Gfct; /* matlab function handle */ mx_in[3] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"cvm_root"); gdata = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"cvm_djac"); /* Extract data */ J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[4] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,5,mx_in,"cvm_bjac"); /* Extract data */ eband = mupper + mlower + 1; J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[5] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); GetData(v, mxGetPr(mx_in[3]), N); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_jtv"); PutData(Jv, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeSpilsPset(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { cvmPbData fwdPb; mxArray *mx_in[7], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fy */ mx_in[3] = mxCreateLogicalScalar(jok); /* jok flag */ mx_in[4] = mxCreateDoubleScalar(gamma); /* gamma value */ mx_in[5] = fwdPb->PSETfct; /* matlab function handle */ mx_in[6] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); mexCallMATLAB(3,mx_out,7,mx_in,"cvm_pset"); *jcurPtr = mxIsLogicalScalarTrue(mx_out[0]); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeSpilsPsol(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector tmp) { cvmPbData fwdPb; mxArray *mx_in[6], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* right hand side r */ mx_in[4] = fwdPb->PSOLfct; /* matlab function handle */ mx_in[5] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); GetData(r, mxGetPr(mx_in[3]), N); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_psol"); PutData(z, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } /* * ---------------------------- * BBD PRECONDITONER FUNCTIONS * ---------------------------- */ int mxW_CVodeBBDgloc(long int Nlocal, realtype t, N_Vector y, N_Vector g, void *user_data) { cvmPbData fwdPb; mxArray *mx_in[4], *mx_out[3]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = fwdPb->GLOCfct; /* matlab function handle */ mx_in[3] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"cvm_gloc"); PutData(g, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeBBDgcom(long int Nlocal, realtype t, N_Vector y, void *user_data) { cvmPbData fwdPb; mxArray *mx_in[4], *mx_out[2]; int ret; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = fwdPb->GCOMfct; /* matlab function handle */ mx_in[3] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); mexCallMATLAB(2,mx_out,4,mx_in,"cvm_gcom"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], fwdPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } /* * ---------------------------- * FORWARD SENSITVITY FUNCTIONS * ---------------------------- */ int mxW_CVodeSensRhs(int Nsens, realtype t, N_Vector y, N_Vector yd, N_Vector *yS, N_Vector *ySd, void *user_data, N_Vector tmp1, N_Vector tmp2) { cvmPbData fwdPb; mxArray *mx_in[7], *mx_out[3]; int is, ret; double *tmp; /* Extract global interface data from user-data */ fwdPb = (cvmPbData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yd */ mx_in[3] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[4] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yS */ mx_in[5] = fwdPb->SRHSfct; /* matlab function handle */ mx_in[6] = fwdPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yd, mxGetPr(mx_in[2]), N); tmp = mxGetPr(mx_in[4]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(0.0); /* type=0: not dependent on yS */ mx_in[1] = mxCreateDoubleScalar(t); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[4] = bckPb->RHSfct; /* matlab function handle */ mx_in[5] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[2]), N); GetData(yB, mxGetPr(mx_in[3]), NB); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_rhsB"); PutData(yBd, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeRhsBS(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBd, void *user_dataB) { cvmPbData fwdPb, bckPb; mxArray *mx_in[8], *mx_out[3]; int is, ret; double *tmp; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(1.0); /* type=1: dependent on yS */ mx_in[1] = mxCreateDoubleScalar(t); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[3] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[4] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yS */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[6] = bckPb->RHSfct; /* matlab function handle */ mx_in[7] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[2]), N); tmp = mxGetPr(mx_in[4]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(0.0); /* type=0: not dependent on yS */ mx_in[1] = mxCreateDoubleScalar(t); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[4] = bckPb->QUADfct; /* matlab function handle */ mx_in[5] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[2]), N); GetData(yB, mxGetPr(mx_in[3]), NB); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_rhsQB"); PutData(yQBd, mxGetPr(mx_out[0]), NqB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeQUADfctBS(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yQBd, void *user_dataB) { cvmPbData fwdPb, bckPb; mxArray *mx_in[8], *mx_out[3]; int is, ret; double *tmp; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(1.0); /* type=1: dependent on yS */ mx_in[1] = mxCreateDoubleScalar(t); /* current t */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[3] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ mx_in[4] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current yS */ mx_in[5] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[6] = bckPb->QUADfct; /* matlab function handle */ mx_in[7] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[2]), N); tmp = mxGetPr(mx_in[4]); for (is=0; isfwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current fyB */ mx_in[4] = bckPb->JACfct; /* matlab function handle */ mx_in[5] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); GetData(fyB, mxGetPr(mx_in[3]), NB); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_djacB"); JB_data = mxGetPr(mx_out[0]); for (i=0;ifwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current fyB */ mx_in[4] = bckPb->JACfct; /* matlab function handle */ mx_in[5] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); GetData(fyB, mxGetPr(mx_in[3]), NB); mexCallMATLAB(3,mx_out,6,mx_in,"cvm_bjacB"); ebandB = mupperB + mlowerB + 1; JB_data = mxGetPr(mx_out[0]); for (i=0;ifwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current fyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* vector vB */ mx_in[5] = bckPb->JACfct; /* matlab function handle */ mx_in[6] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); GetData(fyB, mxGetPr(mx_in[3]), NB); GetData(vB, mxGetPr(mx_in[4]), NB); mexCallMATLAB(3,mx_out,7,mx_in,"cvm_jtvB"); PutData(JvB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeSpilsPsetB(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { cvmPbData fwdPb, bckPb; mxArray *mx_in[8], *mx_out[3]; int ret; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current fyB */ mx_in[4] = mxCreateLogicalScalar(jokB); /* jokB flag */ mx_in[5] = mxCreateDoubleScalar(gammaB); /* gammaB value */ mx_in[6] = bckPb->PSETfct; /* matlab function handle */ mx_in[7] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); GetData(fyB, mxGetPr(mx_in[3]), NB); mexCallMATLAB(3,mx_out,8,mx_in,"cvm_psetB"); *jcurPtrB = mxIsLogicalScalarTrue(mx_out[0]); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_in[5]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeSpilsPsolB(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *user_dataB, N_Vector tmpB) { cvmPbData fwdPb, bckPb; mxArray *mx_in[7], *mx_out[3]; int ret; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current fyB */ mx_in[4] = mxCreateDoubleMatrix(NB,1,mxREAL); /* right hand side rB */ mx_in[5] = bckPb->PSOLfct; /* matlab function handle */ mx_in[6] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); GetData(fyB, mxGetPr(mx_in[3]), NB); GetData(rB, mxGetPr(mx_in[4]), NB); mexCallMATLAB(3,mx_out,7,mx_in,"cvm_psolB"); PutData(zB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeBBDglocB(long int NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector gB, void *user_dataB) { cvmPbData fwdPb, bckPb; mxArray *mx_in[5], *mx_out[3]; int ret; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = bckPb->GLOCfct; /* matlab function handle */ mx_in[4] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); mexCallMATLAB(3,mx_out,5,mx_in,"cvm_glocB"); PutData(gB, mxGetPr(mx_out[0]), NB); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_CVodeBBDgcomB(long int NlocalB, realtype t, N_Vector y, N_Vector yB, void *user_dataB) { cvmPbData fwdPb, bckPb; mxArray *mx_in[5], *mx_out[2]; int ret; /* Extract global interface data from user-data */ bckPb = (cvmPbData) user_dataB; fwdPb = bckPb->fwd; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleScalar(t); /* current t */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[2] = mxCreateDoubleMatrix(NB,1,mxREAL); /* current yB */ mx_in[3] = bckPb->GCOMfct; /* matlab function handle */ mx_in[4] = bckPb->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[1]), N); GetData(yB, mxGetPr(mx_in[2]), NB); mexCallMATLAB(2,mx_out,5,mx_in,"cvm_gcomB"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], bckPb); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } /* * --------------------------------------------------------------------------------- * Wrapper around matlab monitor function * --------------------------------------------------------------------------------- */ void mxW_CVodeMonitor(int call, double t, N_Vector y, N_Vector yQ, N_Vector *yS, cvmPbData fwdPb) { mxArray *mx_in[8], *mx_out[1]; double *tmp; int is; mx_in[0] = mxCreateDoubleScalar(call); /* call type (0:first, 1:interm. 2:last) */ mx_in[1] = mxCreateDoubleScalar(t); /* current time */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current solution */ if (quadr) mx_in[3] = mxCreateDoubleMatrix(Nq,1,mxREAL); /* current quadratures */ else mx_in[3] = mxCreateDoubleMatrix(0,0,mxREAL); mx_in[4] = mxCreateDoubleScalar(Ns); /* number of sensitivities */ if (fsa) mx_in[5] = mxCreateDoubleMatrix(N*Ns,1,mxREAL); /* current sensitivities */ else mx_in[5] = mxCreateDoubleMatrix(0,0,mxREAL); mx_in[6] = fwdPb->MONfct; /* Matlab monitor function */ mx_in[7] = fwdPb->MONdata; /* data for monitor function */ if (call == 1) { GetData(y, mxGetPr(mx_in[2]), N); if (quadr) GetData(yQ, mxGetPr(mx_in[3]), Nq); if (fsa) { tmp = mxGetPr(mx_in[5]); for (is=0; isMONfct; mx_in[6] = bckPb->MONdata; if (call == 1) { GetData(yB, mxGetPr(mx_in[3]), NB); if (quadrB) GetData(yQB, mxGetPr(mx_in[4]), NqB); } mexCallMATLAB(1,mx_out,7,mx_in,"cvm_monitorB"); if (!mxIsEmpty(mx_out[0])) { UpdateMonitorData(mx_out[0], bckPb); } mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); } /* * --------------------------------------------------------------------------------- * Private functions to update the user data structures * --------------------------------------------------------------------------------- */ static void UpdateUserData(mxArray *new_mtlb_data, cvmPbData pb) { mexUnlock(); mxDestroyArray(pb->mtlb_data); pb->mtlb_data = mxDuplicateArray(new_mtlb_data); mexMakeArrayPersistent(pb->mtlb_data); mexLock(); } static void UpdateMonitorData(mxArray *new_mtlb_data, cvmPbData pb) { mexUnlock(); mxDestroyArray(pb->MONdata); pb->MONdata = mxDuplicateArray(new_mtlb_data); mexMakeArrayPersistent(pb->MONdata); mexLock(); } sundials-2.5.0/sundialsTB/cvodes/cvm/src/cvmOpts.c0000600000175000017500000005503711741421121022724 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2012/03/07 21:44:21 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/cvodes/LICENSE. * ----------------------------------------------------------------- * Option parsing functions for the CVODES Matlab interface. * ----------------------------------------------------------------- */ #include #include "cvm.h" /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define N (thisPb->n) #define Ns (thisPb->ns) #define Ng (thisPb->ng) #define ls (thisPb->LS) #define pm (thisPb->PM) #define mtlb_data (thisPb->mtlb_data) #define mtlb_JACfct (thisPb->JACfct) #define mtlb_PSETfct (thisPb->PSETfct) #define mtlb_PSOLfct (thisPb->PSOLfct) #define mtlb_GLOCfct (thisPb->GLOCfct) #define mtlb_GCOMfct (thisPb->GCOMfct) #define mtlb_Gfct (thisPb->Gfct) #define mon (thisPb->Mon) #define tstopSet (thisPb->TstopSet) #define mtlb_MONfct (thisPb->MONfct) #define mtlb_MONdata (thisPb->MONdata) /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_IntgrOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, int lmm, int *maxord, booleantype *sld, booleantype *errmsg, long int *mxsteps, int *itol, realtype *reltol, double *Sabstol, double **Vabstol, double *hin, double *hmax, double *hmin, double *tstop, booleantype *rhs_s) { mxArray *opt; int q; long int i, m, n; double *tmp; char *fctName; char *fwd_fctName = "CVodeInit/CVodeReInit"; char *bck_fctName = "CVodeInitB/CVodeReInitB"; if (fwd) fctName = fwd_fctName; else fctName = bck_fctName; /* Set default values */ *maxord = (lmm == CV_ADAMS) ? 12 : 5; *sld = FALSE; *mxsteps = 0; *itol = CV_SS; *reltol = 1.0e-3; *Sabstol = 1.0e-6; *Vabstol = NULL; *hin = 0.0; *hmax = 0.0; *hmin = 0.0; *rhs_s = FALSE; Ng = 0; tstopSet = FALSE; mon = FALSE; *errmsg = TRUE; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* User data */ opt = mxGetField(options,0,"UserData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_data); mtlb_data = mxDuplicateArray(opt); } /* Tolerances */ opt = mxGetField(options,0,"RelTol"); if ( !mxIsEmpty(opt) ) { *reltol = *mxGetPr(opt); if (*reltol < 0.0 ) { cvmErrHandler(-999, "CVODES", fctName, "RelTol is negative.", NULL); return(-1); } } opt = mxGetField(options,0,"AbsTol"); if ( !mxIsEmpty(opt) ) { m = mxGetM(opt); n = mxGetN(opt); if ( (n != 1) && (m != 1) ) { cvmErrHandler(-999, "CVODES", fctName, "AbsTol is not a scalar or a vector.", NULL); return(-1); } if ( m > n ) n = m; tmp = mxGetPr(opt); if (n == 1) { *itol = CV_SS; *Sabstol = *tmp; if (*Sabstol < 0.0) { cvmErrHandler(-999, "CVODES", fctName, "AbsTol is negative.", NULL); return(-1); } } else if (n == N) { *itol = CV_SV; *Vabstol = (double *) malloc(N*sizeof(double)); for(i=0;i *maxord) { cvmErrHandler(-999, "CVODES", fctName, "MaxOrder is too large for the Method specified.", NULL); return(-1); } *maxord = q; } /* Initial step size */ opt = mxGetField(options,0,"InitialStep"); if ( !mxIsEmpty(opt) ) { *hin = *mxGetPr(opt); } /* Maximum step size */ opt = mxGetField(options,0,"MaxStep"); if ( !mxIsEmpty(opt) ) { tmp = mxGetPr(opt); if (*tmp < 0.0) { cvmErrHandler(-999, "CVODES", fctName, "MaxStep is negative.", NULL); return(-1); } if ( mxIsInf(*tmp) ) *hmax = 0.0; else *hmax = *tmp; } /* Minimum step size */ opt = mxGetField(options,0,"MinStep"); if ( !mxIsEmpty(opt) ) { *hmin = *mxGetPr(opt); if (*hmin < 0.0) { cvmErrHandler(-999, "CVODES", fctName, "MinStep is negative.", NULL); return(-1); } } /* Stability Limit Detection */ opt = mxGetField(options,0,"StabilityLimDet"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { cvmErrHandler(-999, "CVODES", fctName, "StabilityLimDet is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *sld = TRUE; else *sld = FALSE; } /* Monitor? */ opt = mxGetField(options,0,"MonitorFn"); if ( !mxIsEmpty(opt) ) { mon = TRUE; mxDestroyArray(mtlb_MONfct); mtlb_MONfct = mxDuplicateArray(opt); opt = mxGetField(options,0,"MonitorData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_MONdata); mtlb_MONdata = mxDuplicateArray(opt); } } /* The remaining options are interpreted either for * forward problems only or backward problems only */ if (fwd) { /* FORWARD PROBLEM ONLY */ /* Disable error/warning messages? */ opt = mxGetField(options,0,"ErrorMessages"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { cvmErrHandler(-999, "CVODES", fctName, "ErrorMessages is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *errmsg = TRUE; else *errmsg = FALSE; } /* Stopping time */ opt = mxGetField(options,0,"StopTime"); if ( !mxIsEmpty(opt) ) { *tstop = *mxGetPr(opt); tstopSet = TRUE; } /* Number of root functions */ opt = mxGetField(options,0,"NumRoots"); if ( !mxIsEmpty(opt) ) { Ng = (int)*mxGetPr(opt); if (Ng < 0) { cvmErrHandler(-999, "CVODES", fctName, "NumRoots is negative.", NULL); return(-1); } if (Ng > 0) { /* Roots function */ opt = mxGetField(options,0,"RootsFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_Gfct); mtlb_Gfct = mxDuplicateArray(opt); } else { cvmErrHandler(-999, "CVODES", fctName, "RootsFn required for NumRoots > 0", NULL); return(-1); } } } } else { /* BACKWARD PROBLEM ONLY */ /* Dependency on forward sensitivities */ opt = mxGetField(options,0,"SensDependent"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { cvmErrHandler(-999, "CVODES", fctName, "SensDependent is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *rhs_s = TRUE; else *rhs_s = FALSE; } } /* We made it here without problems */ return(0); } int get_LinSolvOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, long int *mupper, long int *mlower, long int *mudq, long int *mldq, double *dqrely, int *ptype, int *gstype, int *maxl) { mxArray *opt; char *bufval; int buflen, status; char *fctName; char *fwd_fctName = "CVodeInit/CVodeReInit"; char *bck_fctName = "CVodeInitB/CVodeReInitB"; if (fwd) fctName = fwd_fctName; else fctName = bck_fctName; *mupper = 0; *mlower = 0; *mudq = 0; *mldq = 0; *dqrely = 0.0; *ptype = PREC_NONE; *gstype = MODIFIED_GS; *maxl = 0; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* Linear solver type */ opt = mxGetField(options,0,"LinearSolver"); if ( !mxIsEmpty(opt) ) { buflen = mxGetM(opt) * mxGetN(opt) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(opt, bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", fctName, "Cannot parse LinearSolver.", NULL); return(-1); } if(!strcmp(bufval,"Diag")) ls = LS_DIAG; else if(!strcmp(bufval,"Band")) ls = LS_BAND; else if(!strcmp(bufval,"GMRES")) ls = LS_SPGMR; else if(!strcmp(bufval,"BiCGStab")) ls = LS_SPBCG; else if(!strcmp(bufval,"TFQMR")) ls = LS_SPTFQMR; else if(!strcmp(bufval,"Dense")) ls = LS_DENSE; else { cvmErrHandler(-999, "CVODES", fctName, "LinearSolver has an illegal value.", NULL); return(-1); } } /* Jacobian function */ opt = mxGetField(options,0,"JacobianFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_JACfct); mtlb_JACfct = mxDuplicateArray(opt); } /* Band linear solver */ if (ls==LS_BAND) { opt = mxGetField(options,0,"UpperBwidth"); if ( !mxIsEmpty(opt) ) *mupper = (long int)*mxGetPr(opt); opt = mxGetField(options,0,"LowerBwidth"); if ( !mxIsEmpty(opt) ) *mlower = (long int)*mxGetPr(opt); } /* SPGMR linear solver options */ if (ls==LS_SPGMR) { /* Type of Gram-Schmidt procedure */ opt = mxGetField(options,0,"GramSchmidtType"); if ( !mxIsEmpty(opt) ) { buflen = mxGetM(opt) * mxGetN(opt) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(opt, bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", fctName, "Cannot parse GramSchmidtType.", NULL); return(-1); } if(!strcmp(bufval,"Classical")) *gstype = CLASSICAL_GS; else if(!strcmp(bufval,"Modified")) *gstype = MODIFIED_GS; else { cvmErrHandler(-999, "CVODES", fctName, "GramSchmidtType has an illegal value.", NULL); return(-1); } } } /* SPILS linear solver options */ if ( (ls==LS_SPGMR) || (ls==LS_SPBCG) || (ls==LS_SPTFQMR) ) { /* Max. dimension of Krylov subspace */ opt = mxGetField(options,0,"KrylovMaxDim"); if ( !mxIsEmpty(opt) ) { *maxl = (int)*mxGetPr(opt); if (*maxl < 0) { cvmErrHandler(-999, "CVODES", fctName, "KrylovMaxDim is negative.", NULL); return(-1); } } /* Preconditioning type */ opt = mxGetField(options,0,"PrecType"); if ( !mxIsEmpty(opt) ) { buflen = mxGetM(opt) * mxGetN(opt) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(opt, bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", fctName, "Cannot parse PrecType.", NULL); return(-1); } if(!strcmp(bufval,"Left")) *ptype = PREC_LEFT; else if(!strcmp(bufval,"Right")) *ptype = PREC_RIGHT; else if(!strcmp(bufval,"Both")) *ptype = PREC_BOTH; else if(!strcmp(bufval,"None")) *ptype = PREC_NONE; else { cvmErrHandler(-999, "CVODES", fctName, "PrecType has an illegal value.", NULL); return(-1); } } /* User defined precoditioning */ opt = mxGetField(options,0,"PrecSetupFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_PSETfct); mtlb_PSETfct = mxDuplicateArray(opt); } opt = mxGetField(options,0,"PrecSolveFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_PSOLfct); mtlb_PSOLfct = mxDuplicateArray(opt); } /* Preconditioner module */ opt = mxGetField(options,0,"PrecModule"); if ( !mxIsEmpty(opt) ) { buflen = mxGetM(opt) * mxGetN(opt) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(opt, bufval, buflen); if(status != 0) { cvmErrHandler(-999, "CVODES", fctName, "Cannot parse PrecModule.", NULL); return(-1); } if(!strcmp(bufval,"BandPre")) pm = PM_BANDPRE; else if(!strcmp(bufval,"BBDPre")) pm = PM_BBDPRE; else if(!strcmp(bufval,"UserDefined")) pm = PM_NONE; else { cvmErrHandler(-999, "CVODES", fctName, "PrecModule has an illegal value.", NULL); return(-1); } } if (pm != PM_NONE) { opt = mxGetField(options,0,"UpperBwidth"); if ( !mxIsEmpty(opt) ) *mupper = (long int)*mxGetPr(opt); opt = mxGetField(options,0,"LowerBwidth"); if ( !mxIsEmpty(opt) ) *mlower = (long int)*mxGetPr(opt); } if (pm == PM_BBDPRE) { opt = mxGetField(options,0,"UpperBwidthDQ"); if ( !mxIsEmpty(opt) ) *mudq = (long int)*mxGetPr(opt); opt = mxGetField(options,0,"LowerBwidthDQ"); if ( !mxIsEmpty(opt) ) *mldq = (long int)*mxGetPr(opt); opt = mxGetField(options,0,"GlocalFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_GLOCfct); mtlb_GLOCfct = mxDuplicateArray(opt); } else { cvmErrHandler(-999, "CVODES", fctName, "GlocalFn required for BBD preconditioner.", NULL); return(-1); } opt = mxGetField(options,0,"GcommFn"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_GCOMfct); mtlb_GCOMfct = mxDuplicateArray(opt); } } } /* We made it here without problems */ return(0); } int get_QuadOptions(const mxArray *options, cvmPbData thisPb, booleantype fwd, long int Nq, booleantype *rhs_s, booleantype *errconQ, int *itolQ, double *reltolQ, double *SabstolQ, double **VabstolQ) { mxArray *opt; long int i, m, n; double *tmp; char *fctName; char *fwd_fctName = "CVodeQuadInit/CVodeQuadReInit"; char *bck_fctName = "CVodeQuadInitB/CVodeQuadReInitB"; if (fwd) fctName = fwd_fctName; else fctName = bck_fctName; *errconQ = FALSE; *itolQ = CV_SS; *reltolQ = 1.0e-4; *SabstolQ = 1.0e-6; *VabstolQ = NULL; *rhs_s = FALSE; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* For backward problems only, check dependency on forward sensitivities */ if (!fwd) { opt = mxGetField(options,0,"SensDependent"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { cvmErrHandler(-999, "CVODES", fctName, "SensDependent is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *rhs_s = TRUE; else *rhs_s = FALSE; } } /* Quadrature error control and tolerances */ opt = mxGetField(options,0,"ErrControl"); if ( mxIsEmpty(opt) ) return(0); if (!mxIsLogical(opt)) { cvmErrHandler(-999, "CVODES", fctName, "ErrControl is not a logical scalar.", NULL); return(-1); } if (!mxIsLogicalScalarTrue(opt)) return(0); /* the remining options are interpreted only if quadratures are included in error control */ *errconQ = TRUE; opt = mxGetField(options,0,"RelTol"); if ( !mxIsEmpty(opt) ) { *reltolQ = *mxGetPr(opt); if (*reltolQ < 0.0) { cvmErrHandler(-999, "CVODES", fctName, "RelTol is negative.", NULL); return(-1); } } opt = mxGetField(options,0,"AbsTol"); if ( !mxIsEmpty(opt) ) { m = mxGetN(opt); n = mxGetM(opt); if ( (n != 1) && (m != 1) ) { cvmErrHandler(-999, "CVODES", fctName, "AbsTol is not a scalar or a vector.", NULL); return(-1); } if ( m > n ) n = m; tmp = mxGetPr(opt); if (n == 1) { *itolQ = CV_SS; *SabstolQ = *tmp; if (*SabstolQ < 0.0) { cvmErrHandler(-999, "CVODES", fctName, "AbsTol is negative.", NULL); return(-1); } } else if (n == Nq) { *itolQ = CV_SV; *VabstolQ = (double *)malloc(Nq*sizeof(double)); for(i=0;i n) n = m; if ( n != Ns) { cvmErrHandler(-999, "CVODES", "CVodeSensInit/CVodeSensReInit", "ParamList does not contain Ns elements.", NULL); return(-1); } *plist = (int *) malloc(Ns*sizeof(int)); for (is=0;is n ) n = m; if ( n != Ns) { cvmErrHandler(-999, "CVODES", "CVodeSensInit/CVodeSensReInit", "ParamScales does not contain Ns elements.", NULL); return(-1); } tmp = mxGetPr(opt); *pbar = (double *) malloc(Ns*sizeof(double)); for(i=0;i % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/05/11 18:51:31 $ mode = 40; cvm(mode); sundials-2.5.0/sundialsTB/cvodes/CVodeSetOptions.m0000600000175000017500000003653411741421121022760 0ustar sylvestresylvestrefunction options = CVodeSetOptions(varargin) %CVodeSetOptions creates an options structure for CVODES. % % Usage: OPTIONS = CVodeSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = CVodeSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = CVodeSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % a CVODES options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = CVodeSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % CVodeSetOptions with no input arguments displays all property names % and their possible values. % %CVodeSetOptions properties %(See also the CVODES User Guide) % %UserData - User data passed unmodified to all functions [ empty ] % If UserData is not empty, all user provided functions will be % passed the problem data as their last input argument. For example, % the RHS function must be defined as YD = ODEFUN(T,Y,DATA). % %LMM - Linear Multistep Method [ 'Adams' | {'BDF'} ] % This property specifies whether the Adams method is to be used instead % of the default Backward Differentiation Formulas (BDF) method. % The Adams method is recommended for non-stiff problems, while BDF is % recommended for stiff problems. %NonlinearSolver - Type of nonlinear solver used [ Functional | {Newton} ] % The 'Functional' nonlinear solver is best suited for non-stiff % problems, in conjunction with the 'Adams' linear multistep method, % while 'Newton' is better suited for stiff problems, using the 'BDF' % method. %RelTol - Relative tolerance [ positive scalar | {1e-4} ] % RelTol defaults to 1e-4 and is applied to all components of the solution % vector. See AbsTol. %AbsTol - Absolute tolerance [ positive scalar or vector | {1e-6} ] % The relative and absolute tolerances define a vector of error weights % with components % ewt(i) = 1/(RelTol*|y(i)| + AbsTol) if AbsTol is a scalar % ewt(i) = 1/(RelTol*|y(i)| + AbsTol(i)) if AbsTol is a vector % This vector is used in all error and convergence tests, which % use a weighted RMS norm on all error-like vectors v: % WRMSnorm(v) = sqrt( (1/N) sum(i=1..N) (v(i)*ewt(i))^2 ), % where N is the problem dimension. %MaxNumSteps - Maximum number of steps [positive integer | {500}] % CVode will return with an error after taking MaxNumSteps internal steps % in its attempt to reach the next output time. %InitialStep - Suggested initial stepsize [ positive scalar ] % By default, CVode estimates an initial stepsize h0 at the initial time % t0 as the solution of % WRMSnorm(h0^2 ydd / 2) = 1 % where ydd is an estimated second derivative of y(t0). %MaxStep - Maximum stepsize [ positive scalar | {inf} ] % Defines an upper bound on the integration step size. %MinStep - Minimum stepsize [ positive scalar | {0.0} ] % Defines a lower bound on the integration step size. %MaxOrder - Maximum method order [ 1-12 for Adams, 1-5 for BDF | {5} ] % Defines an upper bound on the linear multistep method order. %StopTime - Stopping time [ scalar ] % Defines a value for the independent variable past which the solution % is not to proceed. %RootsFn - Rootfinding function [ function ] % To detect events (roots of functions), set this property to the event % function. See CVRootFn. %NumRoots - Number of root functions [ integer | {0} ] % Set NumRoots to the number of functions for which roots are monitored. % If NumRoots is 0, rootfinding is disabled. %StabilityLimDet - Stability limit detection algorithm [ {false} | true ] % Flag used to turn on or off the stability limit detection algorithm % within CVODES. This property can be used only with the BDF method. % In this case, if the order is 3 or greater and if the stability limit % is detected, the method order is reduced. % %LinearSolver - Linear solver type [{Dense}|Diag|Band|GMRES|BiCGStab|TFQMR] % Specifies the type of linear solver to be used for the Newton nonlinear % solver (see NonlinearSolver). Valid choices are: Dense (direct, dense % Jacobian), Band (direct, banded Jacobian), Diag (direct, diagonal Jacobian), % GMRES (iterative, scaled preconditioned GMRES), BiCGStab (iterative, scaled % preconditioned stabilized BiCG), TFQMR (iterative, scaled transpose-free QMR). % The GMRES, BiCGStab, and TFQMR are matrix-free linear solvers. %JacobianFn - Jacobian function [ function ] % This propeerty is overloaded. Set this value to a function that returns % Jacobian information consistent with the linear solver used (see Linsolver). % If not specified, CVODES uses difference quotient approximations. % For the Dense linear solver, JacobianFn must be of type CVDenseJacFn and % must return a dense Jacobian matrix. For the Band linear solver, JacobianFn % must be of type CVBandJacFn and must return a banded Jacobian matrix. % For the iterative linear solvers, GMRES, BiCGStab, and TFQMR, JacobianFn must % be of type CVJacTimesVecFn and must return a Jacobian-vector product. This % property is not used for the Diag linear solver. % If these options are for a backward problem, the corresponding funciton types % are CVDenseJacFnB for the Dense linear solver, CVBandJacFnB for he band linear % solver, and CVJacTimesVecFnB for the iterative linear solvers. %KrylovMaxDim - Maximum number of Krylov subspace vectors [ integer | {5} ] % Specifies the maximum number of vectors in the Krylov subspace. This property % is used only if an iterative linear solver, GMRES, BiCGStab, or TFQMR is used % (see LinSolver). %GramSchmidtType - Gram-Schmidt orthogonalization [ Classical | {Modified} ] % Specifies the type of Gram-Schmidt orthogonalization (classical or modified). % This property is used only if the GMRES linear solver is used (see LinSolver). %PrecType - Preconditioner type [ Left | Right | Both | {None} ] % Specifies the type of user preconditioning to be done if an iterative linear % solver, GMRES, BiCGStab, or TFQMR is used (see LinSolver). PrecType must be % one of the following: 'None', 'Left', 'Right', or 'Both', corresponding to no % preconditioning, left preconditioning only, right preconditioning only, and % both left and right preconditioning, respectively. %PrecModule - Preconditioner module [ BandPre | BBDPre | {UserDefined} ] % If PrecModule = 'UserDefined', then the user must provide at least a % preconditioner solve function (see PrecSolveFn) % CVODES provides the following two general-purpose preconditioner modules: % BandPre provide a band matrix preconditioner based on difference quotients % of the ODE right-hand side function. The user must specify the lower and % upper half-bandwidths through the properties LowerBwidth and UpperBwidth, % respectively. % BBDPre can be only used with parallel vectors. It provide a preconditioner % matrix that is block-diagonal with banded blocks. The blocking corresponds % to the distribution of the dependent variable vector y among the processors. % Each preconditioner block is generated from the Jacobian of the local part % (on the current processor) of a given function g(t,y) approximating % f(t,y) (see GlocalFn). The blocks are generated by a difference quotient % scheme on each processor independently. This scheme utilizes an assumed % banded structure with given half-bandwidths, mldq and mudq (specified through % LowerBwidthDQ and UpperBwidthDQ, respectively). However, the banded Jacobian % block kept by the scheme has half-bandwiths ml and mu (specified through % LowerBwidth and UpperBwidth), which may be smaller. %PrecSetupFn - Preconditioner setup function [ function ] % If PrecType is not 'None', PrecSetupFn specifies an optional function which, % together with PrecSolve, defines left and right preconditioner matrices % (either of which can be trivial), such that the product P1*P2 is an % aproximation to the Newton matrix. PrecSetupFn must be of type CVPrecSetupFn % or CVPrecSetupFnB for forward and backward problems, respectively. %PrecSolveFn - Preconditioner solve function [ function ] % If PrecType is not 'None', PrecSolveFn specifies a required function which % must solve a linear system Pz = r, for given r. PrecSolveFn must be of type % CVPrecSolveFn or CVPrecSolveFnB for forward and backward problems, respectively. %GlocalFn - Local right-hand side approximation funciton for BBDPre [ function ] % If PrecModule is BBDPre, GlocalFn specifies a required function that % evaluates a local approximation to the ODE right-hand side. GlocalFn must % be of type CVGlocFn or CVGlocFnB for forward and backward problems, respectively. %GcommFn - Inter-process communication function for BBDPre [ function ] % If PrecModule is BBDPre, GcommFn specifies an optional function % to perform any inter-process communication required for the evaluation of % GlocalFn. GcommFn must be of type CVGcommFn or CVGcommFnB for forward and % backward problems, respectively. %LowerBwidth - Jacobian/preconditioner lower bandwidth [ integer | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the lower half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in CVODES is used % (see PrecModule), it specifies the lower half-bandwidth of the retained % banded approximation of the local Jacobian block. If the BandPre preconditioner % module (see PrecModule) is used, it specifies the lower half-bandwidth of % the band preconditioner matrix. LowerBwidth defaults to 0 (no sub-diagonals). %UpperBwidth - Jacobian/preconditioner upper bandwidth [ integer | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the upper half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in CVODES is used % (see PrecModule), it specifies the upper half-bandwidth of the retained % banded approximation of the local Jacobian block. If the BandPre % preconditioner module (see PrecModule) is used, it specifies the upper % half-bandwidth of the band preconditioner matrix. UpperBwidth defaults to % 0 (no super-diagonals). %LowerBwidthDQ - BBDPre preconditioner DQ lower bandwidth [ integer | {0} ] % Specifies the lower half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). %UpperBwidthDQ - BBDPre preconditioner DQ upper bandwidth [ integer | {0} ] % Specifies the upper half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). % %MonitorFn - User-provied monitoring function [ function ] % Specifies a function that is called after each successful integration step. % This function must have type CVMonitorFn or CVMonitorFnB, depending on % whether these options are for a forward or a backward problem, respectively. % Sample monitoring functions CVodeMonitor and CvodeMonitorB are provided % with CVODES. %MonitorData - User-provied data for the monitoring function [ struct ] % Specifies a data structure that is passed to the MonitorFn function every % time it is called. % %SensDependent - Backward problem depending on sensitivities [ {false} | true ] % Specifies whether the backward problem right-hand side depends on % forward sensitivites. If TRUE, the right-hand side function provided for % this backward problem must have the appropriate type (see CVRhsFnB). % %ErrorMessages - Post error/warning messages [ {true} | false ] % Note that any errors in CVodeInit will result in a Matlab error, thus % stoping execution. Only subsequent calls to CVODES functions will respect % the value specified for 'ErrorMessages'. % %NOTES: % % The properties listed above that can only be used for forward problems % are: StopTime, RootsFn, and NumRoots. % % The property SensDependent is relevant only for backward problems. % % % See also % CVodeInit, CVodeReInit, CVodeInitB, CVodeReInitB % CVRhsFn, CVRootFn, % CVDenseJacFn, CVBandJacFn, CVJacTimesVecFn % CVPrecSetupFn, CVPrecSolveFn % CVGlocalFn, CVGcommFn % CVMonitorFn % CVRhsFnB, % CVDenseJacFnB, CVBandJacFnB, CVJacTimesVecFnB % CVPrecSetupFnB, CVPrecSolveFnB % CVGlocalFnB, CVGcommFnB % CVMonitorFnB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.9 $Date: 2007/12/05 21:58:18 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) && (nargout == 0) fprintf(' UserData: [ empty ]\n'); fprintf('\n'); fprintf(' LMM: [ Adams | {BDF} ]\n'); fprintf(' NonlinearSolver: [ Functional | {Newton} ]\n'); fprintf(' RelTol: [ positive scalar | {1e-4} ]\n'); fprintf(' AbsTol: [ positive scalar or vector | {1e-6} ]\n'); fprintf(' MaxNumSteps: [ positive integer | {500} ]\n'); fprintf(' InitialStep: [ positive scalar ]\n'); fprintf(' MaxStep: [ positive scalar | {inf} ]\n'); fprintf(' MinStep: [ positive scalar | {0.0} ]\n'); fprintf(' MaxOrder: [ 1-12 for Adams, 1-5 for BDF | {5} ]\n'); fprintf(' StopTime: [ scalar ]\n'); fprintf(' RootsFn: [ function ]\n'); fprintf(' NumRoots: [ integer | {0} ]\n'); fprintf(' StabilityLimDet: [ {false} | true ]\n'); fprintf('\n'); fprintf(' LinearSolver: [ {Dense} | Diag | Band | GMRES | BiCGStab | TFQMR ]\n'); fprintf(' JacobianFn: [ function ]\n'); fprintf(' KrylovMaxDim: [ integer | {5} ]\n'); fprintf(' GramSchmidtType: [ Classical | {Modified} ]\n'); fprintf(' PrecType: [ Left | Right | Both | {None} ]\n'); fprintf(' PrecModule: [ BandPre | BBDPre | {UserDefined} ]\n'); fprintf(' PrecSetupFn: [ function ]\n'); fprintf(' PrecSolveFn: [ function ]\n'); fprintf(' GlocalFn: [ function ]\n'); fprintf(' GcommFn: [ function ]\n'); fprintf(' LowerBwidth: [ integer | {0} ]\n'); fprintf(' UpperBwidth: [ integer | {0} ]\n'); fprintf(' LowerBwidthDQ: [ integer | {0} ]\n'); fprintf(' UpperBwidthDQ: [ integer | {0} ]\n'); fprintf('\n'); fprintf(' MonitorFn: [ function ]\n'); fprintf(' MonitorData: [ struct ]\n'); fprintf('\n'); fprintf(' SensDependent: [ {false} | true ]\n'); fprintf('\n'); fprintf(' ErrorMessages: [ false | {true} ]\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'LMM' 'NonlinearSolver' 'RelTol' 'AbsTol' 'MaxNumSteps' 'InitialStep' 'MaxStep' 'MinStep' 'MaxOrder' 'StopTime' 'RootsFn' 'NumRoots' 'StabilityLimDet' 'LinearSolver' 'JacobianFn' 'PrecType' 'PrecModule' 'PrecSetupFn' 'PrecSolveFn' 'KrylovMaxDim' 'GramSchmidtType' 'GlocalFn' 'GcommFn' 'LowerBwidth' 'UpperBwidth' 'LowerBwidthDQ' 'UpperBwidthDQ' 'MonitorFn' 'MonitorData' 'SensDependent' 'ErrorMessages' }; options = cvm_options(KeyNames,varargin{:}); sundials-2.5.0/sundialsTB/cvodes/CVodeSensSetOptions.m0000600000175000017500000001344611741421121023606 0ustar sylvestresylvestrefunction options = CVodeSensSetOptions(varargin) %CVodeSensSetOptions creates an options structure for FSA with CVODES. % % Usage: OPTIONS = CVodeSensSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = CVodeSensSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = CVodeSensSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % a CVODES options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = CVodeSensSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % CVodeSensSetOptions with no input arguments displays all property names % and their possible values. % %CVodeSensSetOptions properties %(See also the CVODES User Guide) % %method - FSA solution method [ 'Simultaneous' | {'Staggered'} ] % Specifies the FSA method for treating the nonlinear system solution for % sensitivity variables. In the simultaneous case, the nonlinear systems % for states and all sensitivities are solved simultaneously. In the % Staggered case, the nonlinear system for states is solved first and then % the nonlinear systems for all sensitivities are solved at the same time. %ParamField - Problem parameters [ string ] % Specifies the name of the field in the user data structure (specified through % the 'UserData' field with CVodeSetOptions) in which the nominal values of the problem % parameters are stored. This property is used only if CVODES will use difference % quotient approximations to the sensitivity right-hand sides (see CVSensRhsFn). %ParamList - Parameters with respect to which FSA is performed [ integer vector ] % Specifies a list of Ns parameters with respect to which sensitivities are to % be computed. This property is used only if CVODES will use difference-quotient % approximations to the sensitivity right-hand sides. Its length must be Ns, % consistent with the number of columns of yS0 (see CVodeSensInit). %ParamScales - Order of magnitude for problem parameters [ vector ] % Provides order of magnitude information for the parameters with respect to % which sensitivities are computed. This information is used if CVODES % approximates the sensitivity right-hand sides or if CVODES estimates integration % tolerances for the sensitivity variables (see RelTol and AbsTol). %RelTol - Relative tolerance for sensitivity variables [ positive scalar ] % Specifies the scalar relative tolerance for the sensitivity variables. % See also AbsTol. %AbsTol - Absolute tolerance for sensitivity variables [ row-vector or matrix ] % Specifies the absolute tolerance for sensitivity variables. AbsTol must be % either a row vector of dimension Ns, in which case each of its components is % used as a scalar absolute tolerance for the coresponding sensitivity vector, % or a N x Ns matrix, in which case each of its columns is used as a vector % of absolute tolerances for the corresponding sensitivity vector. % By default, CVODES estimates the integration tolerances for sensitivity % variables, based on those for the states and on the order of magnitude % information for the problem parameters specified through ParamScales. %ErrControl - Error control strategy for sensitivity variables [ false | {true} ] % Specifies whether sensitivity variables are included in the error control test. % Note that sensitivity variables are always included in the nonlinear system % convergence test. %DQtype - Type of DQ approx. of the sensi. RHS [{Centered} | Forward ] % Specifies whether to use centered (second-order) or forward (first-order) % difference quotient approximations of the sensitivity eqation right-hand % sides. This property is used only if a user-defined sensitivity right-hand % side function was not provided. %DQparam - Cut-off parameter for the DQ approx. of the sensi. RHS [ scalar | {0.0} ] % Specifies the value which controls the selection of the difference-quotient % scheme used in evaluating the sensitivity right-hand sides (switch between % simultaneous or separate evaluations of the two components in the sensitivity % right-hand side). The default value 0.0 indicates the use of simultaenous approximation % exclusively (centered or forward, depending on the value of DQtype. % For DQparam >= 1, CVODES uses a simultaneous approximation if the estimated % DQ perturbations for states and parameters are within a factor of DQparam, % and separate approximations otherwise. Note that a value DQparam < 1 % will inhibit switching! This property is used only if a user-defined sensitivity % right-hand side function was not provided. % % See also % CVodeSensInit, CVodeSensReInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/08/21 17:42:38 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) & (nargout == 0) fprintf(' method: [ Simultaneous | {Staggered} ]\n'); fprintf(' ParamField: [ string ]\n'); fprintf(' ParamList: [ integer vector ]\n'); fprintf(' ParamScales: [ vector ]\n'); fprintf(' RelTol: [ positive scalar ]\n'); fprintf(' AbsTol: [ row-vector or matrix ]\n'); fprintf(' ErrControl: [ false | {true} ]\n'); fprintf(' DQtype: [ {Centered} | {Forward} ]\n'); fprintf(' DQparam: [ scalar | {0.0} ]\n'); fprintf('\n'); return; end KeyNames = { 'method' 'ParamField' 'ParamList' 'ParamScales' 'RelTol' 'AbsTol' 'ErrControl' 'DQtype' 'DQparam' }; options = cvm_options(KeyNames,varargin{:}); sundials-2.5.0/sundialsTB/cvodes/CVodeMonitor_octave.m0000600000175000017500000003035511741421121023634 0ustar sylvestresylvestrefunction [new_data] = CVodeMonitor(call, T, Y, YQ, YS, data) %CVodeMonitor is the default CVODES monitoring function. % To use it, set the Monitor property in CVodeSetOptions to % 'CVodeMonitor' or to @CVodeMonitor and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to CVodeSetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see CVodeGetStats) % o sol [ true | {false} ] % If true, plot solution components. % o sensi [ true | {false} ] % If true and if FSA is enabled, plot sensitivity components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also CVodeSetOptions, CVMonitorFn % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to CVodeSetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/08/21 17:42:38 $ % NOTES: % - Unlike Matlab, Octave loads children in the normal order % - Unlike Matlab, Octave stores 'XData' and 'YData' as column vectors if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end if data.sol | data.sensi data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y and YS for additional initializations if data.first if isempty(YS) data.sensi = false; end if data.sol | data.sensi if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end if data.sensi data.Ns = size(YS,2); data.ys = zeros(data.N, data.Ns, data.updt); data.nps = data.nps + data.Ns; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; Ns = data.Ns; y = data.y; ys = data.ys; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = CVodeGetStats; t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end if data.sensi for k = 1:Ns for j = 1:N ys(j,k,n) = YS(data.select(j),k); end end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol | data.sensi sol_init(n, hfs, nps, data.sol, data.sensi, ... N, Ns, t, y, ys); end data.initialized = true; else if (data.stats | data.cntr) graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, data.sensi, N, Ns, t, y, ys); end end if call == 2 if (data.stats | data.cntr) graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol | data.sensi sol_final(hfs, nps, data.sol, data.sensi, N, Ns); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.ys = ys; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'sensi') data.sensi = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end if ~data.sol & ~data.sensi data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.Ns = 0; data.y = 0; data.ys = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Time label and figure title tlab = '-> t ->'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; abs(h(1:n)')]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') ; t(1:n)']; yd = [get(hc,'YData') ; q(1:n)']; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; yd = [get(hc(1),'YData') ; ncfn(1:n)']; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') ; netf(1:n)']; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') ; nni(1:n)']; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') ; nfe(1:n)']; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') ; nst(1:n)']; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); % Time label tlab = '-> t ->'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hold on; ys_crt = ys(:,is,1:n); for i = 1:N hp = plot(t(1:n),ys_crt(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); str = sprintf('s_{%d}',is); ylabel(str); str = sprintf('Sensitivity %d',is); title(str); end end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; y(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); ys_crt = ys(:,is,:); hc = get(gca,'Children'); xd = [get(hc(1),'XData') ; t(1:n)']; for i = 1:N yd = [get(hc(i),'YData') ; ys_crt(i,1:n)']; set(hc(i), 'XData', xd, 'YData', yd); end end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, sensi, N, Ns) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('s%d_{%d}',is,i); end legend(cstring); end end drawnow sundials-2.5.0/sundialsTB/cvodes/CVodeMonitor.m0000600000175000017500000004035511741421121022274 0ustar sylvestresylvestrefunction [new_data] = CVodeMonitor(call, T, Y, YQ, YS, data) %CVodeMonitor is the default CVODES monitoring function. % To use it, set the Monitor property in CVodeSetOptions to % 'CVodeMonitor' or to @CVodeMonitor and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to CVodeSetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see CVodeGetStats) % o mode [ {'graphical'} | 'text' | 'both' ] % In graphical mode, plot the evolutions of the above quantities. % In text mode, print a table. % o sol [ true | {false} ] % If true, plot solution components. % o sensi [ true | {false} ] % If true and if FSA is enabled, plot sensitivity components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also CVodeSetOptions, CVMonitorFn % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to CVodeSetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.6 $Date: 2007/08/21 17:42:38 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.grph if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end end if data.text if data.cntr | data.stats data.hft = figure; end end if data.sol | data.sensi data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y and YS for additional initializations if data.first if isempty(YS) data.sensi = false; end if data.sol | data.sensi if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end if data.sensi data.Ns = size(YS,2); data.ys = zeros(data.N, data.Ns, data.updt); data.nps = data.nps + data.Ns; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; Ns = data.Ns; y = data.y; ys = data.ys; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = CVodeGetStats; t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end if data.sensi for k = 1:Ns for j = 1:N ys(j,k,n) = YS(data.select(j),k); end end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) & data.grph graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_init(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol | data.sensi sol_init(n, hfs, nps, data.sol, data.sensi, ... N, Ns, t, y, ys); end data.initialized = true; else if (data.stats | data.cntr) & data.grph graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_update(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, data.sensi, N, Ns, t, y, ys); end end if call == 2 if (data.stats | data.cntr) & data.grph graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol | data.sensi sol_final(hfs, nps, data.sol, data.sensi, N, Ns); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.ys = ys; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'mode') data.mode = 'graphical'; end if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'sensi') data.sensi = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end data.grph = true; data.text = true; if strcmp(data.mode,'graphical') data.text = false; end if strcmp(data.mode,'text') data.grph = false; end if ~data.sol & ~data.sensi data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.Ns = 0; data.y = 0; data.ys = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) fig_name = 'CVODES run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfg); set(hfg,'Name',fig_name); set(hfg,'color',[1 1 1]); pl = 0; % Time label and figure title tlab = '\rightarrow t \rightarrow'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') abs(h(1:n))]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') q(1:n)]; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); % Attention: Children are loaded in reverse order! xd = [get(hc(1),'XData') t(1:n)]; yd = [get(hc(1),'YData') ncfn(1:n)]; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') netf(1:n)]; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') nni(1:n)]; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') nfe(1:n)]; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') nst(1:n)]; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = text_init(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) fig_name = 'CVODES run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hft); set(hft,'Name',fig_name); set(hft,'color',[1 1 1]); set(hft,'MenuBar','none'); set(hft,'Resize','off'); % Create text box margins=[10 10 50 50]; % left, right, top, bottom pos=get(hft,'position'); tbpos=[margins(1) margins(4) pos(3)-margins(1)-margins(2) ... pos(4)-margins(3)-margins(4)]; tbpos(tbpos<1)=1; htb=uicontrol(hft,'style','listbox','position',tbpos,'tag','textbox'); set(htb,'BackgroundColor',[1 1 1]); set(htb,'SelectionHighlight','off'); set(htb,'FontName','courier'); % Create table head tpos = [tbpos(1) tbpos(2)+tbpos(4)+10 tbpos(3) 20]; ht=uicontrol(hft,'style','text','position',tpos,'tag','text'); set(ht,'BackgroundColor',[1 1 1]); set(ht,'HorizontalAlignment','left'); set(ht,'FontName','courier'); newline = ' time step order | nst nfe nni netf ncfn'; set(ht,'String',newline); % Create OK button bsize=[60,28]; badjustpos=[0,25]; bpos=[pos(3)/2-bsize(1)/2+badjustpos(1) -bsize(2)/2+badjustpos(2)... bsize(1) bsize(2)]; bpos=round(bpos); bpos(bpos<1)=1; hb=uicontrol(hft,'style','pushbutton','position',bpos,... 'string','Close','tag','okaybutton'); set(hb,'callback','close'); % Save handles handles=guihandles(hft); guidata(hft,handles); for i = 1:n newline = ''; if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = text_update(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) figure(hft); handles=guidata(hft); for i = 1:n if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) fig_name = 'CVODES solution'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfs); set(hfs,'Name',fig_name); set(hfs,'color',[1 1 1]); % Time label tlab = '\rightarrow t \rightarrow'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hold on; ys_crt = ys(:,is,1:n); for i = 1:N hp = plot(t(1:n),ys_crt(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); str = sprintf('s_{%d}',is); ylabel(str); str = sprintf('Sensitivity %d',is); title(str); end end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, sensi, N, Ns, t, y, ys) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') y(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); ys_crt = ys(:,is,:); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') ys_crt(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, sensi, N, Ns) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end if sensi for is = 1:Ns pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('s%d_{%d}',is,i); end legend(cstring); end end drawnow sundials-2.5.0/sundialsTB/cvodes/examples_ser/0000755000175000017500000000000011767174700022256 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsPollut_FSA_dns.m0000600000175000017500000002152411741421121026115 0ustar sylvestresylvestrefunction mcvsPollut_FSA_dns() %mcvsPollut_FSA_dns - Air pollution model % J.G Verwer - Gauss-Seidel Iteration for Stiff ODEs from Chemical Kinetics % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ t0 = 0.0; tf = 1.0; Ny = 20; Np = 25; plist = [21;22;23;24;25]; Ns = length(plist); % ------------------- % User data structure % ------------------- data.p = [0.35 ; 0.266e2 ; 0.123e5 ; 0.86e-3 ; 0.82e-3 ; ... 0.15e5 ; 0.13e-3 ; 0.24e5 ; 0.165e5 ; 0.9e4 ; ... 0.22e-1 ; 0.12e5 ; 0.188e1 ; 0.163e5 ; 0.48e7 ; ... 0.35e-3 ; 0.175e-1 ; 0.1e9 ; 0.444e12 ; 0.124e4 ; ... 0.21e1 ; 0.578e1 ; 0.474e-1 ; 0.178e4 ; 0.312e1]; data.plist = plist; % --------------------- % CVODES initialization % --------------------- options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-5,... 'AbsTol',1.e-8,... 'LinearSolver','Dense'); y0 = [0 ; 0.2 ; 0 ; 0.04 ; 0 ; ... 0 ; 0.1 ; 0.3 ; 0.01 ; 0 ; ... 0 ; 0 ; 0 ; 0 ; 0 ; ... 0 ; 0.007 ; 0 ; 0 ; 0]; CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); % ------------------ % FSA initialization % ------------------ yS0 = zeros(Ny,Ns); FSAoptions = CVodeSensSetOptions('method','Simultaneous',... 'ErrControl', true,... 'ParamScales', data.p(plist)); CVodeSensInit(Ns, @rhsSfn, yS0, FSAoptions); % ---------------- % Problem solution % ---------------- time(1,1) = t0; sol(1,:) = y0'; sens(1,:,:) = yS0; t = t0; it = 1; while t % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ data.p = [0.04; 1.0e4; 3.0e7]; t0 = 0.0; y0 = [1.0;0.0;0.0]; options = CVodeSetOptions('UserData', data,... 'RelTol',1.e-8,... 'AbsTol',[1.e-8; 1.e-14; 1.e-6],... 'LinearSolver','Dense',... 'JacobianFn',@djacfn,... 'RootsFn',@rootfn, 'NumRoots',2); mondata.sol = true; mondata.mode = 'text'; mondata.skip = 9; mondata.updt = 100; options = CVodeSetOptions(options,'MonitorFn',@CVodeMonitor,'MonitorData',mondata); CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); t1 = 0.4; tmult = 10.0; nout = 12; iout = 0; tout = t1; while iout < nout [status,t,y] = CVode(tout,'Normal'); % Extract statistics si = CVodeGetStats; % Print output fprintf('t = %0.2e order = %1d step = %0.2e',t, si.qlast, si.hlast); if(status == 2) fprintf(' ... Root found %d %d\n',si.RootInfo.roots(1), si.RootInfo.roots(2)); else fprintf('\n'); end fprintf('solution = [ %14.6e %14.6e %14.6e ]\n\n', y(1), y(2), y(3)); % Update output time if(status == 0) iout = iout+1; tout = tout*tmult; end end si = CVodeGetStats; CVodeFree; % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); yd(1) = -r1*y(1) + r2*y(2)*y(3); yd(3) = r3*y(2)*y(2); yd(2) = -yd(1) - yd(3); flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = djacfn(t, y, fy, data) % Dense Jacobian function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); J(1,1) = -r1; J(1,2) = r2*y(3); J(1,3) = r2*y(2); J(2,1) = r1; J(2,2) = -r2*y(3) - 2*r3*y(2); J(2,3) = -r2*y(2); J(3,2) = 2*r3*y(2); flag = 0; new_data = []; return % =========================================================================== function [g, flag, new_data] = rootfn(t,y,data) % Root finding function g(1) = y(1) - 0.0001; g(2) = y(3) - 0.01; flag = 0; new_data = []; sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsDiscRHS_dns.m0000600000175000017500000000651211741421121025404 0ustar sylvestresylvestrefunction mcvsDiscRHS_dns() %mcvsDiscRHS_dns - CVODES example with RHS discontinuity % Trivial CVODES example to illustrate the proper % way to integrate over a discontinuity in the RHS: % y' = -y ; y(0) = 1 ; t = [0,1] % z' = -5*z ; z(1) = y(1) ; t = [1,2] % The problem is solved twice, first by explicitly treating the % discontinuity point and secondly by letting the integrator % deal with the discontinuity. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $ t0 = 0.0; t1 = 1.0; t2 = 2.0; y0 = 1.0; % --------------------------------------------------------------- % Discontinuity in RHS: Case 1 - let CVODES deal with it. % --------------------------------------------------------------- data.tdisc = t1; % Initialize solver options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-3,... 'AbsTol',1.e-4,... 'LinearSolver','Dense'); CVodeInit(@rhsfn1, 'BDF', 'Newton', t0, y0, options); % Integrate over the point of discontinuity t = t0; i = 1; tt1(1) = t0; yy1(1) = y0; while t < t2 [status, t, y] = CVode(t2,'OneStep'); i = i+1; tt1(i) = t; yy1(i) = y; end % Free memory CVodeFree; % ------------------------------------------------------------- % Discontinuity in RHS: Case 1 - explicit treatment % Note that, since we set tstop at the point of discontinuity, % we could simply use the exact same RHS function as before. % However, we chose to use a flag set in the user data (to also % illustrate the use of CVodeSet). % ------------------------------------------------------------- % Initialize solver (data.flag = 1) data.flag = 1; options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-3,... 'AbsTol',1.e-4,... 'StopTime',t1,... 'LinearSolver','Dense'); CVodeInit(@rhsfn2, 'BDF', 'Newton', t0, y0, options); % Integrate to the point of discontinuity t = t0; i = 1; tt2(1) = t0; yy2(1) = y0; while t < t2 [status, t, y] = CVode(t2,'OneStep'); i = i+1; tt2(i) = t; yy2(i) = y; if status == 1 % Once tstop is reached, flag a change in RHS data.flag = 2; CVodeSet('UserData',data); end end % Free memory CVodeFree; % Plot the two solutions figure subplot(2,1,1) hold on plot(tt1,yy1); plot(tt2,yy2,'r'); legend('Integrate over discontinuity','Stop at discontinuity'); title('Discontinuity in RHS'); xlabel('time'); ylabel('y'); box on subplot(2,1,2) hold on plot(tt1,yy1,'b',tt1,yy1,'b.'); plot(tt2,yy2,'r',tt2,yy2,'r.'); set(gca,'XLim',[0.99 1.01],'YLim',[0.36 0.37]); legend('Integrate over discontinuity','Stop at discontinuity'); title('Zoom on discontinuity'); xlabel('time'); ylabel('y'); grid on box on return % =========================================================================== function [yd, flag, new_data] = rhsfn1(t, y, data) % Right-hand side function for case 1 if t <= data.tdisc yd(1) = -y(1); else yd(1) = -5*y(1); end flag = 0; new_data = []; return % =========================================================================== function [yd, flag, new_data] = rhsfn2(t, y, data) % Right-hand side function for case 2 if data.flag == 1 yd(1) = -y(1); else yd(1) = -5*y(1); end flag = 0; new_data = []; return sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsHessian_FSA_ASA.m0000600000175000017500000001660411741421121026053 0ustar sylvestresylvestrefunction mcvsHessian_FSA_ASA %mcvsHessian_FSA_ASA - CVODES Hessian calculation example (FSA over ASA) % The following is a simple example illustrating the use % of simultaneous FSA and ASA computations in order to % evaluate the Hessian of a functional depending on the % ODE solution. % % The forward problem consists of the following 3 equations % % dy1/dt = - p1 * y1^2 - y3; % dy2/dt = - y2; % dy3/dt = - p2^2 * y2 * y3; % % depending on the parameters p1 = 1.0 and p2 = 2.0. % % The initial conditions are y1(0) = y2(0) = y390) = 1.0 % % The functional considered is % % 2 % / % G(p) = | 0.5 * ( y1^2 + y2^2 + y3^2 ) dt % / % 0 % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ Neq = 3; Np = 2; t0 = 0.0; tf = 2.0; % ---------------------------------------- % User data structure % ---------------------------------------- data.p = [1.0 2.0]; % ---------------------------------------- % Forward CVODES options % ---------------------------------------- options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-8,... 'AbsTol',1.0e-8,... 'LinearSolver','Dense'); optionsQ = CVodeQuadSetOptions('ErrControl',true,... 'RelTol',1.e-8,'AbsTol',1.e-8); optionsS = CVodeSensSetOptions('method','Simultaneous',... 'ErrControl', true,... 'ParamScales', [1.0; 2.0]); y0 = ones(Neq,1); CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); q0 = 0.0; CVodeQuadInit(@rhsQfn, q0, optionsQ); s0 = zeros(Neq,Np); CVodeSensInit(Np, @rhsSfn, s0, optionsS); % ---------------------------------------- % Initialize ASA % ---------------------------------------- CVodeAdjInit(100, 'Polynomial'); % ---------------------------------------- % Forward integration % ---------------------------------------- fprintf('\nForward integration '); [status, tret, y, q, yS] = CVode(tf,'Normal'); s = CVodeGetStats; fprintf('(%d steps)\n', s.nst); fprintf('G = %12.4e\n', q); % ---------------------------------------- % Backward CVODES options % ---------------------------------------- optionsB = CVodeSetOptions('UserData',data,... 'RelTol',1.e-8,... 'AbsTol',1.e-8,... 'LinearSolver','Dense',... 'SensDependent', true); optionsQB = CVodeQuadSetOptions('ErrControl',true,... 'RelTol',1.e-8,'AbsTol',1.e-8,... 'SensDependent', true); yB1 = zeros(2*Neq,1); idxB1 = CVodeInitB(@rhsB1fn, 'BDF', 'Newton', tf, yB1, optionsB); qB1 = zeros(2*Np,1); CVodeQuadInitB(idxB1, @rhsQB1fn, qB1, optionsQB); yB2 = zeros(2*Neq,1); idxB2 = CVodeInitB(@rhsB2fn, 'BDF', 'Newton', tf, yB2, optionsB); qB2 = zeros(2*Np,1); CVodeQuadInitB(idxB2, @rhsQB2fn, qB2, optionsQB); % ---------------------------------------- % Backward integration % ---------------------------------------- fprintf('\nBackward integration '); [status, tretB, yB, qB] = CVodeB(t0,'Normal'); sB1 = CVodeGetStatsB(idxB1); sB2 = CVodeGetStatsB(idxB2); fprintf('(%d steps pb1) (%d steps pb2)\n',sB1.nst, sB2.nst); qB1 = -qB{idxB1}; qB2 = -qB{idxB2}; fprintf('Gradient\n'); fprintf(' %12.4e %12.4e (from backward pb. 1)\n',qB1(1:2)); fprintf(' %12.4e %12.4e (from backward pb. 2)\n',qB2(1:2)); fprintf('Hessian\n'); fprintf(' %12.4e %12.4e\n',qB1(3), qB2(3)); fprintf(' %12.4e %12.4e\n',qB1(4), qB2(4)); % ---------------------------------------- % Free memory % ---------------------------------------- CVodeFree; % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function p1 = data.p(1); p2 = data.p(2); yd(1) = - p1 * y(1)^2 - y(3); yd(2) = - y(2); yd(3) = - p2^2 * y(2) * y(3); flag = 0; new_data = []; return % =========================================================================== function [qd, flag, new_data] = rhsQfn(t, y, data) % Forward quadrature integrand function qd = 0.5 * ( y(1)^2 + y(2)^2 + y(3)^2 ); flag = 0; new_data = []; return % =========================================================================== function [ySd, flag, new_data] = rhsSfn(t,y,yd,yS,data) % Sensitivity right-hand side function p1 = data.p(1); p2 = data.p(2); s = yS(:,1); fys1 = - 2.0*p1*y(1) * s(1) - s(3); fys2 = - s(2); fys3 = - p2*p2*y(3) * s(2) - p2*p2*y(2) * s(3); ySd(1,1) = fys1 - y(1)*y(1); ySd(2,1) = fys2; ySd(3,1) = fys3; s = yS(:,2); fys1 = - 2.0*p1*y(1) * s(1) - s(3); fys2 = - s(2); fys3 = - p2*p2*y(3) * s(2) - p2*p2*y(2) * s(3); ySd(1,2) = fys1; ySd(2,2) = fys2; ySd(3,2) = fys3 - 2.0*p2*y(2)*y(3); flag = 0; new_data = []; return % =========================================================================== function [yBd, flag, new_data] = rhsB1fn(t, y, yS, yB, data) % Backward problem right-hand side function for 1st Hessian column p1 = data.p(1); p2 = data.p(2); y1 = y(1); y2 = y(2); y3 = y(3); s1 = yS(1,1); s2 = yS(2,1); s3 = yS(3,1); l1 = yB(1); l2 = yB(2); l3 = yB(3); m1 = yB(4); m2 = yB(5); m3 = yB(6); yBd(1) = 2.0*p1*y1 * l1 - y1; yBd(2) = l2 + p2*p2*y3 * l3 - y2; yBd(3) = l1 + p2*p2*y2 * l3 - y3; yBd(4) = 2.0*p1*y1 * m1 + l1 * 2.0*(y1 + p1*s1) - s1; yBd(5) = m2 + p2*p2*y3 * m3 + l3 * p2*p2*s3 - s2; yBd(6) = m1 + p2*p2*y2 * m3 + l3 * p2*p2*s2 - s3; flag = 0; new_data = []; return % =========================================================================== function [yBd, flag, new_data] = rhsB2fn(t, y, yS, yB, data) % Backward problem right-hand side function 2nd Hessian column p1 = data.p(1); p2 = data.p(2); y1 = y(1); y2 = y(2); y3 = y(3); s1 = yS(1,2); s2 = yS(2,2); s3 = yS(3,2); l1 = yB(1); l2 = yB(2); l3 = yB(3); m1 = yB(4); m2 = yB(5); m3 = yB(6); yBd(1) = 2.0*p1*y1 * l1 - y1; yBd(2) = l2 + p2*p2*y3 * l3 - y2; yBd(3) = l1 + p2*p2*y2 * l3 - y3; yBd(4) = 2.0*p1*y1 * m1 + l1 * 2.0*p1*s1 - s1; yBd(5) = m2 + p2*p2*y3 * m3 + l3 * (2.0*p2*y3 + p2*p2*s3) - s2; yBd(6) = m1 + p2*p2*y2 * m3 + l3 * (2.0*p2*y3 + p2*p2*s2) - s3; flag = 0; new_data = []; return % =========================================================================== function [qBd, flag, new_data] = rhsQB1fn(t, y, yS, yB, data) % Backward problem quadrature integrand function for 1st Hessian column p1 = data.p(1); p2 = data.p(2); y1 = y(1); y2 = y(2); y3 = y(3); s1 = yS(1,1); s2 = yS(2,1); s3 = yS(3,1); l1 = yB(1); l2 = yB(2); l3 = yB(3); m1 = yB(4); m2 = yB(5); m3 = yB(6); qBd(1) = -y1*y1 * l1; qBd(2) = -2.0*p2*y2*y3 * l3; qBd(3) = -y1*y1 * m1 - l1 * 2.0*y1*s1; qBd(4) = -2.0*p2*y2*y3 * m3 - l3 * 2.0*(p2*y3*s2 + p2*y2*s3); flag = 0; new_data = []; return % =========================================================================== function [qBd, flag, new_data] = rhsQB2fn(t, y, yS, yB, data) % Backward problem quadrature integrand function for 2nd Hessian column p1 = data.p(1); p2 = data.p(2); y1 = y(1); y2 = y(2); y3 = y(3); s1 = yS(1,2); s2 = yS(2,2); s3 = yS(3,2); l1 = yB(1); l2 = yB(2); l3 = yB(3); m1 = yB(4); m2 = yB(5); m3 = yB(6); qBd(1) = -y1*y1 * l1; qBd(2) = -2.0*p2*y2*y3 * l3; qBd(3) = -y1*y1 * m1 - l1 * 2.0*y1*s1; qBd(4) = -2.0*p2*y2*y3 * m3 - l3 * 2.0*(p2*y3*s2 + p2*y2*s3 + y2*y3); flag = 0; new_data = []; returnsundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsOzone_FSA_dns.m0000600000175000017500000000532011741421121025724 0ustar sylvestresylvestrefunction mcvsOzone_FSA_dns() %mcvsOzone_FSA_dns - CVODES example problem (serial, dense) % ozone depletion chemical mechanism (3 species) % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ % ------------------- % User data structure % ------------------- data.p = [1.63e-16 ; 4.66e-16 ; 5.00e-11 ; 2.50e-4]; % --------------------- % CVODES initialization % --------------------- options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-4,... 'AbsTol',1.e-8,... 'LinearSolver','Dense'); t0 = 0.0; y0 = [1.0e6 ; 1.0e12 ; 3.7e16]; CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); % ------------------ % FSA initialization % ------------------ Ns = 4; yS0 = zeros(3,Ns); FSAoptions = CVodeSensSetOptions('method','Simultaneous',... 'ErrControl', true,... 'ParamField', 'p',... 'ParamScales', data.p); CVodeSensInit(Ns, [], yS0, FSAoptions); % ---------------- % Problem solution % ---------------- time(1,1) = t0; sol(1,:) = y0'; t = t0; tf = 0.25; it = 1; while t % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ data.mu = 100.0; t0 = 0.0; tf = 300.0; y0 = [2.0;0.0]; options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-8,... 'AbsTol',1e-6,... 'JacobianFn',@djacfn); mondata.mode = 'both'; mondata.skip = 20; options = CVodeSetOptions(options,'MonitorFn',@CVodeMonitor,'MonitorData',mondata); CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); ntout = 50; dt = (tf-t0)/ntout; tt = linspace(t0+dt,tf,ntout-1); [status,t,y] = CVode(tt,'Normal'); CVodeFree; figure; plot(t,y(1,:),'r',t,y(1,:),'.'); % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function mu = data.mu; yd = [ y(2) mu*(1-y(1)^2)*y(2)-y(1) ]; flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = djacfn(t, y, fy, data) % Dense Jacobian function (if using Newton) mu = data.mu; J = [ 0 1 -2*mu*y(1)*y(2)-1 mu*(1-y(1)^2) ]; flag = 0; new_data = [];sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsRoberts_FSA_dns.m0000600000175000017500000001156111741421121026256 0ustar sylvestresylvestrefunction mcvsRoberts_FSA_dns() %mcvsRoberts_FSA_dns - CVODES forward sensitivity example (serial, dense) % The following is a simple example problem, with the coding % needed for its solution by CVODES. The problem is from % chemical kinetics, and consists of the following three rate % equations: % dy1/dt = -.04*y1 + 1.e4*y2*y3 % dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 % dy3/dt = 3.e7*(y2)^2 % on the interval from t = 0.0 to t = 4.e10, with initial % conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. % While integrating the system, we also use the rootfinding % feature to find the points at which y1 = 1e-4 or at which % y3 = 0.01. This program solves the problem with the BDF method, % Newton iteration with the CVDENSE dense linear solver, and a % user-supplied Jacobian routine. It uses a scalar relative % tolerance and a vector absolute tolerance. % % Solution sensitivities with respect to the problem parameters % p1, p2, and p3 are computed using FSA. The sensitivity right-hand % side is given analytically through the user routine rhsSfn. % Tolerances for the sensitivity variables are estimated by % CVODES using the provided parameter scale information. The % sensitivity variables are included in the error test. % % Output is printed in decades from t = .4 to t = 4.e10. % Run statistics (optional outputs) are printed at the end. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ % ------------------- % User data structure % ------------------- data.p = [0.04; 1.0e4; 3.0e7]; % --------------------- % CVODES initialization % --------------------- options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-4,... 'AbsTol',[1.e-8; 1.e-14; 1.e-6],... 'JacobianFn',@djacfn); mondata = struct; mondata.mode = 'both'; mondata.sol = true; mondata.sensi = true; options = CVodeSetOptions(options,'MonitorFn',@CVodeMonitor,'MonitorData',mondata); t0 = 0.0; y0 = [1.0;0.0;0.0]; CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); % ------------------ % FSA initialization % ------------------ Ns = 2; yS0 = zeros(3,Ns); % Case 1: user-provided sensitivity RHS FSAoptions = CVodeSensSetOptions('method','Simultaneous',... 'ErrControl', true,... 'ParamScales', [0.04; 1.0e4]); CVodeSensInit(Ns, @rhsSfn, yS0, FSAoptions); % Case 2: internal DQ approximation %FSAoptions = CVodeSensSetOptions('method','Simultaneous',... % 'ErrControl', true,... % 'ParamField', 'p',... % 'ParamList', [1 2],... % 'ParamScales', [0.04 1.0e4]); %CVodeSensInit(Ns, [], yS0, FSAoptions); % ---------------- % Problem solution % ---------------- t1 = 0.4; tmult = 10.0; nout = 12; iout = 0; tout = t1; while 1, [status, t, y, yS] = CVode(tout,'Normal'); fprintf('t = %0.2e\n',t); fprintf('solution = [ %14.6e %14.6e %14.6e ]\n', y(1), y(2), y(3)); fprintf('sensitivity 1 = [ %14.6e %14.6e %14.6e ]\n', yS(1,1), yS(2,1), yS(3,1)); fprintf('sensitivity 2 = [ %14.6e %14.6e %14.6e ]\n\n', yS(1,2), yS(2,2), yS(3,2)); if(status ==0) iout = iout+1; tout = tout*tmult; end if iout==nout break; end end si = CVodeGetStats % ----------- % Free memory % ----------- CVodeFree; % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); yd(1) = -r1*y(1) + r2*y(2)*y(3); yd(3) = r3*y(2)*y(2); yd(2) = -yd(1) - yd(3); flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = djacfn(t, y, fy, data) % Dense Jacobian function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); J(1,1) = -r1; J(1,2) = r2*y(3); J(1,3) = r2*y(2); J(2,1) = r1; J(2,2) = -r2*y(3) - 2*r3*y(2); J(2,3) = -r2*y(2); J(3,2) = 2*r3*y(2); flag = 0; new_data = []; return % =========================================================================== function [ySd, flag, new_data] = rhsSfn(t,y,yd,yS,data) % Sensitivity right-hand side function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); % r1 yS1 = yS(:,1); yS1d = zeros(3,1); yS1d(1) = -r1*yS1(1) + r2*y(3)*yS1(2) + r2*y(2)*yS1(3); yS1d(3) = 2*r3*y(2)*yS1(2); yS1d(2) = -yS1d(1)-yS1d(3); yS1d(1) = yS1d(1) - y(1); yS1d(2) = yS1d(2) + y(1); % r2 yS2 = yS(:,2); yS2d = zeros(3,1); yS2d(1) = -r1*yS2(1) + r2*y(3)*yS2(2) + r2*y(2)*yS2(3); yS2d(3) = 2*r3*y(2)*yS2(2); yS2d(2) = -yS2d(1)-yS2d(3); yS2d(1) = yS2d(1) + y(2)*y(3); yS2d(2) = yS2d(2) - y(2)*y(3); % Return values ySd = [yS1d yS2d]; flag = 0; new_data = []; return sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsPleiades_non.m0000600000175000017500000000551411741421121025702 0ustar sylvestresylvestrefunction mcvsPleiades_non() %mcvsPleiades_non - CVODES example problem (serial, nonstiff) % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:48 $ neq = 28; t0 = 0.0; tout = 3.0; y0 = zeros(neq,1); y0(1) = 3.0; y0(2) = 3.0; y0(3) = -1.0; y0(4) = -3.0; y0(5) = 2.0; y0(6) = -2.0; y0(7) = 2.0; y0(8) = 3.0; y0(9) = -3.0; y0(10) = 2.0; y0(13) = -4.0; y0(14) = 4.0; y0(20) = 1.75; y0(21) = -1.5; y0(25) = -1.25; y0(26) = 1.0; options = CVodeSetOptions('RelTol', 1.0e-7,... 'AbsTol', 1.0e-7,... 'StopTime',tout,... 'MaxNumSteps',2000); CVodeInit(@rhsfn, 'Adams', 'Functional', t0, y0, options); % Loop in one-step mode t = t0; i = 0; while t < tout i = i+1; [status,t,y] = CVode(tout,'OneStep'); time(i) = t; xx(:,i) = y(1:7); yy(:,i) = y(8:14); end % Display solver statistics Stats = CVodeGetStats % Free solver memory CVodeFree; % Plot body trajectories colors = ['k','b','r','g','c','y','m']; figure; for i = 1:7 plot(xx(i,:),yy(i,:),colors(i)); hold on; end legend('Body 1','Body 2','Body 3','Body 4','Body 5','Body 6','Body 7'); title('Body Trajectories'); xlabel('x'); ylabel('y'); grid on; axis square; % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function for i = 1:7 sumx = 0.0; sumy = 0.0; for j = 1:7 mj = j; rij = (y(i)-y(j))^2 + (y(i+7)-y(j+7))^2; rij32 = rij^(3/2); if j ~= i sumx = sumx + mj*(y(j)-y(i))/rij32; sumy = sumy + mj*(y(j+7)-y(i+7))/rij32; end end yd(i+14) = sumx; yd(i+21) = sumy; end for i = 1:14 yd(i) = y(i+14); end flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = djacfn(t, y, fy, data) % Dense Jacobian function neq = 28; J = zeros(neq,neq); for i = 1:14 J(i,14+i)=1.0; end for i = 2:7 mi=i; for j = 1:i-1 mj = j; rij = (y(i)-y(j))^2+(y(i+7)-y(j+7))^2; rij32 = rij^(3/2); rij52 = rij^(5/2); fjh = (1.0-3.0*(y(j)-y(i))^2/rij)/rij32; J(i+14,j) = mj*fjh; J(j+14,i) = mi*fjh; fjh = (1.0-3.0*(y(j+7)-y(i+7))^2/rij)/rij32; J(i+21,j+7) = mj*fjh; J(j+21,i+7) = mi*fjh; fjh = -3.0*(y(j)-y(i))*(y(j+7)-y(i+7))/rij52; J(i+14,j+7) = mj*fjh; J(j+14,i+7) = mi*fjh; J(i+21,j) = mj*fjh; J(j+21,i) = mi*fjh; end end for i = 1:7 sumxx = 0.0; sumxy = 0.0; sumyy = 0.0; for j = 1:7 if j ~= i sumxx = sumxx + J(i+14,j); sumxy = sumxy + J(i+14,j+7); sumyy = sumyy + J(i+21,j+7); end end J(i+14,i) = -sumxx; J(i+14,i+7) = -sumxy; J(i+21,i) = -sumxy; J(i+21,i+7) = -sumyy; end flag = 0; new_data = []; returnsundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsAdvDiff_bnd.m0000600000175000017500000001164611741421121025433 0ustar sylvestresylvestrefunction mcvsAdvDiff_bnd() %mcvsAdvDiff_bnd - CVODES example problem (serial, band) % The following is a simple example problem with a banded Jacobian, % with the program for its solution by CVODES. % The problem is the semi-discrete form of the advection-diffusion % equation in 2-D: % du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 % on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time % interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions % are posed, and the initial condition is % u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). % The PDE is discretized on a uniform MX+2 by MY+2 grid with % central differencing, and with boundary values eliminated, % leaving an ODE system of size NEQ = MX*MY. % This program solves the problem with the BDF method, Newton % iteration with the CVBAND band linear solver, and a user-supplied % Jacobian routine. % It uses scalar relative and absolute tolerances. % Output is printed at t = .1, .2, ..., 1. % Run statistics (optional outputs) are printed at the end. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ xmax = 2.0; ymax = 1.0; mx = 10; my = 5; rtol = 0.0; atol = 1.0e-5; t0 = 0.0; dtout = 0.1; nout = 6; dx = xmax/(mx+1); dy = ymax/(my+1); % Problem data structure data.xmax = xmax; data.ymax = ymax; data.mx = mx; data.my = my; data.dx = dx; data.dy = dy; data.hdcoef = 1.0/dx^2; data.hacoef = 0.5/(2.0*dx); data.vdcoef = 1.0/dy^2; % Options for integration options = CVodeSetOptions('UserData',data,... 'RelTol',rtol,... 'AbsTol',atol,... 'LinearSolver','Band',... 'JacobianFn',@bjacfn,... 'UpperBwidth',my,... 'LowerBwidth',my); mondata.grph = false; options = CVodeSetOptions(options,... 'MonitorFn',@CVodeMonitor,... 'MonitorData',mondata); % Initial conditions for states t = t0; u = zeros(mx*my,1); for j = 1:my y = j * data.dy; for i = 1:mx x = i * data.dx; u(j + (i-1)*my) = x*(xmax-x)*y*(ymax-y)*exp(5.0*x*y); end end % Initialize integrator CVodeInit(@rhsfn, 'BDF', 'Newton', t, u, options); % Initialize quadratures (with default optional inputs) q = 0.0; CVodeQuadInit(@quadfn, q); ff=figure; hold on; box umax = norm(u,'inf'); uavg = quadfn(t,u,data); fprintf('At t = %f max.norm(u) = %e\n',t, umax); for i = 1:nout t_old = t; uavg_old = uavg; tout = t + dtout; [status,t,u, q] = CVode(tout, 'Normal'); if status ~= 0 return end uavg = quadfn(t,u,data); umax = norm(u,'inf'); fprintf('At t = %f max.norm(u) = %e\n',tout, umax); figure(ff); plot([t_old t],[uavg_old uavg]); plot([t0 tout], [q q]/(tout-t0), 'r-'); plot([tout tout], [0 q]/(tout-t0), 'r-'); end si= CVodeGetStats CVodeFree; return % =========================================================================== function [ud, flag, new_data] = rhsfn(t, u, data) % Right-hand side function mx = data.mx; my = data.my; hordc = data.hdcoef; horac = data.hacoef; verdc = data.vdcoef; for j = 1:my for i = 1:mx uij = u(j+(i-1)*my); if j == 1 udn = 0.0; else udn = u(j-1+(i-1)*my); end if j == my uup = 0.0; else uup = u(j+1+(i-1)*my); end if i == 1 ult = 0.0; else ult = u(j+(i-2)*my); end if i == mx urt = 0.0; else urt = u(j+i*my); end hdiff = hordc * (ult - 2*uij + urt); hadv = horac * (urt - ult); vdiff = verdc * (uup - 2*uij + udn); ud(j+(i-1)*my) = hdiff + hadv + vdiff; end end flag = 0; new_data = []; return % =========================================================================== function [qd, flag, new_data] = quadfn(t, u, data) % Quadrature integrand function mx = data.mx; my = data.my; dx = data.dx; dy = data.dy; xmax = data.xmax; ymax = data.ymax; qd1 = 0.0; for j = 1:my for i = 1:mx uij = u(j+(i-1)*my); if j == 1 | j == mx del_y = dy/2; else del_y = dy; end if i == 1 | i == mx del_x = dx/2; else del_x = dx; end qd1 = qd1 + uij * del_x*del_y; end end qd1 = qd1 / (xmax*ymax); qd(1) = qd1; flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = bjacfn(t, y, fy, data) % Band Jacobian function mx = data.mx; my = data.my; hordc = data.hdcoef; horac = data.hacoef; verdc = data.vdcoef; mu = my; ml = my; mband = mu + 1 + ml; for i = 1:mx for j = 1:my k = j + (i-1)*my; J(mu+1,k) = -2.0 * (verdc + hordc); if i ~= 1 J(1,k) = hordc + horac; end if i ~= mx J(mband,k) = hordc - horac; end if j ~= 1 J(mu,k) = verdc; end if j ~= my J(mu+2,k) = verdc; end end end flag = 0; new_data = []; sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsDiscSOL_dns.m0000600000175000017500000000274611741421121025412 0ustar sylvestresylvestrefunction mcvsDiscSOL_dns() %mcvsDiscSOL_dns - CVODES example with solution discontinuity % Trivial CVODES example to illustrate the use of % CVodeReInit to integrate over a discontinuity in % the solution: % y' = -y ; y(0) = 1 ; t = [0,1] % y' = -y ; y(1) = 1 ; t = [1,2] % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $ t0 = 0.0; t1 = 1.0; t2 = 2.0; % Initialize solver y = 1.0; options = CVodeSetOptions('RelTol',1.e-3,... 'AbsTol',1.e-4,... 'StopTime',t1,... 'LinearSolver','Dense'); CVodeInit(@rhsfn,'BDF','Newton',t0,y,options); % Integrate to the point of discontinuity t = t0; i = 1; tt(i) = t0; yy(i) = y; while t < t1 [status, t, y] = CVode(t1,'OneStep'); i = i+1; tt(i) = t; yy(i) = y; end % Add discontinuity and reinitialize solver y = 1.0; options = CVodeSetOptions(options,'StopTime',t2); CVodeReInit(t1,y,options); % Integrate from discontinuity to final time t = t1; i = i+1; tt(i) = t1; yy(i) = y; while t < t2 [status, t, y] = CVode(t2,'OneStep'); i = i+1; tt(i) = t; yy(i) = y; end % Plot solution figure plot(tt,yy) title('Discontinuity in solution'); xlabel('time'); ylabel('y'); % Free memory CVodeFree; return % =========================================================================== function [yd, flag] = rhsfn(t, y) % Right-hand side function yd(1) = -y(1); flag = 0; return sundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsRoberts_ASAi_dns.m0000600000175000017500000001530211741421121026417 0ustar sylvestresylvestrefunction mcvsRoberts_ASAi_dns() %mcvsRoberts_ASAi_dns - CVODES adjoint sensitivity example problem (serial, dense) % The following is a simple example problem, with the coding % needed for its solution by CVODES. The problem is from % chemical kinetics, and consists of the following three rate % equations: % dy1/dt = -p1*y1 + p2*y2*y3 % dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2 % dy3/dt = p3*(y2)^2 % on the interval from t = 0.0 to t = 4.e10, with initial % conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. % % This program solves the problem with the BDF method, % Newton iteration with the CVDENSE dense linear solver, and a % user-supplied Jacobian routine. It uses a scalar relative % tolerance and a vector absolute tolerance. % % The gradient with respect to the problem parameters p1, p2, % and p3 of the following quantity: % G = int_t0^t1 y3(t) dt % is computed using ASA. % % Writing the original ODE as: % dy/dt = f(y,p) % y(t0) = y0(p) % then the gradient with respect to the parameters p of % G(p) = int_t0^t1 g(y,p) dt % is obtained as: % dG/dp = int_t0^t1 (g_p + lambda^T f_p ) dt + lambda^T(t0)*y0_p % = -xi^T(t0) + lambda^T(t0)*y0_p % where lambda and xi are solutions of: % d(lambda)/dt = - (f_y)^T * lambda - (g_y)^T % lambda(t1) = 0 % and % d(xi)/dt = (g_p)^T + (f_p)^T * lambda % xi(t1) = 0 % % During the forward integration, CVODES also evaluates G as % G = q(t1) % where % dq/dt = g(t,y,p) % q(t0) = 0 % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2009/04/26 23:26:45 $ % ---------------------------------------- % User data structure % ---------------------------------------- data.p = [0.04; 1.0e4; 3.0e7]; % ---------------------------------------- % Forward CVODES options % ---------------------------------------- options = CVodeSetOptions('UserData',data,... 'RelTol',1.e-6,... 'AbsTol',[1.e-8; 1.e-14; 1.e-6],... 'LinearSolver','Dense',... 'JacobianFn',@djacfn); mondata = struct; mondata.sol = true; mondata.mode = 'both'; options = CVodeSetOptions(options,... 'MonitorFn',@CVodeMonitor,... 'MonitorData',mondata); t0 = 0.0; y0 = [1.0;0.0;0.0]; CVodeInit(@rhsfn, 'BDF', 'Newton', t0, y0, options); optionsQ = CVodeQuadSetOptions('ErrControl',true,... 'RelTol',1.e-6,'AbsTol',1.e-6); q0 = 0.0; CVodeQuadInit(@quadfn, q0, optionsQ); % ---------------------------------------- % Initialize ASA % ---------------------------------------- CVodeAdjInit(150, 'Hermite'); % ---------------------------------------- % Forward integration % ---------------------------------------- fprintf('Forward integration '); tout = 4.e7; [status,t,y,q] = CVode(tout,'Normal'); s = CVodeGetStats; fprintf('(%d steps)\n',s.nst); fprintf('G = %12.4e\n',q); fprintf('\nCheck point info\n'); ck = CVodeGet('CheckPointsInfo'); fprintf([' t0 t1 nstep order step size\n']); for i = 1:length(ck) fprintf('%8.3e %8.3e %4d %1d %10.5e\n',... ck(i).t0, ck(i).t1, ck(i).nstep, ck(i).order, ck(i).step); end fprintf('\n'); % ---------------------------------------- % Backward CVODES options % ---------------------------------------- optionsB = CVodeSetOptions('UserData',data,... 'RelTol',1.e-6,... 'AbsTol',1.e-8,... 'LinearSolver','Dense',... 'JacobianFn',@djacBfn); mondataB = struct; mondataB.mode = 'both'; optionsB = CVodeSetOptions(optionsB,... 'MonitorFn','CVodeMonitorB',... 'MonitorData', mondataB); tB1 = 4.e7; yB1 = [0.0;0.0;0.0]; idxB = CVodeInitB(@rhsBfn, 'BDF', 'Newton', tB1, yB1, optionsB); optionsQB = CVodeQuadSetOptions('ErrControl',true,... 'RelTol',1.e-6,'AbsTol',1.e-3); qB1 = [0.0;0.0;0.0]; CVodeQuadInitB(idxB, @quadBfn, qB1, optionsQB); % ---------------------------------------- % Backward integration % ---------------------------------------- fprintf('Backward integration '); [status,t,yB,qB] = CVodeB(t0,'Normal'); sB=CVodeGetStatsB(idxB); fprintf('(%d steps)\n',sB.nst); fprintf('tB1: %12.4e\n',tB1); fprintf('dG/dp: %12.4e %12.4e %12.4e\n',... -qB(1)+yB(1), -qB(2)+yB(2), -qB(3)+yB(3)); fprintf('lambda(t0): %12.4e %12.4e %12.4e\n',... yB(1),yB(2),yB(3)); % ---------------------------------------- % Free memory % ---------------------------------------- CVodeFree; % =========================================================================== function [yd, flag, new_data] = rhsfn(t, y, data) % Right-hand side function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); yd(1) = -r1*y(1) + r2*y(2)*y(3); yd(3) = r3*y(2)*y(2); yd(2) = -yd(1) - yd(3); flag = 0; new_data = []; return % =========================================================================== function [qd, flag, new_data] = quadfn(t, y, data) % Forward quadrature integrand function qd = y(3); flag = 0; new_data = []; return % =========================================================================== function [J, flag, new_data] = djacfn(t, y, fy, data) % Dense Jacobian function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); J(1,1) = -r1; J(1,2) = r2*y(3); J(1,3) = r2*y(2); J(2,1) = r1; J(2,2) = -r2*y(3) - 2*r3*y(2); J(2,3) = -r2*y(2); J(3,2) = 2*r3*y(2); flag = 0; new_data = []; return % =========================================================================== function [yBd, flag, new_data] = rhsBfn(t, y, yB, data) % Backward problem right-hand side function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); y1 = y(1); y2 = y(2); y3 = y(3); l1 = yB(1); l2 = yB(2); l3 = yB(3); l21 = l2-l1; l32 = l3-l2; y23 = y2*y3; yBd(1) = - r1*l21; yBd(2) = r2*y3*l21 - 2.0*r3*y2*l32; yBd(3) = r2*y2*l21 - 1.0; flag = 0; new_data = []; return % =========================================================================== function [qBd, flag, new_data] = quadBfn(t, y, yB, data) % Backward problem quadrature integrand function r1 = data.p(1); r2 = data.p(2); r3 = data.p(3); y1 = y(1); y2 = y(2); y3 = y(3); l1 = yB(1); l2 = yB(2); l3 = yB(3); l21 = l2-l1; l32 = l3-l2; y23 = y2*y3; qBd(1) = y1*l21; qBd(2) = -y23*l21; qBd(3) = l32*y2^2; flag = 0; new_data = []; return % =========================================================================== function [JB, flag, new_data] = djacBfn(t, y, yB, fyB, data) % Backward problem Jacobian function J = djacfn(t,y,[],data); JB = -J'; flag = 0; new_data = []; returnsundials-2.5.0/sundialsTB/cvodes/examples_ser/mcvsDiurnal_kry.m0000600000175000017500000001703711741421121025570 0ustar sylvestresylvestrefunction [x,y,u0_2, u_2] = mcvsDiurnal_kry %mcvsDiurnal_kry - CVODES example problem (serial, Spgmr) % An ODE system is generated from the following 2-species diurnal % kinetics advection-diffusion PDE system in 2 space dimensions: % % dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) % + Ri(c1,c2,t) for i = 1,2, where % R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , % R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , % Kv(y) = Kv0*exp(y/5) , % Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) % vary diurnally. The problem is posed on the square % 0 <= x <= 20, 30 <= y <= 50 (all in km), % with homogeneous Neumann boundary conditions, and for time t in % 0 <= t <= 86400 sec (1 day). % The PDE system is treated by central differences on a uniform % 10 x 10 mesh, with simple polynomial initial profiles. % The problem is solved with CVODES, with the BDF/GMRES % method (i.e. using the CVSPGMR linear solver) and the % block-diagonal part of the Newton matrix as a left % preconditioner. A copy of the block-diagonal part of the % Jacobian is saved and conditionally reused within the Precond % routine. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/10/26 16:30:47 $ %------------------------ % SET USER DATA STRUCTURE %------------------------ ns = 2; mx = 50; my = 20; xmin = 0.0; xmax = 20.0; xmid = 10.0; ymin = 30.0; ymax = 50.0; ymid = 40.0; dx = (xmax-xmin)/(mx-1); dy = (ymax-ymin)/(my-1); kh = 4.0e-6; vel = 0.001; kv0 = 1.0e-8; halfday = 4.32e4; c1s = 1.0e6; c2s = 1.0e12; data.ns = ns; %% Problem constants data.mx = mx; data.xmin = xmin; data.xmax = xmax; data.xmid = xmid; data.dx = dx; data.my = my; data.ymin = ymin; data.ymax = ymax; data.ymid = ymid; data.dy = dy; data.q1 = 1.63e-16; data.q2 = 4.66e-16; data.c3 = 3.7e16; data.a3 = 22.62; data.a4 = 7.601; data.om = pi/halfday; data.hdco = kh/dx^2; data.haco = vel/(2*dx); data.vdco = kv0/dy^2; %% Workspace data.P = []; %------------------------ % SET INITIAL PROFILE %------------------------ t0 = 0.0; for jy = 1:my y(jy) = ymin + (jy - 1) * dy; end for jx = 1:mx x(jx) = xmin + (jx - 1) * dx; end for jy = 1:my cy = (0.1 * (y(jy) - ymid))^2; cy = 1.0 - cy + 0.5 * cy^2; for jx = 1:mx cx = (0.1 * (x(jx) - xmid))^2; cx = 1.0 - cx + 0.5 * cx^2; u0(1,jx,jy) = c1s * cx * cy; u0(2,jx,jy) = c2s * cx * cy; end end u0_2 = squeeze(u0(2,:,:)); u0 = reshape(u0,2*mx*my,1); %------------------------ % SET CVODES OPTIONS %------------------------ % Tolerances rtol = 1.0e-5; atol = 1.0e-3; options = CVodeSetOptions('UserData',data,... 'RelTol',rtol, 'AbsTol',atol,... 'LinearSolver','GMRES',... 'PrecType','Left',... 'PrecSetupFn',@psetfn,... 'PrecSolveFn',@psolfn); %mondata = struct; %options = CVodeSetOptions(options,'MonitorFn',@CVodeMonitor,'MonitorData',mondata); CVodeInit(@rhsfn, 'BDF', 'Newton', t0, u0, options); %------------------------ % SOLVE PROBLEM %------------------------ twohr = 7200.0; tout = twohr; nout = 12; for i = 1:nout [status,t,u] = CVode(tout,'Normal'); si = CVodeGetStats; u = reshape(u,2,mx,my); fprintf('status = %d t = %.2e nst = %d q = %d h = %.2e\n',... status, t, si.nst, si.qlast, si.hlast); fprintf('c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n',... u(1,1,1), u(1,5,5), u(1,10,10)); fprintf('c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n',... u(2,1,1), u(2,5,5), u(2,10,10)); tout = tout + twohr; end u_2 = squeeze(u(2,:,:)); si = CVodeGetStats %------------------------ % FREE MEMORY %------------------------ CVodeFree; %------------------------ % PLOT RESULTS %------------------------ figure; hsurf0 = surf(y,x,u0_2); set(hsurf0,'Edgecolor','flat','EdgeAlpha',0.6); set(hsurf0,'FaceAlpha',0); hold on hsurf = surf(y,x,u_2); set(hsurf,'FaceColor','interp', 'EdgeColor','none'); title('Initial and final values for species 2'); xlabel('y'); ylabel('x'); colorbar box on return % =========================================================================== function [ud, flag, new_data] = rhsfn(t, u, data) % Right-hand side function mx = data.mx; xmin = data.xmin; dx = data.dx; my = data.my; ymin = data.ymin; dy = data.dy; om = data.om; q1 = data.q1; q2 = data.q2; c3 = data.c3; a3 = data.a3; a4 = data.a4; hdco = data.hdco; haco = data.haco; vdco = data.vdco; s = sin(om*t); if s > 0.0 q3 = exp(-a3/s); q4 = exp(-a4/s); else q3 = 0.0; q4 = 0.0; end u = reshape(u, 2,mx*my); for jy = 1:my ydn = ymin + (jy - 1.5)*dy; yup = ydn + dy; cydn = vdco * exp(0.2*ydn); cyup = vdco * exp(0.2*yup); i = (jy-1)*mx; idn = -mx; if jy == 1 idn = mx; end iup = mx; if jy == my iup = -mx; end for jx = 1:mx ii = i + jx; c1 = u(1,ii); c2 = u(2,ii); % kinetic rate terms qq1 = q1 * c1 * c3; qq2 = q2 * c1 * c2; qq3 = q3 * c3; qq4 = q4 *c2; rkin1 = -qq1 - qq2 + 2.0*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; % vertical diffusion c1dn = u(1,ii+idn); c2dn = u(2,ii+idn); c1up = u(1,ii+iup); c2up = u(2,ii+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); % horizontal diffusion and advection ileft = -1; if jx == 1 ileft = 1; end iright = 1; if jx == mx iright = -1; end c1lt = u(1,ii+ileft); c2lt = u(2,ii+ileft); c1rt = u(1,ii+iright); c2rt = u(2,ii+iright); hord1 = hdco * (c1rt-2.0*c1+c1lt); hord2 = hdco * (c2rt-2.0*c2+c2lt); horad1 = haco * (c1rt-c1lt); horad2 = haco * (c2rt-c2lt); % load into ud ud(1,ii) = vertd1 + hord1 + horad1 + rkin1; ud(2,ii) = vertd2 + hord2 + horad2 + rkin2; end end ud = reshape(ud,2*mx*my,1); flag = 0; new_data = []; new_data = data; return % =========================================================================== function [jcur, flag, data] = psetfn(t,u,fu,jok,gm,data) % Preconditioner setup function persistent Jbd mx = data.mx; my = data.my; if jok % Copy Jbd to P P = Jbd; jcur = false; else % Generate Jbd from scratch and copy to P xmin = data.xmin; dx = data.dx; ymin = data.ymin; dy = data.dy; om = data.om; q1 = data.q1; q2 = data.q2; c3 = data.c3; a3 = data.a3; a4 = data.a4; hdco = data.hdco; haco = data.haco; vdco = data.vdco; s = sin(om*t); if s > 0.0 q4 = exp(-a4/s); else q4 = 0.0; end u = reshape(u,2,mx*my); for jy = 1:my ydn = ymin + (jy - 1.5)*dy; yup = ydn + dy; cydn = vdco * exp(0.2*ydn); cyup = vdco * exp(0.2*yup); diag = -(cydn + cyup + 2.0*hdco); i = (jy-1)*mx; for jx = 1:mx ii = i + jx; c1 = u(1,ii); c2 = u(2,ii); Jbd(1,1,ii) = (-q1*c3 - q2*c2) + diag; Jbd(1,2,ii) = -q2*c1 + q4; Jbd(2,1,ii) = q1*c3 - q2*c2; Jbd(2,2,ii) = (-q2*c1 - q4) + diag; end end P = Jbd; jcur = true; end % Scale by -gamma and add identity P = - gm*P; for i = 1:mx*my P(:,:,i) = eye(2) + P(:,:,i); end flag = 0; data.P = P; return % =========================================================================== function [z, flag, new_data] = psolfn(t,y,fy,r,data) % Preconditioner solve function P = data.P; mx = data.mx; my = data.my; r = reshape(r,2,mx*my); for i = 1:mx*my z(:,i) = P(:,:,i)^(-1)*r(:,i); end z = reshape(z,2*mx*my,1); flag = 0; new_data = []; returnsundials-2.5.0/sundialsTB/cvodes/CVodeSensReInit.m0000600000175000017500000000200511741421121022656 0ustar sylvestresylvestrefunction status = CVodeSensReInit(yS0, options) %CVodeSensReInit reinitializes CVODES's FSA-related memory % assuming it has already been allocated in prior calls to CVodeInit % and CVodeSensInit. % The number of sensitivities Ns is assumed to be unchanged since the % previous call to CVodeSensInit. % % Usage: CVodeSensReInit ( YS0 [, OPTIONS ] ) % % YS0 Initial conditions for sensitivity variables. % YS0 must be a matrix with N rows and Ns columns, where N is the problem % dimension and Ns the number of sensitivity systems. % OPTIONS is an (optional) set of FSA options, created with % the CVodeSensSetOptions function. % % See also: CVodeSensSetOptions, CVodeReInit, CVodeSensInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:18 $ mode = 13; if nargin < 1 error('Too few input arguments'); end if nargin < 2 options = []; end status = cvm(mode, yS0, options); sundials-2.5.0/sundialsTB/cvodes/CVodeQuadInitB.m0000600000175000017500000000167211741421121022464 0ustar sylvestresylvestrefunction status = CVodeQuadInitB(idxB, fctQB, yQB0, optionsB) %CVodeQuadInitB allocates and initializes memory for backward quadrature integration. % % Usage: CVodeQuadInitB ( IDXB, QBFUN, YQB0 [, OPTIONS ] ) % % IDXB is the index of the backward problem, returned by % CVodeInitB. % QBFUN is a function defining the righ-hand sides of the % backward ODEs yQB' = fQB(t,y,yB). % YQB0 is the final conditions vector yQB(tB0). % OPTIONS is an (optional) set of QUAD options, created with % the CVodeSetQuadOptions function. % % See also: CVodeInitB, CVodeSetQuadOptions, CVQuadRhsFnB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 6; if nargin < 3 error('Too few input arguments'); end if nargin < 4 optionsB = []; end idxB = idxB-1; status = cvm(mode, idxB, fctQB, yQB0, optionsB); sundials-2.5.0/sundialsTB/cvodes/CVodeQuadInit.m0000600000175000017500000000143211741421121022354 0ustar sylvestresylvestrefunction status = CVodeQuadInit(fctQ, yQ0, options) %CVodeQuadInit allocates and initializes memory for quadrature integration. % % Usage: CVodeQuadInit ( QFUN, YQ0 [, OPTIONS ] ) % % QFUN is a function defining the righ-hand sides of the quadrature % ODEs yQ' = fQ(t,y). % YQ0 is the initial conditions vector yQ(t0). % OPTIONS is an (optional) set of QUAD options, created with % the CVodeSetQuadOptions function. % % See also: CVodeSetQuadOptions, CVQuadRhsFn % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 2; if nargin < 2 error('Too few input arguments'); end if nargin < 3 options = []; end status = cvm(mode, fctQ, yQ0, options); sundials-2.5.0/sundialsTB/cvodes/CVodeB.m0000600000175000017500000000375511741421121021031 0ustar sylvestresylvestrefunction [varargout] = CVodeB(tout,itask) %CVodeB integrates all backwards ODEs currently defined. % % Usage: [STATUS, T, YB] = CVodeB ( TOUT, ITASK ) % [STATUS, T, YB, YQB] = CVodeB ( TOUT, ITASK ) % % If ITASK is 'Normal', then the solver integrates from its current internal % T value to a point at or beyond TOUT, then interpolates to T = TOUT and returns % YB(TOUT). If ITASK is 'OneStep', then the solver takes one internal time step % and returns in YB the solution at the new internal time. In this case, TOUT % is used only during the first call to CVodeB to determine the direction of % integration and the rough scale of the problem. In either case, the time % reached by the solver is returned in T. % % If quadratures were computed (see CVodeQuadInitB), CVodeB will return their % values at T in the vector YQB. % % In ITASK =' Normal' mode, to obtain solutions at specific times T0,T1,...,TFINAL % (all increasing or all decreasing) use TOUT = [T0 T1 ... TFINAL]. In this case % the output arguments YB and YQB are matrices, each column representing the solution % vector at the corresponding time returned in the vector T. % % If more than one backward problem was defined, the return arguments are cell % arrays, with T{IDXB}, YB{IDXB}, and YQB{IDXB} corresponding to the backward % problem with index IDXB (as returned by CVodeInitB). % % On return, STATUS is one of the following: % 0: successful CVodeB return. % 1: CVodeB succeded and return at a tstop value (internally set). % -1: an error occurred (see printed message). % % See also CVodeSetOptions, CVodeGetStatsB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.7 $Date: 2011/06/01 22:30:55 $ mode = 21; if nargin ~= 2 error('Wrong number of input arguments'); end if nargout < 3 || nargout > 4 error('Wrong number of output arguments'); end varargout = cell (nargout, 1); [varargout{:}] = cvm(mode,tout,itask); sundials-2.5.0/sundialsTB/cvodes/CVodeQuadSetOptions.m0000600000175000017500000000505311741421121023563 0ustar sylvestresylvestrefunction options = CVodeQuadSetOptions(varargin) %CVodeQuadSetOptions creates an options structure for quadrature integration with CVODES. % % Usage: OPTIONS = CVodeQuadSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) % OPTIONS = CVodeQuadSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) % % OPTIONS = CVodeQuadSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates % a CVODES options structure OPTIONS in which the named properties have % the specified values. Any unspecified properties have default values. % It is sufficient to type only the leading characters that uniquely % identify the property. Case is ignored for property names. % % OPTIONS = CVodeQuadSetOptions(OLDOPTIONS,'NAME1',VALUE1,...) alters an % existing options structure OLDOPTIONS. % % CVodeQuadSetOptions with no input arguments displays all property names % and their possible values. % %CVodeQuadSetOptions properties %(See also the CVODES User Guide) % %ErrControl - Error control strategy for quadrature variables [ {false} | true ] % Specifies whether quadrature variables are included in the error test. %RelTol - Relative tolerance for quadrature variables [ scalar {1e-4} ] % Specifies the relative tolerance for quadrature variables. This parameter is % used only if ErrControl = true. %AbsTol - Absolute tolerance for quadrature variables [ scalar or vector {1e-6} ] % Specifies the absolute tolerance for quadrature variables. This parameter is % used only if ErrControl = true. % %SensDependent - Backward problem depending on sensitivities [ {false} | true ] % Specifies whether the backward problem quadrature right-hand side depends % on forward sensitivites. If TRUE, the right-hand side function provided for % this backward problem must have the appropriate type (see CVQuadRhsFnB). % % % See also % CVodeQuadInit, CVodeQuadReInit. % CVodeQuadInitB, CVodeQuadReInitB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/08/21 17:42:38 $ % If called without input and output arguments, print out the possible keywords if (nargin == 0) && (nargout == 0) fprintf(' ErrControl: [ {false} | true ]\n'); fprintf(' RelTol: [ positive scalar {1e-4} ]\n'); fprintf(' AbsTol: [ positive scalar or vector {1e-6} ]\n'); fprintf('\n'); fprintf(' SensDependent: [ {false} | true ]\n'); fprintf('\n'); return; end KeyNames = { 'ErrControl' 'RelTol' 'AbsTol' 'SensDependent' }; options = cvm_options(KeyNames,varargin{:}); sundials-2.5.0/sundialsTB/cvodes/CVodeSetB.m0000600000175000017500000000266711741421121021506 0ustar sylvestresylvestrefunction status = CVodeSetB(idxB, varargin) %CVodeSetB changes optional input values during the integration. % % Usage: CVodeSetB( IDXB, 'NAME1',VALUE1,'NAME2',VALUE2,... ) % % CVodeSetB can be used to change some of the optional inputs for % the backward problem identified by IDXB during the backward % integration, i.e., without need for a solver reinitialization. % The property names accepted by CVodeSet are a subset of those valid % for CVodeSetOptions. Any unspecified properties are left unchanged. % % CVodeSetB with no input arguments displays all property names. % %CVodeSetB properties %(See also the CVODES User Guide) % %UserData - problem data passed unmodified to all user functions. % Set VALUE to be the new user data. %RelTol - Relative tolerance % Set VALUE to the new relative tolerance %AbsTol - absolute tolerance % Set VALUE to be either the new scalar absolute tolerance or % a vector of absolute tolerances, one for each solution component. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ if (nargin == 0) fprintf(' UserData\n'); fprintf('\n'); fprintf(' RelTol\n'); fprintf(' AbsTol\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'RelTol' 'AbsTol' }; options = cvm_options(KeyNames,varargin{:}); mode = 34; status = cvm(mode, idxB, options); sundials-2.5.0/sundialsTB/cvodes/CVodeSensToggleOff.m0000600000175000017500000000076411741421121023352 0ustar sylvestresylvestrefunction status = CVodeSensToggleOff() % CVodeSensToggleOff deactivates sensitivity calculations. % It does NOT deallocate sensitivity-related memory so that % sensitivity computations can be later toggled ON (through % CVodeSensReInit). % % Usage: CVodeSensToggleOff % % See also: CVodeSensInit, CVodeSensReInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 18; status = cvm(mode); sundials-2.5.0/sundialsTB/cvodes/CVode.m0000600000175000017500000000436711741421121020727 0ustar sylvestresylvestrefunction [varargout] = CVode(tout, itask) %CVode integrates the ODE. % % Usage: [STATUS, T, Y] = CVode ( TOUT, ITASK ) % [STATUS, T, Y, YS] = CVode ( TOUT, ITASK ) % [STATUS, T, Y, YQ] = CVode (TOUT, ITASK ) % [STATUS, T, Y, YQ, YS] = CVode ( TOUT, ITASK ) % % If ITASK is 'Normal', then the solver integrates from its current internal % T value to a point at or beyond TOUT, then interpolates to T = TOUT and returns % Y(TOUT). If ITASK is 'OneStep', then the solver takes one internal time step % and returns in Y the solution at the new internal time. In this case, TOUT % is used only during the first call to CVode to determine the direction of % integration and the rough scale of the problem. In either case, the time % reached by the solver is returned in T. % % If quadratures were computed (see CVodeQuadInit), CVode will return their % values at T in the vector YQ. % % If sensitivity calculations were enabled (see CVodeSensInit), CVode will % return their values at T in the matrix YS. Each row in the matrix YS % represents the sensitivity vector with respect to one of the problem parameters. % % In ITASK =' Normal' mode, to obtain solutions at specific times T0,T1,...,TFINAL % (all increasing or all decreasing) use TOUT = [T0 T1 ... TFINAL]. In this case % the output arguments Y and YQ are matrices, each column representing the solution % vector at the corresponding time returned in the vector T. If computed, the % sensitivities are eturned in the 3-dimensional array YS, with YS(:,:,I) representing % the sensitivity vectors at the time T(I). % % On return, STATUS is one of the following: % 0: successful CVode return. % 1: CVode succeded and returned at tstop. % 2: CVode succeeded and found one or more roots. % -1: an error occurred (see printed message). % % See also CVodeSetOptions, CVodeGetStats % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.7 $Date: 2011/06/01 22:06:42 $ mode = 20; if nargin ~= 2 error('Wrong number of input arguments'); end if nargout < 3 || nargout > 5 error('Wrong number of output arguments'); end varargout = cell (nargout, 1); [varargout{:}] = cvm(mode,tout,itask); sundials-2.5.0/sundialsTB/cvodes/CVodeSet.m0000600000175000017500000000303111741421121021366 0ustar sylvestresylvestrefunction status = CVodeSet(varargin) %CVodeSet changes optional input values during the integration. % % Usage: CVodeSet('NAME1',VALUE1,'NAME2',VALUE2,...) % % CVodeSet can be used to change some of the optional inputs during % the integration, i.e., without need for a solver reinitialization. % The property names accepted by CVodeSet are a subset of those valid % for CVodeSetOptions. Any unspecified properties are left unchanged. % % CVodeSet with no input arguments displays all property names. % %CVodeSet properties %(See also the CVODES User Guide) % %UserData - problem data passed unmodified to all user functions. % Set VALUE to be the new user data. %RelTol - Relative tolerance % Set VALUE to the new relative tolerance %AbsTol - absolute tolerance % Set VALUE to be either the new scalar absolute tolerance or % a vector of absolute tolerances, one for each solution component. %StopTime - Stopping time % Set VALUE to be a new value for the independent variable past which % the solution is not to proceed. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ if (nargin == 0) fprintf(' UserData\n'); fprintf('\n'); fprintf(' RelTol\n'); fprintf(' AbsTol\n'); fprintf(' StopTime\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'RelTol' 'AbsTol' 'StopTime' }; options = cvm_options(KeyNames,varargin{:}); mode = 33; status = cvm(mode, options); sundials-2.5.0/sundialsTB/cvodes/function_types/0000755000175000017500000000000011767174700022640 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/cvodes/function_types/CVSensRhsFn.m0000600000175000017500000000214711741421121025074 0ustar sylvestresylvestre%CVSensRhsFn - type for user provided sensitivity RHS function. % % The function ODESFUN must be defined as % FUNCTION [YSD, FLAG] = ODESFUN(T,Y,YD,YS) % and must return a matrix YSD corresponding to fS(t,y,yS). % If a user data structure DATA was specified in CVodeInit, then % ODESFUN must be defined as % FUNCTION [YSD, FLAG, NEW_DATA] = ODESFUN(T,Y,YD,YS,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix YSD, % the ODESFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function ODESFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeSetFSAOptions % % NOTE: ODESFUN is specified through the property FSARhsFn to % CVodeSetFSAOptions. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVBandJacFnB.m0000600000175000017500000000213011741421121025063 0ustar sylvestresylvestre%CVBandJacFnB - type for user provided banded Jacobian function for backward problems. % % The function BJACFUNB must be defined either as % FUNCTION [JB, FLAG] = BJACFUNB(T, Y, YB, FYB) % or as % FUNCTION [JB, FLAG, NEW_DATA] = BJACFUNB(T, Y, YB, FYB, DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the matrix JB, the % Jacobian of fB(t,y,yB), with respect to yB. The input argument % FYB contains the current value of f(t,y,yB). % % The function BJACFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeSetOptions % % See the CVODES user guide for more informaiton on the structure of % a banded Jacobian. % % NOTE: BJACFUNB is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'Band'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVGlocalFn.m0000600000175000017500000000245711741421121024714 0ustar sylvestresylvestre%CVGlocalFn - type for user provided RHS approximation function (BBDPre). % % The function GLOCFUN must be defined as % FUNCTION [GLOC, FLAG] = GLOCFUN(T,Y) % and must return a vector GLOC corresponding to an approximation to f(t,y) % which will be used in the BBDPRE preconditioner module. The case where % G is mathematically identical to F is allowed. % If a user data structure DATA was specified in CVodeInit, then % GLOCFUN must be defined as % FUNCTION [GLOC, FLAG, NEW_DATA] = GLOCFUN(T,Y,DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector G, % the GLOCFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function GLOCFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVGcommFn, CVodeSetOptions % % NOTE: GLOCFUN is specified through the GlocalFn property in CVodeSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVRhsFn.m0000600000175000017500000000172311741421121024242 0ustar sylvestresylvestre%CVRhsFn - type for user provided RHS function % % The function ODEFUN must be defined as % FUNCTION [YD, FLAG] = ODEFUN(T,Y) % and must return a vector YD corresponding to f(t,y). % If a user data structure DATA was specified in CVodeInit, then % ODEFUN must be defined as % FUNCTION [YD, FLAG, NEW_DATA] = ODEFUN(T,Y,DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector YD, % the ODEFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function ODEFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeInit % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVDenseJacFnB.m0000600000175000017500000000177011741421121025266 0ustar sylvestresylvestre%CVDenseJacFnB - type for user provided dense Jacobian function for backward problems. % % The function DJACFUNB must be defined either as % FUNCTION [JB, FLAG] = DJACFUNB(T, Y, YB, FYB) % or as % FUNCTION [JB, FLAG, NEW_DATA] = DJACFUNB(T, Y, YB, FYB, DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the matrix JB, the % Jacobian of fB(t,y,yB), with respect to yB. The input argument % FYB contains the current value of f(t,y,yB). % % The function DJACFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeSetOptions % % NOTE: DJACFUNB is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'Dense'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVQuadRhsFnB.m0000600000175000017500000000150111741421121025151 0ustar sylvestresylvestre%CVQuadRhsFnB - type for user provided quadrature RHS function for backward problems % % The function ODEQFUNB must be defined either as % FUNCTION [YQBD, FLAG] = ODEQFUNB(T,Y,YB) % or as % FUNCTION [YQBD, FLAG, NEW_DATA] = ODEQFUNB(T,Y,YB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the vector YQBD % corresponding to fQB(t,y,yB), the integrand for the integral to be % evaluated on the backward phase. % % The function ODEQFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeQuadInitB % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVRhsFnB.m0000600000175000017500000000133611741421121024344 0ustar sylvestresylvestre%CVRhsFnB - type for user provided RHS function for backward problems. % % The function ODEFUNB must be defined either as % FUNCTION [YBD, FLAG] = ODEFUNB(T,Y,YB) % or as % FUNCTION [YBD, FLAG, NEW_DATA] = ODEFUNB(T,Y,YB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the vector YBD % corresponding to fB(t,y,yB). % % The function ODEFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeInitB % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVDenseJacFn.m0000600000175000017500000000234111741421121025157 0ustar sylvestresylvestre%CVDenseJacFn - type for user provided dense Jacobian function. % % The function DJACFUN must be defined as % FUNCTION [J, FLAG] = DJACFUN(T, Y, FY) % and must return a matrix J corresponding to the Jacobian of f(t,y). % The input argument FY contains the current value of f(t,y). % If a user data structure DATA was specified in CVodeInit, then % DJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = DJACFUN(T, Y, FY, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J, % the DJACFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function DJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % See also CVodeSetOptions % % NOTE: DJACFUN is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'Dense'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVPrecSolveFnB.m0000600000175000017500000000207611741421121025514 0ustar sylvestresylvestre%CVPrecSolveFnB - type for user provided preconditioner solve function for backward problems. % % The user-supplied preconditioner solve function PSOLFN % is to solve a linear system P z = r in which the matrix P is % one of the preconditioner matrices P1 or P2, depending on the % type of preconditioning chosen. % % The function PSOLFUNB must be defined either as % FUNCTION [ZB, FLAG] = PSOLFUNB(T,Y,YB,FYB,RB) % or as % FUNCTION [ZB, FLAG, NEW_DATA] = PSOLFUNB(T,Y,YB,FYB,RB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the vector ZB and the % flag FLAG. % % See also CVPrecSetupFnB, CVodeSetOptions % % NOTE: PSOLFUNB is specified through the property PrecSolveFn to % CVodeSetOptions and is used only if the property LinearSolver was % set to 'GMRES', 'BiCGStab', or 'TFQMR' and if the property PrecType % is not 'None'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVBandJacFn.m0000600000175000017500000000251311741421121024766 0ustar sylvestresylvestre%CVBandJacFn - type for user provided banded Jacobian function. % % The function BJACFUN must be defined as % FUNCTION [J, FLAG] = BJACFUN(T, Y, FY) % and must return a matrix J corresponding to the banded Jacobian of f(t,y). % The input argument FY contains the current value of f(t,y). % If a user data structure DATA was specified in CVodeInit, then % BJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = BJACFUN(T, Y, FY, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J, % the BJACFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function BJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeSetOptions % % See the CVODES user guide for more informaiton on the structure of % a banded Jacobian. % % NOTE: BJACFUN is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'Band'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVJacTimesVecFnB.m0000600000175000017500000000177311741421121025752 0ustar sylvestresylvestre%CVJacTimesVecFnB - type for user provided Jacobian times vector function for backward problems. % % The function JTVFUNB must be defined either as % FUNCTION [JVB, FLAG] = JTVFUNB(T,Y,YB,FYB,VB) % or as % FUNCTION [JVB, FLAG, NEW_DATA] = JTVFUNB(T,Y,YB,FYB,VB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the vector JVB, the % product of the Jacobian of fB(t,y,yB) with respect to yB and a vector % vB. The input argument FYB contains the current value of f(t,y,yB). % % The function JTVFUNB must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also CVodeSetOptions % % NOTE: JTVFUNB is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVPrecSetupFnB.m0000600000175000017500000000507211741421121025523 0ustar sylvestresylvestre%CVPrecSetupFnB - type for user provided preconditioner setup function for backward problems. % % The user-supplied preconditioner setup function PSETFUN and % the user-supplied preconditioner solve function PSOLFUN % together must define left and right preconditoner matrices % P1 and P2 (either of which may be trivial), such that the % product P1*P2 is an approximation to the Newton matrix % M = I - gamma*J. Here J is the system Jacobian J = df/dy, % and gamma is a scalar proportional to the integration step % size h. The solution of systems P z = r, with P = P1 or P2, % is to be carried out by the PrecSolve function, and PSETFUN % is to do any necessary setup operations. % % The user-supplied preconditioner setup function PSETFUN % is to evaluate and preprocess any Jacobian-related data % needed by the preconditioner solve function PSOLFUN. % This might include forming a crude approximate Jacobian, % and performing an LU factorization on the resulting % approximation to M. This function will not be called in % advance of every call to PSOLFUN, but instead will be called % only as often as necessary to achieve convergence within the % Newton iteration. If the PSOLFUN function needs no % preparation, the PSETFUN function need not be provided. % % For greater efficiency, the PSETFUN function may save % Jacobian-related data and reuse it, rather than generating it % from scratch. In this case, it should use the input flag JOK % to decide whether to recompute the data, and set the output % flag JCUR accordingly. % % Each call to the PSETFUN function is preceded by a call to % ODEFUN with the same (t,y) arguments. Thus the PSETFUN % function can use any auxiliary data that is computed and % saved by the ODEFUN function and made accessible to PSETFUN. % % % The function PSETFUNB must be defined either as % FUNCTION [JCURB, FLAG] = PSETFUNB(T,Y,YB,FYB,JOK,GAMMAB) % or as % FUNCTION [JCURB, FLAG, NEW_DATA] = PSETFUNB(T,Y,YB,FYB,JOK,GAMMAB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the flags JCURB and FLAG. % % See also CVPrecSolveFnB, CVodeSetOptions % % NOTE: PSETFUNB is specified through the property PrecSetupFn to % CVodeSetOptions and is used only if the property LinearSolver was % set to 'GMRES', 'BiCGStab', or 'TFQMR' and if the property PrecType % is not 'None'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.3 $Date: 2012/03/20 21:08:32 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVPrecSetupFn.m0000600000175000017500000000700111741421121025413 0ustar sylvestresylvestre%CVPrecSetupFn - type for user provided preconditioner setup function. % % The user-supplied preconditioner setup function PSETFUN and % the user-supplied preconditioner solve function PSOLFUN % together must define left and right preconditoner matrices % P1 and P2 (either of which may be trivial), such that the % product P1*P2 is an approximation to the Newton matrix % M = I - gamma*J. Here J is the system Jacobian J = df/dy, % and gamma is a scalar proportional to the integration step % size h. The solution of systems P z = r, with P = P1 or P2, % is to be carried out by the PrecSolve function, and PSETFUN % is to do any necessary setup operations. % % The user-supplied preconditioner setup function PSETFUN % is to evaluate and preprocess any Jacobian-related data % needed by the preconditioner solve function PSOLFUN. % This might include forming a crude approximate Jacobian, % and performing an LU factorization on the resulting % approximation to M. This function will not be called in % advance of every call to PSOLFUN, but instead will be called % only as often as necessary to achieve convergence within the % Newton iteration. If the PSOLFUN function needs no % preparation, the PSETFUN function need not be provided. % % For greater efficiency, the PSETFUN function may save % Jacobian-related data and reuse it, rather than generating it % from scratch. In this case, it should use the input flag JOK % to decide whether to recompute the data, and set the output % flag JCUR accordingly. % % Each call to the PSETFUN function is preceded by a call to % ODEFUN with the same (t,y) arguments. Thus the PSETFUN % function can use any auxiliary data that is computed and % saved by the ODEFUN function and made accessible to PSETFUN. % % The function PSETFUN must be defined as % FUNCTION [JCUR, FLAG] = PSETFUN(T,Y,FY,JOK,GAMMA) % and must return a logical flag JCUR (true if Jacobian information % was recomputed and false if saved data was reused). If PSETFUN % was successful, it must return FLAG=0. For a recoverable error (in % which case the setup will be retried) it must set FLAG to a positive % integer value. If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the integration will be halted. % The input argument FY contains the current value of f(t,y). % If the input logical flag JOK is false, it means that % Jacobian-related data must be recomputed from scratch. If it is true, % it means that Jacobian data, if saved from the previous PSETFUN call % can be reused (with the current value of GAMMA). % % If a user data structure DATA was specified in CVodeInit, then % PSETFUN must be defined as % FUNCTION [JCUR, FLAG, NEW_DATA] = PSETFUN(T,Y,FY,JOK,GAMMA,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the flags JCUR % and FLAG, the PSETFUN function must also set NEW_DATA. Otherwise, it % should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead % to unnecessary copying). % % See also CVPrecSolveFn, CVodeSetOptions % % NOTE: PSETFUN is specified through the property PrecSetupFn to % CVodeSetOptions and is used only if the property LinearSolver was % set to 'GMRES', 'BiCGStab', or 'TFQMR' and if the property PrecType % is not 'None'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVRootFn.m0000600000175000017500000000210611741421121024425 0ustar sylvestresylvestre%CVRootFn - type for user provided root-finding function. % % The function ROOTFUN must be defined as % FUNCTION [G, FLAG] = ROOTFUN(T,Y) % and must return a vector G corresponding to g(t,y). % If a user data structure DATA was specified in CVodeInit, then % ROOTFUN must be defined as % FUNCTION [G, FLAG, NEW_DATA] = ROOTFUN(T,Y,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector G, % the ROOTFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function ROOTFUN must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also CVodeSetOptions % % NOTE: ROOTFUN is specified through the RootsFn property in % CVodeSetOptions and is used only if the property NumRoots is a % positive integer. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVQuadRhsFn.m0000600000175000017500000000204311741421121025051 0ustar sylvestresylvestre%CVQuadRhsFn - type for user provided quadrature RHS function. % % The function ODEQFUN must be defined as % FUNCTION [YQD, FLAG] = ODEQFUN(T,Y) % and must return a vector YQD corresponding to fQ(t,y), the integrand % for the integral to be evaluated. % If a user data structure DATA was specified in CVodeInit, then % ODEQFUN must be defined as % FUNCTION [YQD, FLAG, NEW_DATA] = ODEQFUN(T,Y,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector YQD, % the ODEQFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function ODEQFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVodeQuadInit % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVPrecSolveFn.m0000600000175000017500000000326711741421121025415 0ustar sylvestresylvestre%CVPrecSolveFn - type for user provided preconditioner solve function. % % The user-supplied preconditioner solve function PSOLFN % is to solve a linear system P z = r in which the matrix P is % one of the preconditioner matrices P1 or P2, depending on the % type of preconditioning chosen. % % The function PSOLFUN must be defined as % FUNCTION [Z, FLAG] = PSOLFUN(T,Y,FY,R) % and must return a vector Z containing the solution of Pz=r. % If PSOLFUN was successful, it must return FLAG=0. For a recoverable % error (in which case the step will be retried) it must set FLAG to a % positive value. If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the integration will be halted. % The input argument FY contains the current value of f(t,y). % % If a user data structure DATA was specified in CVodeInit, then % PSOLFUN must be defined as % FUNCTION [Z, FLAG, NEW_DATA] = PSOLFUN(T,Y,FY,R,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector Z and % the flag FLAG, the PSOLFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would % lead to unnecessary copying). % % See also CVPrecSetupFn, CVodeSetOptions % % NOTE: PSOLFUN is specified through the property PrecSolveFn to % CVodeSetOptions and is used only if the property LinearSolver was % set to 'GMRES', 'BiCGStab', or 'TFQMR' and if the property PrecType % is not 'None'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVGcommFn.m0000600000175000017500000000305111741421121024544 0ustar sylvestresylvestre%CVGcommFn - type for user provided communication function (BBDPre). % % The function GCOMFUN must be defined as % FUNCTION FLAG = GCOMFUN(T, Y) % and can be used to perform all interprocess communication necessary % to evaluate the approximate right-hand side function for the BBDPre % preconditioner module. % If a user data structure DATA was specified in CVodeInit, then % GCOMFUN must be defined as % FUNCTION [FLAG, NEW_DATA] = GCOMFUN(T, Y, DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then the GCOMFUN function must also % set NEW_DATA. Otherwise, it should set NEW_DATA=[] (do not set % NEW_DATA = DATA as it would lead to unnecessary copying). % % The function GCOMFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVGlocalFn, CVodeSetOptions % % NOTES: % GCOMFUN is specified through the GcommFn property in CVodeSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % % Each call to GCOMFUN is preceded by a call to the RHS function % ODEFUN with the same arguments T and Y. Thus GCOMFUN can omit % any communication done by ODEFUN if relevant to the evaluation % of G by GLOCFUN. If all necessary communication was done by ODEFUN, % GCOMFUN need not be provided. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVGcommFnB.m0000600000175000017500000000223711741421121024653 0ustar sylvestresylvestre%CVGcommFn - type for user provided communication function (BBDPre) for backward problems. % % The function GCOMFUNB must be defined either as % FUNCTION FLAG = GCOMFUNB(T, Y, YB) % or as % FUNCTION [FLAG, NEW_DATA] = GCOMFUNB(T, Y, YB, DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. % % The function GCOMFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVGlocalFnB, CVodeSetOptions % % NOTES: % GCOMFUNB is specified through the GcommFn property in CVodeSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % % Each call to GCOMFUNB is preceded by a call to the RHS function % ODEFUNB with the same arguments T, Y, and YB. Thus GCOMFUNB can % omit any communication done by ODEFUNB if relevant to the evaluation % of G by GLOCFUNB. If all necessary communication was done by ODEFUNB, % GCOMFUNB need not be provided. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVMonitorFnB.m0000600000175000017500000000325511741421121025241 0ustar sylvestresylvestre%CVMonitorFnB - type of user provided monitoring function for backward problems. % % The function MONFUNB must be defined as % FUNCTION [] = MONFUNB(CALL, IDXB, T, Y, YQ) % It is called after every internal CVodeB step and can be used to % monitor the progress of the solver. MONFUNB is called with CALL=0 % from CVodeInitB at which time it should initialize itself and it % is called with CALL=2 from CVodeFree. Otherwise, CALL=1. % % It receives as arguments the index of the backward problem (as % returned by CVodeInitB), the current time T, solution vector Y, % and, if it was computed, the quadrature vector YQ. If quadratures % were not computed for this backward problem, YQ is empty here. % % If additional data is needed inside MONFUNB, it must be defined % as % FUNCTION NEW_MONDATA = MONFUNB(CALL, IDXB, T, Y, YQ, MONDATA) % If the local modifications to the user data structure need to be % saved (e.g. for future calls to MONFUNB), then MONFUNB must set % NEW_MONDATA. Otherwise, it should set NEW_MONDATA=[] % (do not set NEW_MONDATA = DATA as it would lead to unnecessary copying). % % A sample monitoring function, CVodeMonitorB, is provided with CVODES. % % See also CVodeSetOptions, CVodeMonitorB % % NOTES: % % MONFUNB is specified through the MonitorFn property in CVodeSetOptions. % If this property is not set, or if it is empty, MONFUNB is not used. % MONDATA is specified through the MonitorData property in CVodeSetOptions. % % See CVodeMonitorB for an implementation example. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/05/11 18:51:33 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVJacTimesVecFn.m0000600000175000017500000000235411741421121025644 0ustar sylvestresylvestre%CVJacTimesVecFn - type for user provided Jacobian times vector function. % % The function JTVFUN must be defined as % FUNCTION [JV, FLAG] = JTVFUN(T,Y,FY,V) % and must return a vector JV corresponding to the product of the % Jacobian of f(t,y) with the vector v. % The input argument FY contains the current value of f(t,y). % If a user data structure DATA was specified in CVodeInit, then % JTVFUN must be defined as % FUNCTION [JV, FLAG, NEW_DATA] = JTVFUN(T,Y,FY,V,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector JV, % the JTVFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function JTVFUN must set FLAG=0 if successful, or FLAG~=0 if % a failure occurred. % % See also CVodeSetOptions % % NOTE: JTVFUN is specified through the property JacobianFn to % CVodeSetOptions and is used only if the property LinearSolver % was set to 'GMRES', 'BiCGStab', or 'TFQMR'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVMonitorFn.m0000600000175000017500000000314711741421121025137 0ustar sylvestresylvestre%CVMonitorFn - type for user provided monitoring function for forward problems. % % The function MONFUN must be defined as % FUNCTION [] = MONFUN(CALL, T, Y, YQ, YS) % It is called after every internal CVode step and can be used to % monitor the progress of the solver. MONFUN is called with CALL=0 % from CVodeInit at which time it should initialize itself and it % is called with CALL=2 from CVodeFree. Otherwise, CALL=1. % % It receives as arguments the current time T, solution vector Y, % and, if they were computed, quadrature vector YQ, and forward % sensitivity matrix YS. If YQ and/or YS were not computed they % are empty here. % % If additional data is needed inside MONFUN, it must be defined % as % FUNCTION NEW_MONDATA = MONFUN(CALL, T, Y, YQ, YS, MONDATA) % If the local modifications to the user data structure need to be % saved (e.g. for future calls to MONFUN), then MONFUN must set % NEW_MONDATA. Otherwise, it should set NEW_MONDATA=[] % (do not set NEW_MONDATA = DATA as it would lead to unnecessary copying). % % A sample monitoring function, CVodeMonitor, is provided with CVODES. % % See also CVodeSetOptions, CVodeMonitor % % NOTES: % % MONFUN is specified through the MonitorFn property in CVodeSetOptions. % If this property is not set, or if it is empty, MONFUN is not used. % MONDATA is specified through the MonitorData property in CVodeSetOptions. % % See CVodeMonitor for an implementation example. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/05/11 18:51:33 $ sundials-2.5.0/sundialsTB/cvodes/function_types/CVGlocalFnB.m0000600000175000017500000000167411741421121025016 0ustar sylvestresylvestre%CVGlocalFnB - type for user provided RHS approximation function (BBDPre) for backward problems. % % The function GLOCFUNB must be defined either as % FUNCTION [GLOCB, FLAG] = GLOCFUNB(T,Y,YB) % or as % FUNCTION [GLOCB, FLAG, NEW_DATA] = GLOCFUNB(T,Y,YB,DATA) % depending on whether a user data structure DATA was specified in % CVodeInit. In either case, it must return the vector GLOCB % corresponding to an approximation to fB(t,y,yB). % % The function GLOCFUNB must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also CVGcommFnB, CVodeSetOptions % % NOTE: GLOCFUNB is specified through the GlocalFn property in CVodeSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 20:44:05 $ sundials-2.5.0/sundialsTB/cvodes/CVodeInitB.m0000600000175000017500000000246511741421121021652 0ustar sylvestresylvestrefunction [idxB, status] = CVodeInitB(fctB, lmmB, nlsB, tB0, yB0, optionsB) %CVodeInitB allocates and initializes backward memory for CVODES. % % Usage: IDXB = CVodeInitB ( FCTB, LMMB, NLSB, TB0, YB0 [, OPTIONSB] ) % % FCTB is a function defining the adjoint ODE right-hand side. % This function must return a vector containing the current % value of the adjoint ODE righ-hand side. % LMMB is the Linear Multistep Method ('Adams' or 'BDF') % NLSB is the type of nonlinear solver used ('Functional' or 'Newton') % TB0 is the final value of t. % YB0 is the final condition vector yB(tB0). % OPTIONSB is an (optional) set of integration options, created with % the CVodeSetOptions function. % % CVodeInitB returns the index IDXB associated with this backward % problem. This index must be passed as an argument to any subsequent % functions related to this backward problem. % % See also: CVodeSetOptions, CVodeInit, CVRhsFnB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.3 $Date: 2007/12/05 21:58:18 $ mode = 5; if nargin < 5 error('Too few input arguments'); end if nargin < 6 optionsB = []; end [idxB, status] = cvm(mode, fctB, lmmB, nlsB, tB0, yB0, optionsB); idxB = idxB+1; sundials-2.5.0/sundialsTB/cvodes/CVodeQuadReInitB.m0000600000175000017500000000146611741421121022754 0ustar sylvestresylvestrefunction status = CVodeQuadReInitB(idxB, yQB0, optionsB) %CVodeQuadReInitB reinitializes memory for backward quadrature integration. % % Usage: CVodeQuadReInitB ( IDXB, YS0 [, OPTIONS ] ) % % IDXB is the index of the backward problem, returned by % CVodeInitB. % YQB0 is the final conditions vector yQB(tB0). % OPTIONS is an (optional) set of QUAD options, created with % the CVodeSetQuadOptions function. % % See also: CVodeSetQuadOptions, CVodeReInitB, CVodeQuadInitB % % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 16; if nargin < 2 error('Too few input arguments'); end if nargin < 3 optionsB = []; end idxB = idxB-1; status = cvm(mode, idxB, yQB0, optionsB); sundials-2.5.0/sundialsTB/cvodes/CVodeGetStats.m0000600000175000017500000000662611741421121022406 0ustar sylvestresylvestrefunction [si, status] = CVodeGetStats() %CVodeGetStats returns run statistics for the CVODES solver. % % Usage: STATS = CVodeGetStats % %Fields in the structure STATS % %o nst - number of integration steps %o nfe - number of right-hand side function evaluations %o nsetups - number of linear solver setup calls %o netf - number of error test failures %o nni - number of nonlinear solver iterations %o ncfn - number of convergence test failures %o qlast - last method order used %o qcur - current method order %o h0used - actual initial step size used %o hlast - last step size used %o hcur - current step size %o tcur - current time reached by the integrator %o RootInfo - strucutre with rootfinding information %o QuadInfo - structure with quadrature integration statistics %o LSInfo - structure with linear solver statistics %o FSAInfo - structure with forward sensitivity solver statistics % %If rootfinding was requested, the structure RootInfo has the following fields % %o nge - number of calls to the rootfinding function %o roots - array of integers (a value of 1 in the i-th component means that the % i-th rootfinding function has a root (upon a return with status=2 from % CVode). % %If quadratures were present, the structure QuadInfo has the following fields % %o nfQe - number of quadrature integrand function evaluations %o netfQ - number of error test failures for quadrature variables % %The structure LSinfo has different fields, depending on the linear solver used. % % Fields in LSinfo for the 'Dense' linear solver % %o name - 'Dense' %o njeD - number of Jacobian evaluations %o nfeD - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Diag' linear solver % %o name - 'Diag' %o nfeDI - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Band' linear solver % %o name - 'Band' %o njeB - number of Jacobian evaluations %o nfeB - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'GMRES' and 'BiCGStab' linear solvers % %o name - 'GMRES' or 'BiCGStab' %o nli - number of linear solver iterations %o npe - number of preconditioner setups %o nps - number of preconditioner solve function calls %o ncfl - number of linear system convergence test failures %o njeSG - number of Jacobian-vector product evaluations %o nfeSG - number of right-hand side function evaluations for difference-quotient % Jacobian-vector product approximation % %If forward sensitivities were computed, the structure FSAInfo has the %following fields % %o nfSe - number of sensitivity right-hand side evaluations %o nfeS - number of right-hand side evaluations for difference-quotient % sensitivity right-hand side approximation %o nsetupsS - number of linear solver setups triggered by sensitivity variables %o netfS - number of error test failures for sensitivity variables %o nniS - number of nonlinear solver iterations for sensitivity variables %o ncfnS - number of convergence test failures due to sensitivity variables % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.5 $Date: 2007/12/05 21:58:17 $ mode = 30; [si, status] = cvm(mode); sundials-2.5.0/sundialsTB/cvodes/CVodeQuadReInit.m0000600000175000017500000000140511741421121022643 0ustar sylvestresylvestrefunction status = CVodeQuadReInit(yQ0, options) %CVodeQuadReInit reinitializes CVODES's quadrature-related memory % assuming it has already been allocated in prior calls to CVodeInit % and CVodeQuadInit. % % Usage: CVodeQuadReInit ( YQ0 [, OPTIONS ] ) % % YQ0 Initial conditions for quadrature variables yQ(t0). % OPTIONS is an (optional) set of QUAD options, created with % the CVodeSetQuadOptions function. % % See also: CVodeSetQuadOptions, CVodeQuadInit % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:18 $ mode = 12; if nargin < 1 error('Too few input arguments'); end if nargin < 2 options = []; end status = cvm(mode, yQ0, options); sundials-2.5.0/sundialsTB/cvodes/CVodeGetStatsB.m0000600000175000017500000000502611741421121022501 0ustar sylvestresylvestrefunction [si, status] = CVodeGetStatsB(idxB) %CVodeGetStatsB returns run statistics for the backward CVODES solver. % % Usage: STATS = CVodeGetStatsB( IDXB ) % % IDXB is the index of the backward problem, returned by % CVodeInitB. % %Fields in the structure STATS % %o nst - number of integration steps %o nfe - number of right-hand side function evaluations %o nsetups - number of linear solver setup calls %o netf - number of error test failures %o nni - number of nonlinear solver iterations %o ncfn - number of convergence test failures %o qlast - last method order used %o qcur - current method order %o h0used - actual initial step size used %o hlast - last step size used %o hcur - current step size %o tcur - current time reached by the integrator %o QuadInfo - structure with quadrature integration statistics %o LSInfo - structure with linear solver statistics % %The structure LSinfo has different fields, depending on the linear solver used. % %If quadratures were present, the structure QuadInfo has the following fields % %o nfQe - number of quadrature integrand function evaluations %o netfQ - number of error test failures for quadrature variables % % Fields in LSinfo for the 'Dense' linear solver % %o name - 'Dense' %o njeD - number of Jacobian evaluations %o nfeD - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Diag' linear solver % %o name - 'Diag' %o nfeDI - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'Band' linear solver % %o name - 'Band' %o njeB - number of Jacobian evaluations %o nfeB - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'GMRES' and 'BiCGStab' linear solvers % %o name - 'GMRES' or 'BiCGStab' %o nli - number of linear solver iterations %o npe - number of preconditioner setups %o nps - number of preconditioner solve function calls %o ncfl - number of linear system convergence test failures %o njeSG - number of Jacobian-vector product evaluations %o nfeSG - number of right-hand side function evaluations for difference-quotient % Jacobian-vector product approximation % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.5 $Date: 2007/12/05 21:58:17 $ mode = 31; if nargin ~= 1 error('Wrong number of input arguments'); end idxB = idxB-1; [si, status] = cvm(mode, idxB); sundials-2.5.0/sundialsTB/cvodes/CVodeInit.m0000600000175000017500000000312011741421121021535 0ustar sylvestresylvestrefunction status = CVodeInit(fct, lmm, nls, t0, y0, options) %CVodeInit allocates and initializes memory for CVODES. % % Usage: CVodeInit ( ODEFUN, LMM, NLS, T0, Y0 [, OPTIONS ] ) % % ODEFUN is a function defining the ODE right-hand side: y' = f(t,y). % This function must return a vector containing the current % value of the righ-hand side. % LMM is the Linear Multistep Method ('Adams' or 'BDF') % NLS is the type of nonlinear solver used ('Functional' or 'Newton') % T0 is the initial value of t. % Y0 is the initial condition vector y(t0). % OPTIONS is an (optional) set of integration options, created with % the CVodeSetOptions function. % % See also: CVodeSetOptions, CVRhsFn % % NOTES: % 1) The 'Functional' nonlinear solver is best suited for non-stiff % problems, in conjunction with the 'Adams' linear multistep method, % while 'Newton' is better suited for stiff problems, using the 'BDF' % method. % 2) When using the 'Newton' nonlinear solver, a linear solver is also % required. The default one is 'Dense', indicating the use of direct % dense linear algebra (LU factorization). A different linear solver % can be specified through the option 'LinearSolver' to CVodeSetOptions. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.4 $Date: 2007/12/05 21:58:17 $ mode = 1; if nargin < 5 error('Too few input arguments'); end if nargin < 6 options = []; end status = cvm(mode, fct, lmm, nls, t0, y0, options); sundials-2.5.0/sundialsTB/cvodes/CVodeMonitorB.m0000600000175000017500000003451411741421121022376 0ustar sylvestresylvestrefunction [new_data] = CVodeMonitorB(call, idxB, T, Y, YQ, data) %CVodeMonitorB is the default CVODES monitoring function for backward problems. % To use it, set the Monitor property in CVodeSetOptions to % 'CVodeMonitorB' or to @CVodeMonitorB and 'MonitorData' to mondata % (defined as a structure). % % With default settings, this function plots the evolution of the step % size, method order, and various counters. % % Various properties can be changed from their default values by passing % to CVodeSetOptions, through the property 'MonitorData', a structure % MONDATA with any of the following fields. If a field is not defined, % the corresponding default value is used. % % Fields in MONDATA structure: % o stats [ {true} | false ] % If true, report the evolution of the step size and method order. % o cntr [ {true} | false ] % If true, report the evolution of the following counters: % nst, nfe, nni, netf, ncfn (see CVodeGetStats) % o mode [ {'graphical'} | 'text' | 'both' ] % In graphical mode, plot the evolutions of the above quantities. % In text mode, print a table. % o sol [ true | {false} ] % If true, plot solution components. % o select [ array of integers ] % To plot only particular solution components, specify their indeces in % the field select. If not defined, but sol=true, all components are plotted. % o updt [ integer | {50} ] % Update frequency. Data is posted in blocks of dimension n. % o skip [ integer | {0} ] % Number of integrations steps to skip in collecting data to post. % o post [ {true} | false ] % If false, disable all posting. This option is necessary to disable % monitoring on some processors when running in parallel. % % See also CVodeSetOptions, CVMonitorFnB % % NOTES: % 1. The argument mondata is REQUIRED. Even if only the default options % are desired, set mondata=struct; and pass it to CVodeSetOptions. % 2. The yQ argument is currently ignored. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/05/11 18:51:32 $ if (nargin ~= 6) error('Monitor data not defined.'); end new_data = []; if call == 0 % Initialize unspecified fields to default values. data = initialize_data(data); % Open figure windows if data.post if data.grph if data.stats | data.cntr data.hfg = figure; end % Number of subplots in figure hfg if data.stats data.npg = data.npg + 2; end if data.cntr data.npg = data.npg + 1; end end if data.text if data.cntr | data.stats data.hft = figure; end end if data.sol data.hfs = figure; end end % Initialize other private data data.i = 0; data.n = 1; data.t = zeros(1,data.updt); if data.stats data.h = zeros(1,data.updt); data.q = zeros(1,data.updt); end if data.cntr data.nst = zeros(1,data.updt); data.nfe = zeros(1,data.updt); data.nni = zeros(1,data.updt); data.netf = zeros(1,data.updt); data.ncfn = zeros(1,data.updt); end data.first = true; % the next one will be the first call = 1 data.initialized = false; % the graphical windows were not initalized new_data = data; return; else % If this is the first call ~= 0, % use Y for additional initializations if data.first if data.sol if isempty(data.select) data.N = length(Y); data.select = [1:data.N]; else data.N = length(data.select); end if data.sol data.y = zeros(data.N,data.updt); data.nps = data.nps + 1; end end data.first = false; end % Extract variables from data hfg = data.hfg; hft = data.hft; hfs = data.hfs; npg = data.npg; nps = data.nps; i = data.i; n = data.n; t = data.t; N = data.N; y = data.y; h = data.h; q = data.q; nst = data.nst; nfe = data.nfe; nni = data.nni; netf = data.netf; ncfn = data.ncfn; end % Load current statistics? if call == 1 if i ~= 0 i = i-1; data.i = i; new_data = data; return; end si = CVodeGetStatsB(idxB); t(n) = si.tcur; if data.stats h(n) = si.hlast; q(n) = si.qlast; end if data.cntr nst(n) = si.nst; nfe(n) = si.nfe; nni(n) = si.nni; netf(n) = si.netf; ncfn(n) = si.ncfn; end if data.sol for j = 1:N y(j,n) = Y(data.select(j)); end end end % Is it time to post? if data.post & (n == data.updt | call==2) if call == 2 n = n-1; end if ~data.initialized if (data.stats | data.cntr) & data.grph graphical_init(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_init(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_init(n, hfs, nps, data.sol, ... N, t, y); end data.initialized = true; else if (data.stats | data.cntr) & data.grph graphical_update(n, hfg, npg, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if (data.stats | data.cntr) & data.text text_update(n, hft, data.stats, data.cntr, ... t, h, q, nst, nfe, nni, netf, ncfn); end if data.sol sol_update(n, hfs, nps, data.sol, N, t, y); end end if call == 2 if (data.stats | data.cntr) & data.grph graphical_final(hfg, npg, data.cntr, data.stats); end if data.sol sol_final(hfs, nps, data.sol, N); end return; end n = 1; else n = n + 1; end % Save updated values in data data.i = data.skip; data.n = n; data.npg = npg; data.t = t; data.y = y; data.h = h; data.q = q; data.nst = nst; data.nfe = nfe; data.nni = nni; data.netf = netf; data.ncfn = ncfn; new_data = data; return; %------------------------------------------------------------------------- function data = initialize_data(data) if ~isfield(data,'mode') data.mode = 'graphical'; end if ~isfield(data,'updt') data.updt = 50; end if ~isfield(data,'skip') data.skip = 0; end if ~isfield(data,'stats') data.stats = true; end if ~isfield(data,'cntr') data.cntr = true; end if ~isfield(data,'sol') data.sol = false; end if ~isfield(data,'select') data.select = []; end if ~isfield(data,'post') data.post = true; end data.grph = true; data.text = true; if strcmp(data.mode,'graphical') data.text = false; end if strcmp(data.mode,'text') data.grph = false; end if ~data.sol data.select = []; end % Other initializations data.npg = 0; data.nps = 0; data.hfg = 0; data.hft = 0; data.hfs = 0; data.h = 0; data.q = 0; data.nst = 0; data.nfe = 0; data.nni = 0; data.netf = 0; data.ncfn = 0; data.N = 0; data.y = 0; %------------------------------------------------------------------------- function [] = graphical_init(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) fig_name = 'CVODES run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfg); set(hfg,'Name',fig_name); set(hfg,'color',[1 1 1]); pl = 0; % Time label and figure title tlab = '\leftarrow t \leftarrow'; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) semilogy(t(1:n),abs(h(1:n)),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('|Step size|'); pl = pl+1; subplot(npg,1,pl) plot(t(1:n),q(1:n),'-'); hold on; box on; grid on; xlabel(tlab); ylabel('Order'); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) plot(t(1:n),nst(1:n),'k-'); hold on; plot(t(1:n),nfe(1:n),'b-'); plot(t(1:n),nni(1:n),'r-'); plot(t(1:n),netf(1:n),'g-'); plot(t(1:n),ncfn(1:n),'c-'); box on; grid on; xlabel(tlab); ylabel('Counters'); end drawnow; %------------------------------------------------------------------------- function [] = graphical_update(n, hfg, npg, stats, cntr, ... t, h, q, nst, nfe, nni, netf, ncfn) figure(hfg); pl = 0; % Step size and order if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') abs(h(1:n))]; set(hc, 'XData', xd, 'YData', yd); pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = [get(hc,'XData') t(1:n)]; yd = [get(hc,'YData') q(1:n)]; set(hc, 'XData', xd, 'YData', yd); end % Counters if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); % Attention: Children are loaded in reverse order! xd = [get(hc(1),'XData') t(1:n)]; yd = [get(hc(1),'YData') ncfn(1:n)]; set(hc(1), 'XData', xd, 'YData', yd); yd = [get(hc(2),'YData') netf(1:n)]; set(hc(2), 'XData', xd, 'YData', yd); yd = [get(hc(3),'YData') nni(1:n)]; set(hc(3), 'XData', xd, 'YData', yd); yd = [get(hc(4),'YData') nfe(1:n)]; set(hc(4), 'XData', xd, 'YData', yd); yd = [get(hc(5),'YData') nst(1:n)]; set(hc(5), 'XData', xd, 'YData', yd); end drawnow; %------------------------------------------------------------------------- function [] = graphical_final(hfg,npg,stats,cntr) figure(hfg); pl = 0; if stats pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc,'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); pl = pl+1; subplot(npg,1,pl) ylim = get(gca,'YLim'); ylim(1) = ylim(1) - 1; ylim(2) = ylim(2) + 1; set(gca,'YLim',ylim); set(gca,'XLim',sort([xd(1) xd(end)])); end if cntr pl = pl+1; subplot(npg,1,pl) hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); legend('nst','nfe','nni','netf','ncfn',2); end %------------------------------------------------------------------------- function [] = text_init(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) fig_name = 'CVODES run statistics'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hft); set(hft,'Name',fig_name); set(hft,'color',[1 1 1]); set(hft,'MenuBar','none'); set(hft,'Resize','off'); % Create text box margins=[10 10 50 50]; % left, right, top, bottom pos=get(hft,'position'); tbpos=[margins(1) margins(4) pos(3)-margins(1)-margins(2) ... pos(4)-margins(3)-margins(4)]; tbpos(tbpos<1)=1; htb=uicontrol(hft,'style','listbox','position',tbpos,'tag','textbox'); set(htb,'BackgroundColor',[1 1 1]); set(htb,'SelectionHighlight','off'); set(htb,'FontName','courier'); % Create table head tpos = [tbpos(1) tbpos(2)+tbpos(4)+10 tbpos(3) 20]; ht=uicontrol(hft,'style','text','position',tpos,'tag','text'); set(ht,'BackgroundColor',[1 1 1]); set(ht,'HorizontalAlignment','left'); set(ht,'FontName','courier'); newline = ' time step order | nst nfe nni netf ncfn'; set(ht,'String',newline); % Create OK button bsize=[60,28]; badjustpos=[0,25]; bpos=[pos(3)/2-bsize(1)/2+badjustpos(1) -bsize(2)/2+badjustpos(2)... bsize(1) bsize(2)]; bpos=round(bpos); bpos(bpos<1)=1; hb=uicontrol(hft,'style','pushbutton','position',bpos,... 'string','Close','tag','okaybutton'); set(hb,'callback','close'); % Save handles handles=guihandles(hft); guidata(hft,handles); for i = 1:n newline = ''; if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = text_update(n,hft,stats,cntr,t,h,q,nst,nfe,nni,netf,ncfn) figure(hft); handles=guidata(hft); for i = 1:n if stats newline = sprintf('%10.3e %10.3e %1d |',t(i),h(i),q(i)); end if cntr newline = sprintf('%s %5d %5d %5d %5d %5d',... newline,nst(i),nfe(i),nni(i),netf(i),ncfn(i)); end string = get(handles.textbox,'String'); string{end+1}=newline; set(handles.textbox,'String',string); end drawnow %------------------------------------------------------------------------- function [] = sol_init(n, hfs, nps, sol, N, t, y) fig_name = 'CVODES solution'; % If this is a parallel job, look for the MPI rank in the global % workspace and append it to the figure name global sundials_MPI_rank if ~isempty(sundials_MPI_rank) fig_name = sprintf('%s (PE %d)',fig_name,sundials_MPI_rank); end figure(hfs); set(hfs,'Name',fig_name); set(hfs,'color',[1 1 1]); % Time label tlab = '\leftarrow t \leftarrow'; % Get number of colors in colormap map = colormap; ncols = size(map,1); % Initialize current subplot counter pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hold on; for i = 1:N hp = plot(t(1:n),y(i,1:n),'-'); ic = 1+(i-1)*floor(ncols/N); set(hp,'Color',map(ic,:)); end box on; grid on; xlabel(tlab); ylabel('y'); title('Solution'); end drawnow; %------------------------------------------------------------------------- function [] = sol_update(n, hfs, nps, sol, N, t, y) figure(hfs); pl = 0; if sol pl = pl+1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = [get(hc(1),'XData') t(1:n)]; % Attention: Children are loaded in reverse order! for i = 1:N yd = [get(hc(i),'YData') y(N-i+1,1:n)]; set(hc(i), 'XData', xd, 'YData', yd); end end drawnow; %------------------------------------------------------------------------- function [] = sol_final(hfs, nps, sol, N) figure(hfs); pl = 0; if sol pl = pl +1; subplot(nps,1,pl); hc = get(gca,'Children'); xd = get(hc(1),'XData'); set(gca,'XLim',sort([xd(1) xd(end)])); ylim = get(gca,'YLim'); addon = 0.1*abs(ylim(2)-ylim(1)); ylim(1) = ylim(1) + sign(ylim(1))*addon; ylim(2) = ylim(2) + sign(ylim(2))*addon; set(gca,'YLim',ylim); for i = 1:N cstring{i} = sprintf('y_{%d}',i); end legend(cstring); end drawnow sundials-2.5.0/sundialsTB/cvodes/CVodeGet.m0000600000175000017500000000247311741421121021363 0ustar sylvestresylvestrefunction [output, status] = CVodeGet(key, varargin) %CVodeGet extracts data from the CVODES solver memory. % % Usage: RET = CVodeGet ( KEY [, P1 [, P2] ... ]) % % CVodeGet returns internal CVODES information based on KEY. For some values % of KEY, additional arguments may be required and/or more than one output is % returned. % % KEY is a string and should be one of: % o DerivSolution - Returns a vector containing the K-th order derivative % of the solution at time T. The time T and order K must be passed through % the input arguments P1 and P2, respectively: % DKY = CVodeGet('DerivSolution', T, K) % o ErrorWeights - Returns a vector containing the current error weights. % EWT = CVodeGet('ErrorWeights') % o CheckPointsInfo - Returns an array of structures with check point information. % CK = CVodeGet('CheckPointInfo) % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.6 $Date: 2007/12/05 21:58:17 $ mode = 32; if strcmp(key, 'DerivSolution') t = varargin{1}; k = varargin{2}; [output, status] = cvm(mode, 1, t, k); elseif strcmp(key, 'ErrorWeights') [output, status] = cvm(mode, 2); elseif strcmp(key, 'CheckPointsInfo') [output, status] = cvm(mode, 4); else error('CVodeGet:: Unrecognized key'); endsundials-2.5.0/sundialsTB/startup_STB.in0000600000175000017500000000235611741421121021024 0ustar sylvestresylvestrefunction [] = startup_STB(stb) % STARTUP_STB path/environment setup script for sundialsTB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.7 $Date: 2007/12/05 21:58:17 $ % If called without any argument, use the path specified which was % harcoded when startup_STB.m was created. if nargin == 0 stb_path = '@STB_PATH@'; stb = fullfile(stb_path,'sundialsTB'); end if ~exist(stb, 'dir') warning('SUNDIALS Toolbox not found'); return end % Add top-level directory to path addpath(stb); % Add sundialsTB components to path q = fullfile(stb,'cvodes'); if exist(q, 'dir') addpath(q); q = fullfile(stb,'cvodes','cvm'); addpath(q); q = fullfile(stb,'cvodes','function_types'); addpath(q); end q = fullfile(stb,'idas'); if exist(q, 'dir') addpath(q); q = fullfile(stb,'idas','idm'); addpath(q); q = fullfile(stb,'idas','function_types'); addpath(q); end q = fullfile(stb,'kinsol'); if exist(q, 'dir') addpath(q); q = fullfile(stb,'kinsol','kim'); addpath(q); q = fullfile(stb,'kinsol','function_types'); addpath(q); end q = fullfile(stb,'nvector'); if exist(q, 'dir') addpath(q); end q = fullfile(stb,'putils'); if exist(q, 'dir') addpath(q); end sundials-2.5.0/sundialsTB/install_STB.m0000600000175000017500000007627611741421121020632 0ustar sylvestresylvestrefunction [] = install_STB % % INSTALL_STB Interactive compilation and installtion of sundialsTB % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.23 $Date: 2009/04/22 03:34:01 $ % MEX compiler command % -------------------- mexcompiler = 'mex -v'; % Location of sundialsTB and top of sundials source tree % ------------------------------------------------------ stb = pwd; cd('..'); sun = pwd; cd(stb); % Test mex % -------- mex_ok = check_mex(mexcompiler); if ~mex_ok return end % Should we enable parallel support? % ---------------------------------- par = true; if isempty(getenv('LAMHOME')) par = false; end if isempty(getenv('MPITB_ROOT')) par = false; end q = fullfile(sun,'src','nvec_par'); if ~exist(q, 'dir') par = false; end % Figure out what modules exist and which ones will be built % ---------------------------------------------------------- fprintf('\n\nSelect modules to be built\n'); q = fullfile(sun,'src','cvodes'); if exist(q, 'dir') answ = input(' Compile CVODES interface? (y/n) ','s'); if answ == 'y' cvm_ok = true; else cvm_ok = false; end end if exist(q, 'dir') answ = input(' Compile IDAS interface? (y/n) ','s'); if answ == 'y' idm_ok = true; else idm_ok = false; end end q = fullfile(sun,'src','kinsol'); if exist(q, 'dir') answ = input(' Compile KINSOL interface? (y/n) ','s'); if answ == 'y' kim_ok = true; else kim_ok = false; end end if ~cvm_ok && ~idm_ok && ~kim_ok fprintf('\nOK. All done.\n'); return end % Create sundials_config.h % ------------------------ mkdir('sundials'); fi = fopen(fullfile('sundials','sundials_config.h'),'w'); fprintf(fi,'#define SUNDIALS_PACKAGE_VERSION "2.4.0"\n'); fprintf(fi,'#define SUNDIALS_DOUBLE_PRECISION 1\n'); fprintf(fi,'#define SUNDIALS_USE_GENERIC_MATH 1\n'); fprintf(fi,'#define SUNDIALS_EXPORT\n'); fclose(fi); % Compile MEX file for the selected modules % ----------------------------------------- if cvm_ok compile_CVM(mexcompiler,stb,sun,par); end if idm_ok compile_IDM(mexcompiler,stb,sun,par); end if kim_ok compile_KIM(mexcompiler,stb,sun,par); end % Remove sundials_config.h % ------------------------ rmdir('sundials','s'); % Install sundialsTB % ------------------ fprintf('\n\nMEX files were successfully created.\n'); answ = input(' Install toolbox? (y/n) ','s'); if answ ~= 'y' fprintf('\n\nOK. All done.\n'); return end while true fprintf('\n\nSpecify the location where you wish to install the toolbox.\n'); fprintf('The toolbox will be installed in a subdirectory "sundialsTB".\n'); fprintf('Enter return to cancel the installation.\n'); where = input(' Installation directory: ','s'); if isempty(where) go = 0; break; end if exist(where,'dir') go = 1; break end fprintf('\n%s does not exist!\n', where); end if ~go fprintf('\n\nOK. All done.\n'); return end stbi = fullfile(where,'sundialsTB'); go = 1; if exist(stbi,'dir') fprintf('\n\nDirectory %s exists!\n',stbi); answ = input(' Replace? (y/n) ','s'); if answ == 'y' rmdir(stbi,'s'); go = 1; else go = 0; end end if ~go fprintf('\n\nOK. All done.\n'); return end mkdir(where,'sundialsTB'); mkdir(fullfile(where,'sundialsTB'),'nvector'); if par mkdir(fullfile(where,'sundialsTB'),'putils'); end instSTB(stb, where, par); if cvm_ok mkdir(fullfile(where,'sundialsTB'),'cvodes'); mkdir(fullfile(where,'sundialsTB','cvodes'),'cvm'); mkdir(fullfile(where,'sundialsTB','cvodes'),'function_types'); mkdir(fullfile(where,'sundialsTB','cvodes'),'examples_ser'); if par mkdir(fullfile(where,'sundialsTB','cvodes'),'examples_par'); end instCVM(stb, where, par); end if idm_ok mkdir(fullfile(where,'sundialsTB'),'idas'); mkdir(fullfile(where,'sundialsTB','idas'),'idm'); mkdir(fullfile(where,'sundialsTB','idas'),'function_types'); mkdir(fullfile(where,'sundialsTB','idas'),'examples_ser'); if par mkdir(fullfile(where,'sundialsTB','idas'),'examples_par'); end instIDM(stb, where, par); end if kim_ok mkdir(fullfile(where,'sundialsTB'),'kinsol'); mkdir(fullfile(where,'sundialsTB','kinsol'),'kim'); mkdir(fullfile(where,'sundialsTB','kinsol'),'function_types'); mkdir(fullfile(where,'sundialsTB','kinsol'),'examples_ser'); if par mkdir(fullfile(where,'sundialsTB','kinsol'),'examples_par'); end instKIM(stb, where, par); end fprintf('\n\nThe sundialsTB toolbox was installed in %s\n',stbi); fprintf('\nA startup file, "startup_STB.m" was created in %s.\n',stbi); fprintf('Use it as your Matlab startup file, or, if you already have a startup.m file,\n'); fprintf('add a call to %s\n',fullfile(stbi,'startup_STB.m')); fprintf('\nEnjoy!\n\n'); %--------------------------------------------------------------------------------- % Check if mex works and if the user accepts the current mexopts %--------------------------------------------------------------------------------- function mex_ok = check_mex(mexcompiler) % Create a dummy file fid = fopen('foo.c', 'w'); fprintf(fid,'#include "mex.h"\n'); fprintf(fid,'void mexFunction(int nlhs,mxArray *plhs[],int nrhs,const mxArray *prhs[])\n'); fprintf(fid,'{return;}\n'); fclose(fid); % Run mexcompiler on foo.c mex_cmd = sprintf('%s foo.c', mexcompiler); eval(mex_cmd); % Remove dummy source file and resulting mex file delete('foo.c') delete(sprintf('foo.%s', mexext)) fprintf('\n\nMEX files will be compiled and built using the above options\n'); answ = input(' Proceed? (y/n) ','s'); if answ == 'y' mex_ok = true; else fprintf('\n\nOK. All done.\n'); mex_ok = false; end return %--------------------------------------------------------------------------------- % compilation of cvm MEX file %--------------------------------------------------------------------------------- function [] = compile_CVM(mexcompiler,stb,sun,par) cvm_sources = { fullfile(stb,'cvodes','cvm','src','cvm.c') fullfile(stb,'cvodes','cvm','src','cvmWrap.c') fullfile(stb,'cvodes','cvm','src','cvmOpts.c') }; if par nvm_sources = { fullfile(stb,'nvector','src','nvm_parallel.c') fullfile(stb,'nvector','src','nvm_ops.c') }; else nvm_sources = { fullfile(stb,'nvector','src','nvm_serial.c') fullfile(stb,'nvector','src','nvm_ops.c') }; end sources = ''; for i=1:length(cvm_sources) sources = sprintf('%s "%s"',sources,cvm_sources{i}); end for i=1:length(nvm_sources) sources = sprintf('%s "%s"',sources,nvm_sources{i}); end cvm_incdir = fullfile(stb,'cvodes','cvm','src'); % for cvm.h nvm_incdir = fullfile(stb,'nvector','src'); % for nvm.h includes = sprintf('-I"%s" -I"%s" -I"%s"',stb,cvm_incdir,nvm_incdir); libraries = ''; % Add CVODES sources and header files cvs_sources = { fullfile(sun,'src','cvodes','cvodes_band.c') fullfile(sun,'src','cvodes','cvodes_bandpre.c') fullfile(sun,'src','cvodes','cvodes_bbdpre.c') fullfile(sun,'src','cvodes','cvodes_direct.c') fullfile(sun,'src','cvodes','cvodes_dense.c') fullfile(sun,'src','cvodes','cvodes_diag.c') fullfile(sun,'src','cvodes','cvodea.c') fullfile(sun,'src','cvodes','cvodes.c') fullfile(sun,'src','cvodes','cvodes_io.c') fullfile(sun,'src','cvodes','cvodea_io.c') fullfile(sun,'src','cvodes','cvodes_spils.c') fullfile(sun,'src','cvodes','cvodes_spbcgs.c') fullfile(sun,'src','cvodes','cvodes_spgmr.c') fullfile(sun,'src','cvodes','cvodes_sptfqmr.c') }; shr_sources = { fullfile(sun,'src','sundials','sundials_band.c') fullfile(sun,'src','sundials','sundials_dense.c') fullfile(sun,'src','sundials','sundials_iterative.c') fullfile(sun,'src','sundials','sundials_nvector.c') fullfile(sun,'src','sundials','sundials_direct.c') fullfile(sun,'src','sundials','sundials_spbcgs.c') fullfile(sun,'src','sundials','sundials_spgmr.c') fullfile(sun,'src','sundials','sundials_sptfqmr.c') fullfile(sun,'src','sundials','sundials_math.c') }; for i=1:length(cvs_sources) sources = sprintf('%s "%s"',sources,cvs_sources{i}); end for i=1:length(shr_sources) sources = sprintf('%s "%s"',sources,shr_sources{i}); end sun_incdir = fullfile(sun,'include'); % for SUNDIALS exported headers cvs_srcdir = fullfile(sun,'src','cvodes'); % for cvodes_impl.h includes = sprintf('%s -I"%s" -I"%s"',includes,sun_incdir,cvs_srcdir); % Add NVEC_SER sources and header files nvs_sources = fullfile(sun,'src','nvec_ser','nvector_serial.c'); sources = sprintf('%s "%s"',sources, nvs_sources); if par % Add NVEC_PAR sources and header files nvp_sources = fullfile(sun,'src','nvec_par','nvector_parallel.c'); sources = sprintf('%s "%s"',sources, nvp_sources); % Add LAM headers and libraries lam = getenv('LAMHOME'); lam_incdir = fullfile(lam, 'include'); lam_libdir = fullfile(lam, 'lib'); includes = sprintf('%s -I"%s"',includes,lam_incdir); libraries = sprintf('%s -L"%s" -lmpi -llam -lutil',libraries,lam_libdir); end % Create MEX file cvm_dir = fullfile(stb,'cvodes','cvm'); cd(cvm_dir) mex_cmd = sprintf('%s %s %s %s', mexcompiler, includes, sources, libraries); disp(mex_cmd); eval(mex_cmd); % Move back to sundialsTB cd(stb) %--------------------------------------------------------------------------------- % compilation of idm MEX file %--------------------------------------------------------------------------------- function [] = compile_IDM(mexcompiler,stb,sun,par) idm_sources = { fullfile(stb,'idas','idm','src','idm.c') fullfile(stb,'idas','idm','src','idmWrap.c') fullfile(stb,'idas','idm','src','idmOpts.c') }; if par nvm_sources = { fullfile(stb,'nvector','src','nvm_parallel.c') fullfile(stb,'nvector','src','nvm_ops.c') }; else nvm_sources = { fullfile(stb,'nvector','src','nvm_serial.c') fullfile(stb,'nvector','src','nvm_ops.c') }; end sources = ''; for i=1:length(idm_sources) sources = sprintf('%s "%s"',sources,idm_sources{i}); end for i=1:length(nvm_sources) sources = sprintf('%s "%s"',sources,nvm_sources{i}); end idm_incdir = fullfile(stb,'idas','idm','src'); % for idm.h nvm_incdir = fullfile(stb,'nvector','src'); % for nvm.h includes = sprintf('-I"%s" -I"%s" -I"%s"',stb,idm_incdir,nvm_incdir); libraries = ''; % Add IDAS sources and header files ids_sources = { fullfile(sun,'src','idas','idas_band.c') fullfile(sun,'src','idas','idas_bbdpre.c') fullfile(sun,'src','idas','idas_dense.c') fullfile(sun,'src','idas','idas_direct.c') fullfile(sun,'src','idas','idaa.c') fullfile(sun,'src','idas','idas.c') fullfile(sun,'src','idas','idas_ic.c') fullfile(sun,'src','idas','idas_io.c') fullfile(sun,'src','idas','idaa_io.c') fullfile(sun,'src','idas','idas_spils.c') fullfile(sun,'src','idas','idas_spbcgs.c') fullfile(sun,'src','idas','idas_spgmr.c') fullfile(sun,'src','idas','idas_sptfqmr.c') }; shr_sources = { fullfile(sun,'src','sundials','sundials_band.c') fullfile(sun,'src','sundials','sundials_dense.c') fullfile(sun,'src','sundials','sundials_iterative.c') fullfile(sun,'src','sundials','sundials_nvector.c') fullfile(sun,'src','sundials','sundials_direct.c') fullfile(sun,'src','sundials','sundials_spbcgs.c') fullfile(sun,'src','sundials','sundials_spgmr.c') fullfile(sun,'src','sundials','sundials_sptfqmr.c') fullfile(sun,'src','sundials','sundials_math.c') }; for i=1:length(ids_sources) sources = sprintf('%s "%s"',sources,ids_sources{i}); end for i=1:length(shr_sources) sources = sprintf('%s "%s"',sources,shr_sources{i}); end sun_incdir = fullfile(sun,'include'); % for SUNDIALS exported headers ids_srcdir = fullfile(sun,'src','idas'); % for idas_impl.h includes = sprintf('%s -I"%s" -I"%s"',includes,sun_incdir,ids_srcdir); % Add NVEC_SER sources and header files nvs_sources = fullfile(sun,'src','nvec_ser','nvector_serial.c'); sources = sprintf('%s "%s"',sources, nvs_sources); if par % Add NVEC_PAR sources and header files nvp_sources = fullfile(sun,'src','nvec_par','nvector_parallel.c'); sources = sprintf('%s "%s"',sources, nvp_sources); % Add LAM headers and libraries lam = getenv('LAMHOME'); lam_incdir = fullfile(lam, 'include'); lam_libdir = fullfile(lam, 'lib'); includes = sprintf('%s -I"%s"',includes,lam_incdir); libraries = sprintf('%s -L"%s" -lmpi -llam -lutil',libraries,lam_libdir); end % Create MEX file idm_dir = fullfile(stb,'idas','idm'); cd(idm_dir) mex_cmd = sprintf('%s %s %s %s', mexcompiler, includes, sources, libraries); disp(mex_cmd); eval(mex_cmd); % Move back to sundialsTB cd(stb) %--------------------------------------------------------------------------------- % compilation of KINSOL MEX file %--------------------------------------------------------------------------------- function [] = compile_KIM(mexcompiler,stb,sun,par) kim_sources = { fullfile(stb,'kinsol','kim','src','kim.c') fullfile(stb,'kinsol','kim','src','kimWrap.c') fullfile(stb,'kinsol','kim','src','kimOpts.c') }; if par nvm_sources = { fullfile(stb,'nvector','src','nvm_parallel.c') fullfile(stb,'nvector','src','nvm_ops.c') }; else nvm_sources = { fullfile(stb,'nvector','src','nvm_serial.c') fullfile(stb,'nvector','src','nvm_ops.c') }; end sources = ''; for i=1:length(kim_sources) sources = sprintf('%s "%s"',sources,kim_sources{i}); end for i=1:length(nvm_sources) sources = sprintf('%s "%s"',sources,nvm_sources{i}); end kim_incdir = fullfile(stb,'kinsol','kim','src'); % for kim.h nvm_incdir = fullfile(stb,'nvector','src'); % for nvm.h includes = sprintf('-I"%s" -I"%s" -I"%s"',stb,kim_incdir,nvm_incdir); libraries = ''; % Add KINSOL sources and header files kin_sources = { fullfile(sun,'src','kinsol','kinsol_band.c') fullfile(sun,'src','kinsol','kinsol_bbdpre.c') fullfile(sun,'src','kinsol','kinsol_dense.c') fullfile(sun,'src','kinsol','kinsol_direct.c') fullfile(sun,'src','kinsol','kinsol.c') fullfile(sun,'src','kinsol','kinsol_io.c') fullfile(sun,'src','kinsol','kinsol_spils.c') fullfile(sun,'src','kinsol','kinsol_spbcgs.c') fullfile(sun,'src','kinsol','kinsol_spgmr.c') fullfile(sun,'src','kinsol','kinsol_sptfqmr.c') }; shr_sources = { fullfile(sun,'src','sundials','sundials_band.c') fullfile(sun,'src','sundials','sundials_dense.c') fullfile(sun,'src','sundials','sundials_iterative.c') fullfile(sun,'src','sundials','sundials_nvector.c') fullfile(sun,'src','sundials','sundials_direct.c') fullfile(sun,'src','sundials','sundials_spbcgs.c') fullfile(sun,'src','sundials','sundials_spgmr.c') fullfile(sun,'src','sundials','sundials_sptfqmr.c') fullfile(sun,'src','sundials','sundials_math.c') }; for i=1:length(kin_sources) sources = sprintf('%s "%s"',sources,kin_sources{i}); end for i=1:length(shr_sources) sources = sprintf('%s "%s"',sources,shr_sources{i}); end sun_incdir = fullfile(sun,'include'); % for SUNDIALS exported headers kin_srcdir = fullfile(sun,'src','kinsol'); % for kinsol_impl.h includes = sprintf('%s -I"%s" -I"%s"',includes,sun_incdir,kin_srcdir); % Add NVEC_SER sources and header files nvs_sources = fullfile(sun,'src','nvec_ser','nvector_serial.c'); sources = sprintf('%s "%s"',sources, nvs_sources); if par % Add NVEC_PAR sources and header files nvp_sources = fullfile(sun,'src','nvec_par','nvector_parallel.c'); sources = sprintf('%s "%s"',sources, nvp_sources); % Add LAM headers and libraries lam = getenv('LAMHOME'); lam_incdir = fullfile(lam, 'include'); lam_libdir = fullfile(lam, 'lib'); includes = sprintf('%s -I"%s"',includes,lam_incdir); libraries = sprintf('%s -L"%s" -lmpi -llam -lutil',libraries,lam_libdir); end % Create MEX file kim_dir = fullfile(stb, 'kinsol', 'kim'); cd(kim_dir) mex_cmd = sprintf('%s %s %s %s', mexcompiler, includes, sources, libraries); disp(mex_cmd); eval(mex_cmd); % Move back to sundialsTB cd(stb) %--------------------------------------------------------------------------------- % Installation of common sundialsTB files %--------------------------------------------------------------------------------- function [] = instSTB(stb, where, par) stbi = fullfile(where,'sundialsTB'); % Create startup_STB.m (use the template startup_STB.in) in_file = fullfile(stb,'startup_STB.in'); fi = fopen(in_file,'r'); out_file = fullfile(stbi,'startup_STB.m'); fo = fopen(out_file,'w'); while(~feof(fi)) l = fgets(fi); i = strfind(l,'@STB_PATH@'); if ~isempty(i) l = sprintf(' stb_path = ''%s'';\n',where); end fprintf(fo,'%s',l); end fclose(fo); fclose(fi); top_files = { 'LICENSE' 'Contents.m' }; nvm_files = { fullfile('nvector','Contents.m') fullfile('nvector','N_VDotProd.m') fullfile('nvector','N_VL1Norm.m') fullfile('nvector','N_VMax.m') fullfile('nvector','N_VMaxNorm.m') fullfile('nvector','N_VMin.m') fullfile('nvector','N_VWL2Norm.m') fullfile('nvector','N_VWrmsNorm.m') }; put_files = { fullfile('putils','Contents.m') fullfile('putils','mpistart.m') fullfile('putils','mpirun.m') fullfile('putils','mpiruns.m') }; stb_files = [top_files ; nvm_files]; if par stb_files = [stb_files; put_files]; end fprintf('\n\n'); for i=1:length(stb_files) src = fullfile(stb,stb_files{i}); dest = fullfile(stbi,stb_files{i}); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); break; end end %--------------------------------------------------------------------------------- % Installation of CVODES files %--------------------------------------------------------------------------------- function [] = instCVM(stb, where, par) stbi = fullfile(where,'sundialsTB'); % Copy files to installation directory cvmmex = ['cvm.' mexext]; cvm_files = { fullfile('cvodes','Contents.m') % fullfile('cvodes','CVodeSetOptions.m') fullfile('cvodes','CVodeQuadSetOptions.m') fullfile('cvodes','CVodeSensSetOptions.m') fullfile('cvodes','CVodeInit.m') fullfile('cvodes','CVodeReInit.m') fullfile('cvodes','CVodeQuadInit.m') fullfile('cvodes','CVodeQuadReInit.m') fullfile('cvodes','CVodeSensInit.m') fullfile('cvodes','CVodeSensReInit.m') fullfile('cvodes','CVode.m') fullfile('cvodes','CVodeGet.m') fullfile('cvodes','CVodeSet.m') fullfile('cvodes','CVodeGetStats.m') % fullfile('cvodes','CVodeAdjInit.m') fullfile('cvodes','CVodeAdjReInit.m') % fullfile('cvodes','CVodeInitB.m') fullfile('cvodes','CVodeReInitB.m') fullfile('cvodes','CVodeQuadInitB.m') fullfile('cvodes','CVodeQuadReInitB.m') fullfile('cvodes','CVodeSensToggleOff.m') fullfile('cvodes','CVodeB.m') fullfile('cvodes','CVodeSetB.m') fullfile('cvodes','CVodeGetStatsB.m') % fullfile('cvodes','CVodeFree.m') % fullfile('cvodes','cvm','Contents.m') fullfile('cvodes','cvm','cvm_options.m') % fullfile('cvodes','cvm','cvm_rhs.m') fullfile('cvodes','cvm','cvm_rhsQ.m') fullfile('cvodes','cvm','cvm_rhsS.m') fullfile('cvodes','cvm','cvm_root.m') fullfile('cvodes','cvm','cvm_bjac.m') fullfile('cvodes','cvm','cvm_djac.m') fullfile('cvodes','cvm','cvm_jtv.m') fullfile('cvodes','cvm','cvm_pset.m') fullfile('cvodes','cvm','cvm_psol.m') fullfile('cvodes','cvm','cvm_gcom.m') fullfile('cvodes','cvm','cvm_gloc.m') fullfile('cvodes','cvm','cvm_monitor.m') % fullfile('cvodes','cvm','cvm_rhsB.m') fullfile('cvodes','cvm','cvm_rhsQB.m') fullfile('cvodes','cvm','cvm_bjacB.m') fullfile('cvodes','cvm','cvm_djacB.m') fullfile('cvodes','cvm','cvm_jtvB.m') fullfile('cvodes','cvm','cvm_psetB.m') fullfile('cvodes','cvm','cvm_psolB.m') fullfile('cvodes','cvm','cvm_gcomB.m') fullfile('cvodes','cvm','cvm_glocB.m') fullfile('cvodes','cvm','cvm_monitorB.m') % fullfile('cvodes','cvm',cvmmex) }; cvm_ftypes = { fullfile('cvodes','function_types','CVRhsFn.m') fullfile('cvodes','function_types','CVQuadRhsFn.m') fullfile('cvodes','function_types','CVSensRhsFn.m') fullfile('cvodes','function_types','CVRootFn.m') fullfile('cvodes','function_types','CVBandJacFn.m') fullfile('cvodes','function_types','CVDenseJacFn.m') fullfile('cvodes','function_types','CVJacTimesVecFn.m') fullfile('cvodes','function_types','CVPrecSetupFn.m') fullfile('cvodes','function_types','CVPrecSolveFn.m') fullfile('cvodes','function_types','CVGcommFn.m') fullfile('cvodes','function_types','CVGlocalFn.m') fullfile('cvodes','function_types','CVMonitorFn.m') % fullfile('cvodes','function_types','CVRhsFnB.m') fullfile('cvodes','function_types','CVQuadRhsFnB.m') fullfile('cvodes','function_types','CVBandJacFnB.m') fullfile('cvodes','function_types','CVDenseJacFnB.m') fullfile('cvodes','function_types','CVJacTimesVecFnB.m') fullfile('cvodes','function_types','CVPrecSetupFnB.m') fullfile('cvodes','function_types','CVPrecSolveFnB.m') fullfile('cvodes','function_types','CVGcommFnB.m') fullfile('cvodes','function_types','CVGlocalFnB.m') fullfile('cvodes','function_types','CVMonitorFnB.m') }; cvm_exs = { fullfile('cvodes','examples_ser','mcvsAdvDiff_bnd.m') fullfile('cvodes','examples_ser','mcvsDiscRHS_dns.m') fullfile('cvodes','examples_ser','mcvsDiscSOL_dns.m') fullfile('cvodes','examples_ser','mcvsDiurnal_kry.m') fullfile('cvodes','examples_ser','mcvsHessian_FSA_ASA.m') fullfile('cvodes','examples_ser','mcvsOzone_FSA_dns.m') fullfile('cvodes','examples_ser','mcvsPleiades_non.m') fullfile('cvodes','examples_ser','mcvsPollut_FSA_dns.m') fullfile('cvodes','examples_ser','mcvsRoberts_ASAi_dns.m') fullfile('cvodes','examples_ser','mcvsRoberts_dns.m') fullfile('cvodes','examples_ser','mcvsRoberts_FSA_dns.m') fullfile('cvodes','examples_ser','mcvsVanDPol_dns.m') }; cvm_exp = { fullfile('cvodes','examples_par','mcvsAdvDiff_FSA_non_p.m') fullfile('cvodes','examples_par','mcvsAtmDisp_kry_bbd_p.m') fullfile('cvodes','examples_par','mcvsDecoupl_non_p.m') }; stb_files = [cvm_files ; cvm_ftypes ; cvm_exs]; if par stb_files = [stb_files ; cvm_exp]; end fprintf('\n\n'); for i=1:length(stb_files) src = fullfile(stb,stb_files{i}); dest = fullfile(stbi,stb_files{i}); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); break; end end if (exist ('OCTAVE_VERSION')) cvmon = fullfile('cvodes','CVodeMonitor_octave.m'); cvmonB = fullfile('cvodes','CVodeMonitorB_octave.m'); else cvmon = fullfile('cvodes','CVodeMonitor.m'); cvmonB = fullfile('cvodes','CVodeMonitorB.m'); end src = fullfile(stb,cvmon); dest = fullfile(stbi,'cvodes','CVodeMonitor.m'); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); end src = fullfile(stb,cvmonB); dest = fullfile(stbi,'cvodes','CVodeMonitorB.m'); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); end %--------------------------------------------------------------------------------- % Installation of IDAS files %--------------------------------------------------------------------------------- function [] = instIDM(stb, where, par) stbi = fullfile(where,'sundialsTB'); % Copy files to installation directory idmmex = ['idm.' mexext]; idm_files = { fullfile('idas','Contents.m') % fullfile('idas','IDASetOptions.m') fullfile('idas','IDAQuadSetOptions.m') fullfile('idas','IDASensSetOptions.m') fullfile('idas','IDAInit.m') fullfile('idas','IDAReInit.m') fullfile('idas','IDAQuadInit.m') fullfile('idas','IDAQuadReInit.m') fullfile('idas','IDASensInit.m') fullfile('idas','IDASensReInit.m') fullfile('idas','IDASensToggleOff.m') fullfile('idas','IDAAdjReInit.m') fullfile('idas','IDACalcIC.m') fullfile('idas','IDASolve.m') fullfile('idas','IDASet.m') fullfile('idas','IDAGet.m') fullfile('idas','IDAGetStats.m') % fullfile('idas','IDAAdjInit.m') % fullfile('idas','IDAInitB.m') fullfile('idas','IDAReInitB.m') fullfile('idas','IDAQuadInitB.m') fullfile('idas','IDAQuadReInitB.m') fullfile('idas','IDACalcICB.m') fullfile('idas','IDASolveB.m') fullfile('idas','IDASetB.m') fullfile('idas','IDAGetStatsB.m') % fullfile('idas','IDAFree.m') % fullfile('idas','idm','Contents.m') fullfile('idas','idm','idm_options.m') % fullfile('idas','idm','idm_res.m') fullfile('idas','idm','idm_rhsQ.m') fullfile('idas','idm','idm_bjac.m') fullfile('idas','idm','idm_djac.m') fullfile('idas','idm','idm_gcom.m') fullfile('idas','idm','idm_gloc.m') fullfile('idas','idm','idm_jtv.m') fullfile('idas','idm','idm_pset.m') fullfile('idas','idm','idm_psol.m') fullfile('idas','idm','idm_root.m') fullfile('idas','idm','idm_resS.m') fullfile('idas','idm','idm_monitor.m') % fullfile('idas','idm','idm_resB.m') fullfile('idas','idm','idm_rhsQB.m') fullfile('idas','idm','idm_bjacB.m') fullfile('idas','idm','idm_djacB.m') fullfile('idas','idm','idm_jtvB.m') fullfile('idas','idm','idm_psetB.m') fullfile('idas','idm','idm_psolB.m') fullfile('idas','idm','idm_gcomB.m') fullfile('idas','idm','idm_glocB.m') fullfile('idas','idm','idm_monitorB.m') % fullfile('idas','idm',idmmex) }; idm_ftypes = { fullfile('idas','function_types','IDABandJacFn.m') fullfile('idas','function_types','IDABandJacFnB.m') fullfile('idas','function_types','IDADenseJacFn.m') fullfile('idas','function_types','IDADenseJacFnB.m') fullfile('idas','function_types','IDAGcommFn.m') fullfile('idas','function_types','IDAGcommFnB.m') fullfile('idas','function_types','IDAGlocalFn.m') fullfile('idas','function_types','IDAGlocalFnB.m') fullfile('idas','function_types','IDAJacTimesVecFn.m') fullfile('idas','function_types','IDAJacTimesVecFnB.m') fullfile('idas','function_types','IDAMonitorFn.m') fullfile('idas','function_types','IDAMonitorFnB.m') fullfile('idas','function_types','IDAPrecSetupFn.m') fullfile('idas','function_types','IDAPrecSetupFnB.m') fullfile('idas','function_types','IDAPrecSolveFn.m') fullfile('idas','function_types','IDAPrecSolveFnB.m') fullfile('idas','function_types','IDAQuadRhsFn.m') fullfile('idas','function_types','IDAQuadRhsFnB.m') fullfile('idas','function_types','IDAResFn.m') fullfile('idas','function_types','IDAResFnB.m') fullfile('idas','function_types','IDARootFn.m') fullfile('idas','function_types','IDASensResFn.m') }; idm_exs = { fullfile('idas','examples_ser','midasBruss_ASA_dns.m') fullfile('idas','examples_ser','midasBruss_dns.m') fullfile('idas','examples_ser','midasHeat2D_bnd.m') fullfile('idas','examples_ser','midasPendI1_dns.m') fullfile('idas','examples_ser','midasPendI2_dns.m') fullfile('idas','examples_ser','midasReInit_dns.m') fullfile('idas','examples_ser','midasRoberts_ASAi_dns.m') fullfile('idas','examples_ser','midasRoberts_dns.m') fullfile('idas','examples_ser','midasSlCrank_dns.m') fullfile('idas','examples_ser','midasSlCrank_FSA_dns.m') }; stb_files = [idm_files ; idm_ftypes ; idm_exs]; %if par % stb_files = [stb_files ; idm_exp]; %end fprintf('\n\n'); for i=1:length(stb_files) src = fullfile(stb,stb_files{i}); dest = fullfile(stbi,stb_files{i}); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); break; end end if (exist ('OCTAVE_VERSION')) idamon = fullfile('idas','IDAMonitor_octave.m'); idamonB = fullfile('idas','IDAMonitorB_octave.m'); else idamon = fullfile('idas','IDAMonitor.m'); idamonB = fullfile('idas','IDAMonitorB.m'); end src = fullfile(stb,idamon); dest = fullfile(stbi,'idas','IDAMonitor.m'); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); end src = fullfile(stb,idamonB); dest = fullfile(stbi,'idas','IDAMonitorB.m'); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); end %--------------------------------------------------------------------------------- % Installation of KINSOL files %--------------------------------------------------------------------------------- function [] = instKIM(stb, where, par) stbi = fullfile(where,'sundialsTB'); % Copy files to installation directory kimmex = ['kim.' mexext]; kim_files = { fullfile('kinsol','Contents.m') fullfile('kinsol','KINFree.m') fullfile('kinsol','KINGetStats.m') fullfile('kinsol','KINInit.m') fullfile('kinsol','KINSetOptions.m') fullfile('kinsol','KINSol.m') fullfile('kinsol','kim','Contents.m') fullfile('kinsol','kim','kim_bjac.m') fullfile('kinsol','kim','kim_djac.m') fullfile('kinsol','kim','kim_gcom.m') fullfile('kinsol','kim','kim_gloc.m') fullfile('kinsol','kim','kim_info.m') fullfile('kinsol','kim','kim_jtv.m') fullfile('kinsol','kim','kim_pset.m') fullfile('kinsol','kim','kim_psol.m') fullfile('kinsol','kim','kim_sys.m') fullfile('kinsol','kim',kimmex) }; kim_ftypes = { fullfile('kinsol','function_types','KINSysFn.m') fullfile('kinsol','function_types','KINBandJacFn.m') fullfile('kinsol','function_types','KINDenseJacFn.m') fullfile('kinsol','function_types','KINJacTimesVecFn.m') fullfile('kinsol','function_types','KINPrecSetupFn.m') fullfile('kinsol','function_types','KINPrecSolveFn.m') fullfile('kinsol','function_types','KINGcommFn.m') fullfile('kinsol','function_types','KINGlocalFn.m') }; kim_exs = { fullfile('kinsol','examples_ser','mkinDiagon_kry.m') fullfile('kinsol','examples_ser','mkinTest_dns.m') fullfile('kinsol','examples_ser','mkinFerTron_dns.m') fullfile('kinsol','examples_ser','mkinRoboKin_dns.m') }; kim_exp = { fullfile('kinsol','examples_par','mkinDiagon_kry_p.m') }; stb_files = [kim_files ; kim_ftypes ; kim_exs]; if par stb_files = [stb_files ; kim_exp]; end fprintf('\n\n'); for i=1:length(stb_files) src = fullfile(stb,stb_files{i}); dest = fullfile(stbi,stb_files{i}); fprintf('Install %s\n',dest); [success,msg,msgid] = copyfile(src,dest); if ~success disp(msg); break; end end sundials-2.5.0/sundialsTB/LICENSE0000600000175000017500000000550211741421121017263 0ustar sylvestresylvestreCopyright (c) 2005, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by Radu Serban, radu@llnl.gov UCRL-CODE-155978 All rights reserved. This file is part of sundialsTB. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/sundialsTB/nvector/0000755000175000017500000000000011767174700017764 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/nvector/N_VDotProd.m0000600000175000017500000000106511741421121022072 0ustar sylvestresylvestrefunction ret = N_VDotProd(x,y,comm) %N_VDotProd returns the dot product of two vectors % % Usage: RET = N_VDotProd ( X, Y [, COMM] ) % %If COMM is not present, N_VDotProd returns the dot product of the %local portions of X and Y. Otherwise, it returns the global dot %product. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 2 ret = dot(x,y); else ldot = dot(x,y); gdot = 0.0; MPI_Allreduce(ldot,gdot,'SUM',comm); ret = gdot; endsundials-2.5.0/sundialsTB/nvector/Contents.m0000600000175000017500000000132511741421121021710 0ustar sylvestresylvestre% SUNDIALS NVECTOR operations % % Functions: % % N_VMax - returns the largest element of x % N_VMaxNorm - returns the maximum norm of x % N_VMin - returns the smallest element of x % N_VDotProd - returns the dot product of two vectors % N_VWrmsNorm - returns the weighted root mean square norm of x % N_VWL2Norm - returns the weighted Euclidean L2 norm of x % N_VL1Norm - returns the L1 norm of x % % NOTE For serial vectors, all of the above operations default to % the corresponding MATLAB functions. For parallel vectors, they % can be used either on the local portion of the distributed vector % or on the global vector (in which case they will trigger an MPI % allreduce operation). sundials-2.5.0/sundialsTB/nvector/N_VMax.m0000600000175000017500000000102311741421121021236 0ustar sylvestresylvestrefunction ret = N_VMax(x,comm) %N_VMax returns the largest element of x % % Usage: RET = N_VMax ( X [, COMM] ) % %If COMM is not present, N_VMax returns the maximum value of %the local portion of X. Otherwise, it returns the global %maximum value. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 1 ret = max(x); else lmax = max(x); gmax = 0.0; MPI_Allreduce(lmax,gmax,'MAX',comm); ret = gmax; endsundials-2.5.0/sundialsTB/nvector/N_VWrmsNorm.m0000600000175000017500000000137411741421121022306 0ustar sylvestresylvestrefunction ret = N_VWrmsNorm(x,w,comm) %N_VWrmsNorm returns the weighted root mean square norm of x %with weight vector w: % sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})/N] % % Usage: RET = N_VWrmsNorm ( X, W [, COMM] ) % %If COMM is not present, N_VWrmsNorm returns the WRMS norm %of the local portion of X. Otherwise, it returns the global %WRMS norm.. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:11 $ if nargin == 2 ret = dot(x.^2,w.^2); ret = sqrt(ret/length(x)); else lnrm = dot(x.^2,w.^2); gnrm = 0.0; MPI_Allreduce(lnrm,gnrm,'SUM',comm); ln = length(x); gn = 0; MPI_Allreduce(ln,gn,'SUM',comm); ret = sqrt(gnrm/gn); end sundials-2.5.0/sundialsTB/nvector/N_VWL2Norm.m0000600000175000017500000000126111741421121021755 0ustar sylvestresylvestrefunction ret = N_VWL2Norm(x,w,comm) %N_VWL2Norm returns the weighted Euclidean L2 norm of x % with weight vector w: % sqrt [(sum (i = 0 to N-1) {(x[i]*w[i])^2})] % % Usage: RET = N_VWL2Norm ( X, W [, COMM] ) % %If COMM is not present, N_VWL2Norm returns the weighted L2 %norm of the local portion of X. Otherwise, it returns the %global weighted L2 norm.. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 2 ret = dot(x.^2,w.^2); ret = sqrt(ret); else lnrm = dot(x.^2,w.^2); gnrm = 0.0; MPI_Allreduce(lnrm,gnrm,'SUM',comm); ret = sqrt(gnrm); endsundials-2.5.0/sundialsTB/nvector/N_VL1Norm.m0000600000175000017500000000102211741421121021620 0ustar sylvestresylvestrefunction ret = N_VL1Norm(x,comm) %N_VL1Norm returns the L1 norm of x % % Usage: RET = N_VL1Norm ( X [, COMM] ) % %If COMM is not present, N_VL1Norm returns the L1 norm of %the local portion of X. Otherwise, it returns the global %L1 norm.. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 1 ret = norm(x,1); else lnrm = norm(x,1); gnrm = 0.0; MPI_Allreduce(lnrm,gnrm,'MAX',comm); ret = gnrm; endsundials-2.5.0/sundialsTB/nvector/N_VMaxNorm.m0000600000175000017500000000106711741421121022102 0ustar sylvestresylvestrefunction ret = N_VMaxNorm(x, comm) %N_VMaxNorm returns the L-infinity norm of x % % Usage: RET = N_VMaxNorm ( X [, COMM] ) % %If COMM is not present, N_VMaxNorm returns the L-infinity norm %of the local portion of X. Otherwise, it returns the global %L-infinity norm.. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 1 ret = norm(x,'inf'); else lnrm = norm(x,'inf'); gnrm = 0.0; MPI_Allreduce(lnrm,gnrm,'MAX',comm); ret = gnrm; endsundials-2.5.0/sundialsTB/nvector/N_VMin.m0000600000175000017500000000102211741421121021233 0ustar sylvestresylvestrefunction ret = N_VMin(x,comm) %N_VMin returns the smallest element of x % Usage: RET = N_VMin ( X [, COMM] ) % %If COMM is not present, N_VMin returns the minimum value of %the local portion of X. Otherwise, it returns the global %minimum value. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2006/01/06 19:00:10 $ if nargin == 1 ret = min(x); else lmin = min(x); gmin = 0.0; MPI_Allreduce(lmin,gmin,'MIN',comm); ret = gmin; endsundials-2.5.0/sundialsTB/nvector/src/0000755000175000017500000000000011767174700020553 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/nvector/src/nvm_serial.c0000600000175000017500000000154611741421121023034 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2012/03/07 21:41:19 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Vector constructors for the SUNDIALS Matlab interfaces. * ----------------------------------------------------------------- */ #include #include "nvm.h" #include void InitVectors() {} N_Vector NewVector(long int n) { N_Vector v; v = N_VNew_Serial(n); return(v); } sundials-2.5.0/sundialsTB/nvector/src/nvm.h0000600000175000017500000000214711741421121021500 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2012/03/07 21:41:19 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Header file for the MNVECTOR Matlab interface. * ----------------------------------------------------------------- */ #ifndef _NVM_H #define _NVM_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "mex.h" /* * ------------------ * Vector functions * ------------------ */ void InitVectors(); N_Vector NewVector(long int n); void PutData(N_Vector v, double *data, long int n); void GetData(N_Vector v, double *data, long int n); #ifdef __cplusplus } #endif #endif sundials-2.5.0/sundialsTB/nvector/src/nvm_parallel.c0000600000175000017500000000373211741421121023350 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2012/03/07 21:41:19 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Vector constructors for the SUNDIALS Matlab interfaces. * ----------------------------------------------------------------- */ #include #include #include "nvm.h" #include #include int sundials_VecType; MPI_Comm sundials_comm; void InitVectors() { const mxArray *mx_comm; char *str; /* Check if the Matlab global variable sundials_MPI_comm exists (mpirun and mpiruns set it) */ mx_comm = mexGetVariable("global", "sundials_MPI_comm"); if (mx_comm == NULL) { /* If it does not exist, set vector type to 1 (serial) */ sundials_VecType = 1; } else { /* If it does exist, set vector type to 2 (parallel) and set the MPI communicator */ sundials_VecType = 2; str = mxArrayToString(mx_comm); if (!strcmp(str,"NULL" )) sundials_comm = MPI_COMM_NULL ; else if (!strcmp(str,"WORLD" )) sundials_comm = MPI_COMM_WORLD ; else if (!strcmp(str,"SELF" )) sundials_comm = MPI_COMM_SELF ; else sundials_comm = *(MPI_Comm*)mxGetData(mx_comm); } } N_Vector NewVector(long int n) { N_Vector v; long int nlocal, nglobal; if (sundials_VecType == 1) { v = N_VNew_Serial((long int)n); } else { nlocal = n; MPI_Allreduce(&nlocal, &nglobal, 1, MPI_INT, MPI_SUM, sundials_comm); v = N_VNew_Parallel(sundials_comm, nlocal, nglobal); } return(v); } sundials-2.5.0/sundialsTB/nvector/src/nvm_ops.c0000600000175000017500000000205511741421121022352 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2012/03/07 21:41:19 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Vector constructors for the SUNDIALS Matlab interfaces. * ----------------------------------------------------------------- */ #include #include "nvm.h" void PutData(N_Vector v, double *data, long int n) { double *vdata; long int i; vdata = N_VGetArrayPointer(v); for(i=0;i2 % Hosts passed as an argument... if ~iscell(hosts) error('MPISTART: 3rd arg is not a cell'); end for i=1:length(hosts) if ~ischar(hosts{i}) error('MPISTART: 3rd arg is not cell-of-strings'); end end else % Get hosts from file specified in env. var. LAMBHOST bfile = getenv('LAMBHOST'); if isempty(bfile) error('MPISTART: cannot find list of hosts'); end hosts = readHosts(bfile); end % RPI if nargin>1 % RPI passed as an argument if ~ischar(rpi) error('MPISTART: 2nd arg is not a string') end % Get full rpi name, if single letter used rpi = rpi_str(rpi); if isempty(rpi) error('MPISTART: 2nd arg is not a known RPI') end else % Get RPI from env. var. LAM_MPI_SSI_rpi RPI = getenv('LAM_MPI_SSI_rpi'); if isempty(RPI) % If LAM_MPI_SSI_rpi not defined, use RPI='tcp' RPI = 'tcp'; end rpi = rpi_str(RPI); end % Number of slaves if nargin>0 if ~isreal(nslaves) || fix(nslaves)~=nslaves || nslaves>=length(hosts) error('MPISTART: 1st arg is not a valid #slaves') end else nslaves = length(hosts)-1; end %------------------------------ % LAMHALT % %------------------------------------------------------------- % reasons to lamhalt: % - not enough nodes (nslv+1) % NHL < NSLAVES+1 % - localhost not in list % weird - just lamboot (NHL=0) % - localhost not last in list % weird - just lamboot (NHL=0) %------------------------------------------------------------- % Lam Nodes Output [stat, LNO] = system('lamnodes'); if ~stat % already lambooted emptyflag = false; if isempty(LNO) % this shouldn't happen emptyflag=true; % it's MATLAB's fault I think fprintf('pushing stubborn MATLAB "system" call (lamnodes): '); end while isempty(LNO) || stat fprintf('.'); [stat, LNO] = system('lamnodes'); end if emptyflag fprintf('\n'); end LF = char(10); LNO = split(LNO,LF); % split lines in rows at \n [stat, NHL] = system('lamnodes|wc -l'); % Number of Hosts in Lamnodes emptyflag = false; % again, if isempty(NHL) % this shouldn't happen emptyflag=true; % it's MATLAB's fault I think fprintf('pushing stubborn MATLAB "system" call (lamnodes|wc): '); end while isempty(NHL) || stat fprintf('.'); [stat, NHL] = system('lamnodes|wc -l'); end if emptyflag fprintf('\n'); end NHL = str2num(NHL); if NHL ~= size(LNO,1) || ~ NHL>0 % Oh my, logic error NHL= 0; % pretend there are no nodes disp('MPISTART: internal logic error: lamboot') end % to force lamboot w/o lamhalt if isempty(findstr(LNO(end,:),'this_node')) % master computer last in list disp('MPISTART: local host is not last in nodelist, hope that''s right') beforeflag=0; for i=1:size(LNO,1) if ~isempty(findstr(LNO(i,:),'this_node')) beforeflag=1; break; % well, not 1st but it's there end end % we already warned the user if ~beforeflag % Oh my, incredible, not there NHL= 0; % pretend there are no nodes disp('MPISTART: local host not in LAM? lamboot') end end % to force lamboot w/o lamhalt if NHL > 0 % accurately account multiprocessors NCL = 0; % number of CPUs in lamnodes for i=1:size(LNO,1) % add the 2nd ":"-separated fields=split(LNO(i,:),':'); % field, ie, #CPUs NCL = NCL + str2num(fields(2,:)); end if NCL 0 % avoid lamhalt in weird cases disp('MPISTART: halting LAM') system('lamhalt'); % won't get caught on this end end end %------------------------------ % LAMBOOT %------------------------------------------------------------- % reasons to lamboot: % % - not lambooted yet % stat~=0 % - lamhalted above (or weird) % NHL < NSLAVES+1 (0 _is_ <) %------------------------------------------------------------- if stat || NHL % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2006/03/07 01:20:01 $ ih = isa(fct,'function_handle'); is = isa(fct,'char'); if ih sh = functions(fct); fct_str = sh.function; elseif is fct_str = fct; else error('mpirun:: Unrecognized function'); end if exist(fct_str) ~= 2 err_msg = sprintf('mpirun:: Function %s not in search path.',fct_str); error(err_msg); end nslaves = npe-1; mpistart(nslaves); debug = false; if (nargin > 2) & dbg debug = true; end cmd_slaves = sprintf('mpiruns(''%s'')',fct_str); if debug cmd = 'xterm'; args = {'-sb','-sl','5000','-e','matlab','-nosplash','-nojvm','-r',cmd_slaves}; else cmd = 'matlab'; args = {'-nosplash','-nojvm','-r',cmd_slaves}; end [info children errs] = MPI_Comm_spawn(cmd,args,nslaves,'NULL',0,'SELF'); [info NEWORLD] = MPI_Intercomm_merge(children,0); % Put the MPI communicator in the global workspace global sundials_MPI_comm; sundials_MPI_comm = NEWORLD; % Get rank of current process and put it in the global workspace [status mype] = MPI_Comm_rank(NEWORLD); global sundials_MPI_rank; sundials_MPI_rank = mype; % Call the user main program feval(fct,NEWORLD); % Clear the global MPI communicator variable clear sundials_MPI_comm sundials-2.5.0/sundialsTB/putils/Contents.m0000600000175000017500000000035511741421121021552 0ustar sylvestresylvestre% Parallel utilities for the Matlab SUNDIALS interfaces % % Functions: % % mpirun - runs parallel examples % mpiruns - runs the parallel example on a child MATLAB process % mpistart - lamboot and MPI_Init master (if required) sundials-2.5.0/sundialsTB/putils/mpiruns.m0000600000175000017500000000241611741421121021452 0ustar sylvestresylvestrefunction [] = mpiruns(fct) %MPIRUNS runs the parallel example on a child MATLAB process. % % Usage: MPIRUNS ( FCT ) % % This function should not be called directly. It is called % by mpirun on the spawned child processes. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2006/03/07 01:20:01 $ clc; [dummy hostname]=system('hostname'); fprintf('mpiruns :: child MATLAB process on %s\n',hostname); MPI_Init; MPI_Errhandler_set('WORLD','RETURN'); [info parent] = MPI_Comm_get_parent; fprintf('mpiruns :: waiting to merge MPI intercommunicators ... '); [info NEWORLD] = MPI_Intercomm_merge(parent,1); fprintf('OK!\n\n'); MPI_Errhandler_set(NEWORLD,'RETURN'); % Put the MPI communicator in the global workspace global sundials_MPI_comm; sundials_MPI_comm = NEWORLD; % Get rank of current process and put it in the global workspace [status mype] = MPI_Comm_rank(NEWORLD); global sundials_MPI_rank; sundials_MPI_rank = mype; fprintf('mpiruns :: MPI rank: %d\n\n',mype); fprintf('----------------------------------------------------------------\n\n'); % Call the user main program feval(fct,NEWORLD); % Clear the global MPI communicator variable clear sundials_MPI_comm % Finalize MPI on this slave MPI_Finalize;sundials-2.5.0/sundialsTB/kinsol/0000755000175000017500000000000011767174700017603 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/KINFree.m0000600000175000017500000000040211741421121021150 0ustar sylvestresylvestrefunction KINFree() %KINFree deallocates memory for the KINSOL solver. % % Usage: KINFree % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ mode = 6; kim(mode); sundials-2.5.0/sundialsTB/kinsol/examples_par/0000755000175000017500000000000011767174700022263 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/examples_par/mkinDiagon_kry_p.m0000600000175000017500000000527111741421121025702 0ustar sylvestresylvestrefunction [] = mkinDiagon_kry_p(comm) %mkinDiagon_kry_p - KINSOL example problem (parallel, GMRES) % Simple diagonal test, using user-supplied preconditioner setup and % solve routines. % % This example does a basic test of the solver by solving the system: % f(y) = 0 for % f(y) = y(i)^2 - i^2 % % No scaling is done. % An approximate diagonal preconditioner is used. % % See also: mpirun % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ [status npes] = MPI_Comm_size(comm); [status mype] = MPI_Comm_rank(comm); % Problem size nlocal = 32; neq = npes * nlocal; % Problem options fnormtol = 1.0e-5; scsteptol = 1.0e-4; maxl = 10; maxlrst = 2; msbset = 5; % User data structure data.mype = mype; % MPI id data.nlocal = nlocal; % local problem size data.P = []; % workspace for preconditioner options = KINSetOptions('UserData', data,... 'FuncNormTol', fnormtol,... 'ScaledStepTol',scsteptol,... 'LinearSolver','GMRES',.... 'KrylovMaxDim', maxl,... 'MaxNumRestarts', maxlrst,... 'MaxNumSetups', msbset,... 'PrecSetupFn',@psetfn,... 'PrecSolveFn',@psolfn); if mype==0 options = KINSetOptions(options,'Verbose',true); end KINInit(@sysfn, nlocal, options); % Initial guess and scale vector y0 = 2.0 * ([1:nlocal] + mype*nlocal); scale = ones(nlocal,1); % Solve problem using Inexact Newton strategy = 'None'; [status, y] = KINSol(y0, strategy, scale, scale); % Print solution if status < 0 fprintf('KINSOL failed. status = %d\n',status); else for i = 1:4:nlocal fprintf('%4d | %6.2f %6.2f %6.2f %6.2f\n',... i, y(i), y(i+1), y(i+2), y(i+3)); end end fprintf('DONE\n'); % Free memory KINFree; % ======================================================= function [fy, flag, new_data] = sysfn(y, data) nlocal = data.nlocal; mype = data.mype; baseadd = mype * nlocal; for i = 1:nlocal fy(i) = y(i)^2 - (i+baseadd)^2; end new_data = []; % data was not modified flag = 0; % success % ======================================================= function [flag, new_data] = psetfn(y,yscale,fy,fscale,data) nlocal = data.nlocal; for i = 1:nlocal P(i) = 0.5 / (y(i)+5.0); end new_data = data; new_data.P = P; flag = 0; % ======================================================= function [x, flag, new_data] = psolfn(y,yscale,fy,fscale,v,data) nlocal = data.nlocal; P = data.P; for i=1:nlocal x(i) = v(i) * P(i); end new_data = []; flag = 0; sundials-2.5.0/sundialsTB/kinsol/Contents.m0000600000175000017500000000207711741421121021534 0ustar sylvestresylvestre% KINSOL, nonlinear system solver % % Functions % KINSetOptions - creates an options structure for KINSOL. % KINInit - allocates and initializes memory for KINSOL. % KINSol - solves the nonlinear problem. % KINGetStats - returns statistics for the KINSOL solver % KINFree - deallocates memory for the KINSOL solver. % % User-supplied function types % KINSysFn - system function % KINDenseJacFn - dense Jacobian function % KINJacTimesVecFn - Jacobian times vector function % KINPrecSetupFn - preconditioner setup function % KINPrecSolveFn - preconditioner solve function % KINGlocalFn - RHS approximation function (BBDPre) % KINGcomFn - communication function (BBDPre) % % Serial examples % mkinDiagon_kry - simple serial diagonal example % mkinTest_dns - simple 2 dimensional example % mkinRoboKin - robot kinematics problem % % Parallel examples % mkinDiagon_kry_p - simple parallel diagonal example % Use the mpirun function to run any of the parallel examples % % See also nvector, putils sundials-2.5.0/sundialsTB/kinsol/KINSetOptions.m0000600000175000017500000003411411741421121022405 0ustar sylvestresylvestrefunction options = KINSetOptions(varargin) %KINSetOptions creates an options structure for KINSOL. % % Usage: % % options = KINSetOptions('NAME1',VALUE1,'NAME2',VALUE2,...) creates a KINSOL % options structure options in which the named properties have the % specified values. Any unspecified properties have default values. It is % sufficient to type only the leading characters that uniquely identify the % property. Case is ignored for property names. % % options = KINSetOptions(oldoptions,'NAME1',VALUE1,...) alters an existing % options structure oldoptions. % % options = KINSetOptions(oldoptions,newoptions) combines an existing options % structure oldoptions with a new options structure newoptions. Any new % properties overwrite corresponding old properties. % % KINSetOptions with no input arguments displays all property names and their % possible values. % %KINSetOptions properties %(See also the KINSOL User Guide) % %UserData - User data passed unmodified to all functions [ empty ] % If UserData is not empty, all user provided functions will be % passed the problem data as their last input argument. For example, % the SYS function must be defined as FY = SYSFUN(Y,DATA). % %MaxNumIter - maximum number of nonlinear iterations [ scalar | {200} ] % Specifies the maximum number of iterations that the nonlinar solver is allowed % to take. %FuncRelErr - relative residual error [ scalar | {eps} ] % Specifies the realative error in computing f(y) when used in difference % quotient approximation of matrix-vector product J(y)*v. %FuncNormTol - residual stopping criteria [ scalar | {eps^(1/3)} ] % Specifies the stopping tolerance on ||fscale*ABS(f(y))||_L-infinity %ScaledStepTol - step size stopping criteria [ scalar | {eps^(2/3)} ] % Specifies the stopping tolerance on the maximum scaled step length: % || y_(k+1) - y_k || % || ------------------ ||_L-infinity % || |y_(k+1)| + yscale || %MaxNewtonStep - maximum Newton step size [ scalar | {0.0} ] % Specifies the maximum allowable value of the scaled length of the Newton step. %InitialSetup - initial call to linear solver setup [ false | {true} ] % Specifies whether or not KINSol makes an initial call to the linear solver % setup function. %MaxNumSetups - [ scalar | {10} ] % Specifies the maximum number of nonlinear iterations between calls to the % linear solver setup function (i.e. Jacobian/preconditioner evaluation) %MaxNumSubSetups - [ scalar | {5} ] % Specifies the maximum number of nonlinear iterations between checks by the % nonlinear residual monitoring algorithm (specifies length of subintervals). % NOTE: MaxNumSetups should be a multiple of MaxNumSubSetups. %MaxNumBetaFails - maximum number of beta-condition failures [ scalar | {10} ] % Specifies the maximum number of beta-condiiton failures in the line search % algorithm. %EtaForm - Inexact Newton method [ Constant | Type2 | {Type1} ] % Specifies the method for computing the eta coefficient used in the calculation % of the linear solver convergence tolerance (used only if strategy='InexactNEwton' % in the call to KINSol): % lintol = (eta + eps)*||fscale*f(y)||_L2 % which is the used to check if the following inequality is satisfied: % ||fscale*(f(y)+J(y)*p)||_L2 <= lintol % Valid choices are: % | ||f(y_(k+1))||_L2 - ||f(y_k)+J(y_k)*p_k||_L2 | % EtaForm='Type1' eta = ------------------------------------------------ % ||f(y_k)||_L2 % % [ ||f(y_(k+1))||_L2 ]^alpha % EtaForm='Type2' eta = gamma * [ ----------------- ] % [ ||f(y_k)||_L2 ] % EtaForm='Constant' %Eta - constant value for eta [ scalar | {0.1} ] % Specifies the constant value for eta in the case EtaForm='Constant'. %EtaAlpha - alpha parameter for eta [ scalar | {2.0} ] % Specifies the parameter alpha in the case EtaForm='Type2' %EtaGamma - gamma parameter for eta [ scalar | {0.9} ] % Specifies the parameter gamma in the case EtaForm='Type2' %MinBoundEps - lower bound on eps [ false | {true} ] % Specifies whether or not the value of eps is bounded below by 0.01*FuncNormtol. %Constraints - solution constraints [ vector ] % Specifies additional constraints on the solution components. % Constraints(i) = 0 : no constrain on y(i) % Constraints(i) = 1 : y(i) >= 0 % Constraints(i) = -1 : y(i) <= 0 % Constraints(i) = 2 : y(i) > 0 % Constraints(i) = -2 : y(i) < 0 % If Constraints is not specified, no constraints are applied to y. % %LinearSolver - Type of linear solver [ {Dense} | Band | GMRES | BiCGStab | TFQMR ] % Specifies the type of linear solver to be used for the Newton nonlinear solver. % Valid choices are: Dense (direct, dense Jacobian), GMRES (iterative, scaled % preconditioned GMRES), BiCGStab (iterative, scaled preconditioned stabilized % BiCG), TFQMR (iterative, scaled preconditioned transpose-free QMR). % The GMRES, BiCGStab, and TFQMR are matrix-free linear solvers. %JacobianFn - Jacobian function [ function ] % This propeerty is overloaded. Set this value to a function that returns % Jacobian information consistent with the linear solver used (see Linsolver). % If not specified, KINSOL uses difference quotient approximations. % For the Dense linear solver, JacobianFn must be of type KINDenseJacFn and must % return a dense Jacobian matrix. For the iterative linear solvers, GMRES, % BiCGStab, or TFQMR, JacobianFn must be of type KINJactimesVecFn and must return % a Jacobian-vector product. %KrylovMaxDim - Maximum number of Krylov subspace vectors [ scalar | {10} ] % Specifies the maximum number of vectors in the Krylov subspace. This property % is used only if an iterative linear solver, GMRES, BiCGStab, or TFQMR is used % (see LinSolver). %MaxNumRestarts - Maximum number of GMRES restarts [ scalar | {0} ] % Specifies the maximum number of times the GMRES (see LinearSolver) solver % can be restarted. %PrecModule - Built-in preconditioner module [ BBDPre | {UserDefined} ] % If the PrecModule = 'UserDefined', then the user must provide at least a % preconditioner solve function (see PrecSolveFn) % KINSOL provides a built-in preconditioner module, BBDPre which can only be used % with parallel vectors. It provide a preconditioner matrix that is block-diagonal % with banded blocks. The blocking corresponds to the distribution of the variable % vector among the processors. Each preconditioner block is generated from the % Jacobian of the local part (on the current processor) of a given function g(t,y) % approximating f(y) (see GlocalFn). The blocks are generated by a difference % quotient scheme on each processor independently. This scheme utilizes an assumed % banded structure with given half-bandwidths, mldq and mudq (specified through % LowerBwidthDQ and UpperBwidthDQ, respectively). However, the banded Jacobian % block kept by the scheme has half-bandwiths ml and mu (specified through % LowerBwidth and UpperBwidth), which may be smaller. %PrecSetupFn - Preconditioner setup function [ function ] % PrecSetupFn specifies an optional function which, together with PrecSolve, % defines a right preconditioner matrix which is an aproximation % to the Newton matrix. PrecSetupFn must be of type KINPrecSetupFn. %PrecSolveFn - Preconditioner solve function [ function ] % PrecSolveFn specifies an optional function which must solve a linear system % Pz = r, for given r. If PrecSolveFn is not defined, the no preconditioning will % be used. PrecSolveFn must be of type KINPrecSolveFn. %GlocalFn - Local right-hand side approximation funciton for BBDPre [ function ] % If PrecModule is BBDPre, GlocalFn specifies a required function that % evaluates a local approximation to the system function. GlocalFn must % be of type KINGlocalFn. %GcommFn - Inter-process communication function for BBDPre [ function ] % If PrecModule is BBDPre, GcommFn specifies an optional function % to perform any inter-process communication required for the evaluation of % GlocalFn. GcommFn must be of type KINGcommFn. %LowerBwidth - Jacobian/preconditioner lower bandwidth [ scalar | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the lower half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in KINSOL is used % (see PrecModule), it specifies the lower half-bandwidth of the retained % banded approximation of the local Jacobian block. % LowerBwidth defaults to 0 (no sub-diagonals). %UpperBwidth - Jacobian/preconditioner upper bandwidth [ scalar | {0} ] % This property is overloaded. If the Band linear solver is used (see LinSolver), % it specifies the upper half-bandwidth of the band Jacobian approximation. % If one of the three iterative linear solvers, GMRES, BiCGStab, or TFQMR is used % (see LinSolver) and if the BBDPre preconditioner module in KINSOL is used % (see PrecModule), it specifies the upper half-bandwidth of the retained % banded approximation of the local Jacobian block. % UpperBwidth defaults to 0 (no super-diagonals). %LowerBwidthDQ - BBDPre preconditioner DQ lower bandwidth [ scalar | {0} ] % Specifies the lower half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). %UpperBwidthDQ - BBDPre preconditioner DQ upper bandwidth [ scalar | {0} ] % Specifies the upper half-bandwidth used in the difference-quotient Jacobian % approximation for the BBDPre preconditioner (see PrecModule). % %Verbose - verbose output [ true | {false} ] % Specifies whether or not KINSOL should output additional information %ErrorMessages - Post error/warning messages [ false | {true} ] % Note that any errors in KINInit will result in a Matlab error, thus % stoping execution. Only subsequent calls to KINSOL functions will respect % the value specified for 'ErrorMessages'. % % See also % KINDenseJacFn, KINJacTimesVecFn % KINPrecSetupFn, KINPrecSolveFn % KINGlocalFn, KINGcommFn % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.5 $Date: 2011/06/01 21:11:01 $ % Based on Matlab's ODESET function % Print out possible values of properties. if (nargin == 0) & (nargout == 0) fprintf(' UserData: [ empty ]\n'); fprintf('\n'); fprintf(' MaxNumIter: [ scalar | {200} ]\n'); fprintf(' FuncRelErr: [ scalar | {eps} ]\n'); fprintf(' FuncNormTol: [ scalar | {eps^(1/3)} ]\n'); fprintf(' ScaledStepTol: [ scalar | {eps^(2/3)} ]\n'); fprintf(' MaxNewtonStep: [ scalar | {0.0} ]\n'); fprintf(' InitialSetup: [ false | {true} ]\n'); fprintf(' MaxNumSetups: [ scalar | {10} ]\n'); fprintf(' MaxNumSubSetups: [ scalar | {5} ]\n'); fprintf(' MaxNumBetaFails: [ scalar | {10} ]\n'); fprintf(' EtaForm: [ Constant | Type2 | {Type1} ]\n'); fprintf(' Eta: [ scalar | {0.1} ]\n'); fprintf(' EtaAlpha: [ scalar | {2.0} ]\n'); fprintf(' EtaGamma: [ scalar | {0.9} ]\n'); fprintf(' MinBoundEps: [ false | {true} ]\n'); fprintf(' Constraints: [ array of scalar ]\n'); fprintf('\n'); fprintf(' LinearSolver: [ {Dense} | Band | GMRES | BiCGStab | TFQMR ]\n'); fprintf(' JacobianFn: [ function ]\n'); fprintf(' KrylovMaxDim: [ scalar | {10} ]'); fprintf(' MaxNumRestarts: [ Classical | {Modified} ]\n'); fprintf(' PrecModule: [ BBDPre | {UserDefined} ]\n'); fprintf(' PrecSetupFn: [ function ]\n'); fprintf(' PrecSolveFn: [ function ]\n'); fprintf(' GlocalFn: [ function ]\n'); fprintf(' GcommFn: [ function ]\n'); fprintf(' LowerBwidth: [ scalar | {0} ]\n'); fprintf(' UpperBwidth: [ scalar | {0} ]\n'); fprintf(' LowerBwidthDQ: [ scalar | {0} ]\n'); fprintf(' UpperBwidthDQ: [ scalar | {0} ]\n'); fprintf('\n'); fprintf(' Verbose: [ true | {false} ]\n'); fprintf(' ErrorMessages: [ false | {true} ]\n'); fprintf('\n'); return; end KeyNames = { 'UserData' 'MaxNumIter' 'MaxNumSetups' 'MaxNumSubSetups' 'MaxNumBetaFails' 'EtaForm' 'Eta' 'EtaAlpha' 'EtaGamma' 'MaxNewtonStep' 'FuncRelErr' 'FuncNormTol' 'ScaledStepTol' 'InitialSetup' 'MinBoundEps' 'Constraints' 'LinearSolver' 'JacobianFn' 'PrecType' 'PrecModule' 'PrecSetupFn' 'PrecSolveFn' 'GlocalFn' 'GcommFn' 'KrylovMaxDim' 'MaxNumRestarts' 'LowerBwidthDQ' 'UpperBwidthDQ' 'LowerBwidth' 'UpperBwidth' 'Verbose' 'ErrorMessages' }; options = cvm_options(KeyNames,varargin{:}); return; % % Actual option processing % ------------------------ function options = kim_options(KeyNames, varargin) m = length(KeyNames); % Initialize the output options structure options = []; for i = 1:m options.(KeyNames{i}) = []; end % If the first argument is an options structure, read its non-empty fields % and update options. Store in j the start of key-value pairs. arg = varargin{1}; if isa(arg,'struct') for i = 1:m if isfield(arg,KeyNames{i}) options.(KeyNames{i}) = arg.(KeyNames{i}); end end j = 2; else j = 1; end % The remaining input arguments must be key-value pairs if rem(nargin-j,2) ~= 0 error('Arguments must be key-value pairs.'); end % Process each key-value pair np = (nargin-j)/2; keynames = lower(KeyNames); for i = 1:np % Get the key key = varargin{j}; % key must be a string if ~isstr(key) error(sprintf('Argument %d is not a string property name.', j)); end % Get the index in keynames that exactly matches the current key % (modulo the case) ik = strmatch(lower(key), keynames, 'exact'); if isempty(ik) error(sprintf('Unrecognized property "%s"', key)); end % Get the value val = varargin{j+1}; % Set the proper field in options options.(KeyNames{ik}) = val; % move to next pair j = j+2; end return; sundials-2.5.0/sundialsTB/kinsol/kim/0000755000175000017500000000000011767174700020363 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/kim/kim_gcom.m0000600000175000017500000000033411741421121022276 0ustar sylvestresylvestrefunction [flag, new_data] = kim_gcom(y, f, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,y); new_data = []; else [flag, new_data] = feval(fct,y,data); end sundials-2.5.0/sundialsTB/kinsol/kim/Contents.m0000600000175000017500000000011111741421121022277 0ustar sylvestresylvestre% MEX binding of KINSOL functions % %-- Radu Serban @ LLNL -- April 2005 sundials-2.5.0/sundialsTB/kinsol/kim/kim_psol.m0000600000175000017500000000045211741421121022327 0ustar sylvestresylvestrefunction [ret, flag, new_data] = kim_psol(y, yscale, fy, fscale, v, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [ret, flag] = feval(fct,y,yscale,fy,fscale,v); new_data = []; else [ret, flag, new_data] = feval(fct,y,yscale,fy,fscale,v,data); end sundials-2.5.0/sundialsTB/kinsol/kim/kim_info.m0000600000175000017500000000323611741421121022310 0ustar sylvestresylvestrefunction varargout = kim_info(action, fin, message); switch action case 0 % initialize % Create figure f = figure; set(f,'resizefcn','kim_info(2,0,0)'); set(f,'name','KINSOL info','numbertitle','off'); set(f,'menubar','none','tag','figure'); % Create text box tbpos=getTBPos(f); h=uicontrol(f,'style','listbox','position',tbpos,'tag','textbox'); set(h,'BackgroundColor',[1 1 1]); set(h,'SelectionHighlight','off'); % Create OK button bpos=getOKPos(f); h=uicontrol(f,'style','pushbutton','position',bpos,'string','Close','tag','okaybutton'); set(h,'callback','kim_info(3,0,0)'); % Save handles handles=guihandles(f); guidata(f,handles); varargout{1} = f; case 1 % append text f = fin; new_str = message; handles=guidata(f); string = get(handles.textbox,'String'); string{end+1}=new_str; set(handles.textbox,'String',string); case 2 % resize handles=guidata(gcbo); tbpos=getTBPos(handles.figure); bpos=getOKPos(handles.figure); set(handles.okaybutton,'position',bpos); set(handles.textbox,'position',tbpos); case 3 % close handles=guidata(gcbo); close(handles.figure); end %------------------------------------ function tbpos=getTBPos(f) margins=[10 10 10 50]; % left, right, top, bottom pos=get(f,'position'); tbpos=[margins(1) margins(4) pos(3)-margins(1)-margins(2) ... pos(4)-margins(3)-margins(4)]; tbpos(tbpos<1)=1; %------------------------------------ function tbpos=getOKPos(f) bsize=[60,30]; badjustpos=[0,25]; pos=get(f,'position'); tbpos=[pos(3)/2-bsize(1)/2+badjustpos(1) -bsize(2)/2+badjustpos(2)... bsize(1) bsize(2)]; tbpos=round(tbpos); tbpos(tbpos<1)=1; sundials-2.5.0/sundialsTB/kinsol/kim/kim_djac.m0000600000175000017500000000037011741421121022252 0ustar sylvestresylvestrefunction [ret, flag, new_data] = kim_djac(y, fy, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [ret, flag] = feval(fct,y,fy); new_data = []; else [ret, flag, new_data] = feval(fct,y,fy,data); end sundials-2.5.0/sundialsTB/kinsol/kim/kim_jtv.m0000600000175000017500000000043411741421121022155 0ustar sylvestresylvestrefunction [ret, new_y, flag, new_data] = kim_jtv(y, v, new_y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [ret, new_y, flag] = feval(fct,y,v,new_y); new_data = []; else [ret, new_y, flag, new_data] = feval(fct,y,v,new_y,data); end sundials-2.5.0/sundialsTB/kinsol/kim/kim_sys.m0000600000175000017500000000035611741421121022173 0ustar sylvestresylvestrefunction [ret, flag, new_data] = kim_sys(y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [ret, flag] = feval(fct,y); new_data = []; else [ret, flag, new_data] = feval(fct,y,data); end sundials-2.5.0/sundialsTB/kinsol/kim/kim_gloc.m0000600000175000017500000000036111741421121022275 0ustar sylvestresylvestrefunction [gval, flag, new_data] = kim_gloc(y, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [gval, flag] = feval(fct,y); new_data = []; else [gval, flag, new_data] = feval(fct,y,data); end sundials-2.5.0/sundialsTB/kinsol/kim/src/0000755000175000017500000000000011767174700021152 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/kim/src/kim.c0000600000175000017500000005362411741421121022060 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2012/03/07 21:50:32 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/cvodes/LICENSE. * ----------------------------------------------------------------- * MEX implementation for KINSOL Matlab interface. * ----------------------------------------------------------------- */ #include #include #include "kim.h" #include "nvm.h" /* * --------------------------------------------------------------------------------- * Global interface data variable * --------------------------------------------------------------------------------- */ kimInterfaceData kimData = NULL; /* * --------------------------------------------------------------------------------- * Static function prototypes * --------------------------------------------------------------------------------- */ static void kimInitKINSOLdata(); static void kimPersistKINSOLdata(); static void kimFinalKINSOLdata(); static int KIM_Initialization(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int KIM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int KIM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int KIM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int KIM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); static int KIM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]); /* * --------------------------------------------------------------------------------- * Main entry point * --------------------------------------------------------------------------------- */ void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[] ) { int mode; /* Modes: 1 - initialize KINSOL solver 2 - solve problem 3 - get solver stats 4 - extract data from kin_mem 5 - set one optional input at a time 6 - finalize */ mode = (int)mxGetScalar(prhs[0]); mexUnlock(); if ( (mode != 1) && (kimData == NULL) ) { mexErrMsgTxt("KINSOL - Illegal attempt to call before KINInit."); } switch(mode) { case 1: if (kimData != NULL) { KIM_Free(nlhs, plhs, nrhs-1, &prhs[1]); kimFinalKINSOLdata(); } kimInitKINSOLdata(); KIM_Initialization(nlhs, plhs, nrhs-1, &prhs[1]); break; case 2: KIM_Solve(nlhs, plhs, nrhs-1, &prhs[1]); break; case 3: KIM_Stats(nlhs, plhs, nrhs-1, &prhs[1]); break; case 4: KIM_Get(nlhs, plhs, nrhs-1, &prhs[1]); break; case 5: KIM_Set(nlhs, plhs, nrhs-1, &prhs[1]); break; case 6: KIM_Free(nlhs, plhs, nrhs-1, &prhs[1]); kimFinalKINSOLdata(); break; } /* Unless this was the KINFree call, * make data persistent and lock the MEX file */ if (mode != 6) { kimPersistKINSOLdata(); mexLock(); } return; } /* * --------------------------------------------------------------------------------- * Private functions to deal with the global data * --------------------------------------------------------------------------------- */ static void kimInitKINSOLdata() { mxArray *empty; /* Allocate space for global KINSOL data structure */ kimData = (kimInterfaceData) mxMalloc(sizeof(struct kimInterfaceData_)); /* Initialize global KINSOL data */ kimData->kin_mem = NULL; kimData->n = 0; kimData->Y = NULL; kimData->LS = LS_DENSE; kimData->PM = PM_NONE; kimData->errMsg = TRUE; /* Initialize Matlab mex arrays to empty */ empty = mxCreateDoubleMatrix(0,0,mxREAL); kimData->SYSfct = mxDuplicateArray(empty); kimData->JACfct = mxDuplicateArray(empty); kimData->PSETfct = mxDuplicateArray(empty); kimData->PSOLfct = mxDuplicateArray(empty); kimData->GLOCfct = mxDuplicateArray(empty); kimData->GCOMfct = mxDuplicateArray(empty); kimData->mtlb_data = mxDuplicateArray(empty); mxDestroyArray(empty); return; } static void kimPersistKINSOLdata() { /* Make global memory persistent */ mexMakeArrayPersistent(kimData->mtlb_data); mexMakeArrayPersistent(kimData->SYSfct); mexMakeArrayPersistent(kimData->JACfct); mexMakeArrayPersistent(kimData->PSETfct); mexMakeArrayPersistent(kimData->PSOLfct); mexMakeArrayPersistent(kimData->GLOCfct); mexMakeArrayPersistent(kimData->GCOMfct); mexMakeMemoryPersistent(kimData); return; } static void kimFinalKINSOLdata() { if (kimData == NULL) return; if (kimData->Y != NULL) N_VDestroy(kimData->Y); mxDestroyArray(kimData->mtlb_data); mxDestroyArray(kimData->SYSfct); mxDestroyArray(kimData->JACfct); mxDestroyArray(kimData->PSETfct); mxDestroyArray(kimData->PSOLfct); mxDestroyArray(kimData->GLOCfct); mxDestroyArray(kimData->GCOMfct); mxFree(kimData); kimData = NULL; return; } /* * --------------------------------------------------------------------------------- * Error handler function. * * This function is both passed as the KINSOL error handler and used throughout * the Matlab interface. * * If called directly by one of the interface functions, error_code = -999 to * indicate an error and err_code = +999 to indicate a warning. Otherwise, * err_code is set by the calling KINSOL function. * * NOTE: mexErrMsgTxt will end the execution of the MEX file. Therefore we do * not have to intercept any of the KINSOL error return flags. * The only return flags we intercept are those from CVode() and CVodeB() * which are passed back to the user (only positive values will make it). * --------------------------------------------------------------------------------- */ void kimErrHandler(int error_code, const char *module, const char *function, char *msg, void *eh_data) { char err_msg[256]; if (!(kimData->errMsg)) return; if (error_code > 0) { sprintf(err_msg,"Warning in ==> %s\n%s",function,msg); mexWarnMsgTxt(err_msg); } else if (error_code < 0) { /*mexUnlock(); kimFinalKINSOLdata();*/ sprintf(err_msg,"Error using ==> %s\n%s",function,msg); mexErrMsgTxt(err_msg); } return; } /* * --------------------------------------------------------------------------------- * Info handler function * * This function is passed as the KINSOL info handler if verbose output was * requested. It is a wrapper around the Matlab m-file kim_info.m which posts * all info messages to a separate Matlab figure. * --------------------------------------------------------------------------------- */ void kimInfoHandler(const char *module, const char *function, char *msg, void *ih_data) { char my_msg[400]; mxArray *mx_in[3]; sprintf(my_msg,"[%s] %s\n %s\n",module,function,msg); /* action=1 -> append */ mx_in[0] = mxCreateDoubleScalar(1); mx_in[1] = mxCreateDoubleScalar((double)kimData->fig_handle); mx_in[2] = mxCreateString(my_msg); mexCallMATLAB(0,NULL,3,mx_in,"kim_info"); } /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define kin_mem (kimData->kin_mem) #define y (kimData->Y) #define N (kimData->n) #define ls (kimData->LS) #define pm (kimData->PM) #define mtlb_data (kimData->mtlb_data) #define mtlb_SYSfct (kimData->SYSfct) #define mtlb_JACfct (kimData->JACfct) #define mtlb_PSETfct (kimData->PSETfct) #define mtlb_PSOLfct (kimData->PSOLfct) #define mtlb_GLOCfct (kimData->GLOCfct) #define mtlb_GCOMfct (kimData->GCOMfct) /* * --------------------------------------------------------------------------------- * Interface procedures * --------------------------------------------------------------------------------- */ static int KIM_Initialization(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { const mxArray *options; mxArray *mx_in[3], *mx_out[2]; int status; int mxiter, msbset, msbsetsub, etachoice, mxnbcf; double eta, egamma, ealpha, mxnewtstep, relfunc, fnormtol, scsteptol; booleantype verbose, errmsg, noInitSetup, noMinEps; double *constraints; N_Vector NVconstraints; int ptype; long int mudq, mldq, mupper, mlower; int maxl, maxrs; double dqrely; /* * ------------------------------------ * Initialize appropriate vector module * ------------------------------------ */ InitVectors(); /* * ---------------------------- * Extract stuff from arguments * ---------------------------- */ /* Matlab user-provided function */ mxDestroyArray(mtlb_SYSfct); mtlb_SYSfct = mxDuplicateArray(prhs[0]); /* Problem dimension */ N = (long int) mxGetScalar(prhs[1]); /* Solver Options (may be empty) */ options = prhs[2]; /* Create the solution N_Vector */ y = NewVector(N); /* * ----------------------------- * Process the options structure * ----------------------------- */ status = get_SolverOptions(options, &verbose, &errmsg, &mxiter, &msbset, &msbsetsub, &etachoice, &mxnbcf, &eta, &egamma, &ealpha, &mxnewtstep, &relfunc, &fnormtol, &scsteptol, &constraints, &noInitSetup, &noMinEps); if (status != 0) goto error_return; /* * ------------------------------------------------------ * Create KINSOL object, allocate memory, and set options * ------------------------------------------------------ */ kin_mem = KINCreate(); if (kin_mem == NULL) goto error_return; /* Attach the global KINSOL data as 'user_data' */ status = KINSetUserData(kin_mem, kimData); if (status != KIN_SUCCESS) goto error_return; /* Attach error handler function */ status = KINSetErrHandlerFn(kin_mem, kimErrHandler, NULL); if (status != KIN_SUCCESS) goto error_return; /* If verbose was set to TRUE */ if (verbose) { /* Set print level to its highest value */ status = KINSetPrintLevel(kin_mem,3); if (status != KIN_SUCCESS) goto error_return; /* Attach info handler function */ status = KINSetInfoHandlerFn(kin_mem, kimInfoHandler, NULL); if (status != KIN_SUCCESS) goto error_return; /* Initialize the output window and store the figure handle */ mx_in[0] = mxCreateDoubleScalar(0); /* action=0, initialize */ mx_in[1] = mxCreateDoubleScalar(0); /* ignored */ mx_in[2] = mxCreateDoubleScalar(0); /* ignored */ mexCallMATLAB(1,mx_out,3,mx_in,"kim_info"); kimData->fig_handle = (int)*mxGetPr(mx_out[0]); } /* Call KINInit */ status = KINInit(kin_mem, mxW_KINSys, y); if (status != KIN_SUCCESS) goto error_return; /* Redirect output */ status = KINSetErrFile(kin_mem, stdout); if (status != KIN_SUCCESS) goto error_return; /* Optional inputs */ status = KINSetNumMaxIters(kin_mem, mxiter); if (status != KIN_SUCCESS) goto error_return; status = KINSetNoInitSetup(kin_mem, noInitSetup); if (status != KIN_SUCCESS) goto error_return; status = KINSetNoMinEps(kin_mem, noMinEps); if (status != KIN_SUCCESS) goto error_return; status = KINSetMaxSetupCalls(kin_mem, msbset); if (status != KIN_SUCCESS) goto error_return; status = KINSetMaxSubSetupCalls(kin_mem, msbsetsub); if (status != KIN_SUCCESS) goto error_return; status = KINSetMaxBetaFails(kin_mem, mxnbcf); if (status != KIN_SUCCESS) goto error_return; status = KINSetEtaForm(kin_mem, etachoice); if (status != KIN_SUCCESS) goto error_return; status = KINSetEtaConstValue(kin_mem, eta); if (status != KIN_SUCCESS) goto error_return; status = KINSetEtaParams(kin_mem, egamma, ealpha); if (status != KIN_SUCCESS) goto error_return; status = KINSetMaxNewtonStep(kin_mem, mxnewtstep); if (status != KIN_SUCCESS) goto error_return; status = KINSetRelErrFunc(kin_mem, relfunc); if (status != KIN_SUCCESS) goto error_return; status = KINSetFuncNormTol(kin_mem, fnormtol); if (status != KIN_SUCCESS) goto error_return; status = KINSetScaledStepTol(kin_mem, scsteptol); if (status != KIN_SUCCESS) goto error_return; /* Constraints */ if (constraints != NULL) { NVconstraints = N_VCloneEmpty(y); N_VSetArrayPointer(constraints, NVconstraints); status = KINSetConstraints(kin_mem, NVconstraints); if (status != KIN_SUCCESS) goto error_return; N_VDestroy(NVconstraints); } /* * -------------------- * Attach linear solver * -------------------- */ status = get_LinSolvOptions(options, &mupper, &mlower, &mudq, &mldq, &dqrely, &ptype, &maxrs, &maxl); if (status != 0) goto error_return; switch (ls) { case LS_NONE: kimErrHandler(-999, "KINSOL", "KINInit", "No linear solver was specified.", NULL); goto error_return; case LS_DENSE: status = KINDense(kin_mem, N); if (status != KIN_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = KINDlsSetDenseJacFn(kin_mem, mxW_KINDenseJac); if (status != KIN_SUCCESS) goto error_return; } break; case LS_BAND: status = KINBand(kin_mem, N, mupper, mlower); if (status != KIN_SUCCESS) goto error_return; if (!mxIsEmpty(mtlb_JACfct)) { status = KINDlsSetBandJacFn(kin_mem, mxW_KINBandJac); if (status != KIN_SUCCESS) goto error_return; } break; case LS_SPGMR: status = KINSpgmr(kin_mem, maxl); if (status != KIN_SUCCESS) goto error_return; status = KINSpilsSetMaxRestarts(kin_mem, maxrs); if (status != KIN_SUCCESS) goto error_return; break; case LS_SPBCG: status = KINSpbcg(kin_mem, maxl); if (status != KIN_SUCCESS) goto error_return; break; case LS_SPTFQMR: status = KINSptfqmr(kin_mem, maxl); if (status != KIN_SUCCESS) goto error_return; break; } /* Jacobian * vector and preconditioner for SPILS linear solvers */ if ( (ls==LS_SPGMR) || (ls==LS_SPBCG) || (ls==LS_SPTFQMR) ) { if (!mxIsEmpty(mtlb_JACfct)) { status = KINSpilsSetJacTimesVecFn(kin_mem, mxW_KINSpilsJac); if (status != KIN_SUCCESS) goto error_return; } switch (pm) { case PM_NONE: if (!mxIsEmpty(mtlb_PSOLfct)) { if (!mxIsEmpty(mtlb_PSETfct)) status = KINSpilsSetPreconditioner(kin_mem, mxW_KINSpilsPset, mxW_KINSpilsPsol); else status = KINSpilsSetPreconditioner(kin_mem, NULL, mxW_KINSpilsPsol); if (status != KIN_SUCCESS) goto error_return; } break; case PM_BBDPRE: if (!mxIsEmpty(mtlb_GCOMfct)) status = KINBBDPrecInit(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_KINGloc, mxW_KINGcom); else status = KINBBDPrecInit(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mxW_KINGloc, NULL); if (status != KIN_SUCCESS) goto error_return; break; } } /* Set errMsg field in global data * (all error messages from here on will respect this) */ kimData->errMsg = errmsg; /* Successfull return */ status = 0; plhs[0] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); return(-1); } static int KIM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { double *y0, *ys, *fs; N_Vector yscale = NULL, fscale = NULL; int buflen, status, strategy; char *bufval; /* * ---------------------------------------------------------------- * Extract input arguments * ---------------------------------------------------------------- */ /* Exract y0 and load initial guess in y */ y0 = mxGetPr(prhs[0]); PutData(y, y0, N); /* Extract strategy */ buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(prhs[1], bufval, buflen); if(!strcmp(bufval,"None")) { strategy = KIN_NONE; } else if(!strcmp(bufval,"LineSearch")) { strategy = KIN_LINESEARCH; } else { kimErrHandler(-999, "KINSOL", "KINSol", "Illegal value for strategy.", NULL); goto error_return; } /* Extract yscale */ ys = mxGetPr(prhs[2]); yscale = N_VCloneEmpty(y); N_VSetArrayPointer(ys, yscale); /* Extract fscale */ fs = mxGetPr(prhs[3]); fscale = N_VCloneEmpty(y); N_VSetArrayPointer(fs, fscale); /* * ------------------------- * Call main solver function * ------------------------- */ status = KINSol(kin_mem, y, strategy, yscale, fscale); if (status < 0) goto error_return; /* Extract solution vector */ plhs[1] = mxCreateDoubleMatrix(N,1,mxREAL); GetData(y, mxGetPr(plhs[1]), N); /* Free temporary vectors */ N_VDestroy(yscale); N_VDestroy(fscale); /* KINSOL return flag (only non-negative values make it here) */ plhs[0] = mxCreateDoubleScalar((double)status); return(0); error_return: status = -1; plhs[0] = mxCreateDoubleScalar((double)status); plhs[1] = mxCreateDoubleMatrix(0,0,mxREAL); if (yscale != NULL) N_VDestroy(yscale); if (fscale != NULL) N_VDestroy(fscale); return(-1); } static int KIM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { const char *fnames_solver[]={ "nfe", "nni", "nbcf", "nbops", "fnorm", "step", "LSInfo", }; const char *fnames_dense[]={ "name", "njeD", "nfeD" }; const char *fnames_band[]={ "name", "njeD", "nfeD" }; const char *fnames_spils[]={ "name", "nli", "npe", "nps", "ncfl", }; long int nfe, nni, nbcf, nbops; double fnorm, step; long int njeD, nfeD; long int nli, npe, nps, ncfl; mxArray *mx_ls; int nfields; int status; if (kimData == NULL) return; status = KINGetNumNonlinSolvIters(kin_mem, &nni); if (status != KIN_SUCCESS) goto error_return; status = KINGetNumFuncEvals(kin_mem, &nfe); if (status != KIN_SUCCESS) goto error_return; status = KINGetNumBetaCondFails(kin_mem, &nbcf); if (status != KIN_SUCCESS) goto error_return; status = KINGetNumBacktrackOps(kin_mem, &nbops); if (status != KIN_SUCCESS) goto error_return; status = KINGetFuncNorm(kin_mem, &fnorm); if (status != KIN_SUCCESS) goto error_return; status = KINGetStepLength(kin_mem, &step); if (status != KIN_SUCCESS) goto error_return; nfields = sizeof(fnames_solver)/sizeof(*fnames_solver); plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_solver); mxSetField(plhs[0], 0, "nfe", mxCreateDoubleScalar((double)nfe)); mxSetField(plhs[0], 0, "nni", mxCreateDoubleScalar((double)nni)); mxSetField(plhs[0], 0, "nbcf", mxCreateDoubleScalar((double)nbcf)); mxSetField(plhs[0], 0, "nbops", mxCreateDoubleScalar((double)nbops)); mxSetField(plhs[0], 0, "fnorm", mxCreateDoubleScalar(fnorm)); mxSetField(plhs[0], 0, "step", mxCreateDoubleScalar(step)); /* Linear Solver Statistics */ switch(ls){ case LS_DENSE: status = KINDlsGetNumJacEvals(kin_mem, &njeD); if (status != KIN_SUCCESS) goto error_return; status = KINDlsGetNumFuncEvals(kin_mem, &nfeD); if (status != KIN_SUCCESS) goto error_return; nfields = sizeof(fnames_dense)/sizeof(*fnames_dense); mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_dense); mxSetField(mx_ls, 0, "name", mxCreateString("Dense")); mxSetField(mx_ls, 0, "njeD", mxCreateDoubleScalar((double)njeD)); mxSetField(mx_ls, 0, "nfeD", mxCreateDoubleScalar((double)nfeD)); break; case LS_BAND: status = KINDlsGetNumJacEvals(kin_mem, &njeD); if (status != KIN_SUCCESS) goto error_return; status = KINDlsGetNumFuncEvals(kin_mem, &nfeD); if (status != KIN_SUCCESS) goto error_return; nfields = sizeof(fnames_band)/sizeof(*fnames_band); mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_band); mxSetField(mx_ls, 0, "name", mxCreateString("Band")); mxSetField(mx_ls, 0, "njeD", mxCreateDoubleScalar((double)njeD)); mxSetField(mx_ls, 0, "nfeD", mxCreateDoubleScalar((double)nfeD)); break; case LS_SPGMR: case LS_SPBCG: case LS_SPTFQMR: status = KINSpilsGetNumLinIters(kin_mem, &nli); if (status != KIN_SUCCESS) goto error_return; status = KINSpilsGetNumPrecEvals(kin_mem, &npe); if (status != KIN_SUCCESS) goto error_return; status = KINSpilsGetNumPrecSolves(kin_mem, &nps); if (status != KIN_SUCCESS) goto error_return; status = KINSpilsGetNumConvFails(kin_mem, &ncfl); if (status != KIN_SUCCESS) goto error_return; nfields = sizeof(fnames_spils)/sizeof(*fnames_spils); mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_spils); if (ls == LS_SPGMR) mxSetField(mx_ls, 0, "name", mxCreateString("GMRES")); else if (ls == LS_SPBCG) mxSetField(mx_ls, 0, "name", mxCreateString("BiCGStab")); else mxSetField(mx_ls, 0, "name", mxCreateString("TFQMR")); mxSetField(mx_ls, 0, "nli", mxCreateDoubleScalar((double)nli)); mxSetField(mx_ls, 0, "npe", mxCreateDoubleScalar((double)npe)); mxSetField(mx_ls, 0, "nps", mxCreateDoubleScalar((double)nps)); mxSetField(mx_ls, 0, "ncfl", mxCreateDoubleScalar((double)ncfl)); break; } mxSetField(plhs[0], 0, "LSInfo", mx_ls); /* Successfull return */ status = 0; plhs[1] = mxCreateDoubleScalar((double)status); return(0); /* Error return */ error_return: status = -1; plhs[1] = mxCreateDoubleScalar((double)status); return(-1); } static int KIM_Set(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { return(0); } static int KIM_Get(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { return(0); } static int KIM_Free(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { if (kimData == NULL) return(0); KINFree(&kin_mem); return; } sundials-2.5.0/sundialsTB/kinsol/kim/src/kim.h0000600000175000017500000001213111741421121022051 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2012/03/07 21:50:32 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/kinsol/LICENSE. * ----------------------------------------------------------------- * Header file for the KINSOL Matlab interface. * ----------------------------------------------------------------- */ #ifndef _KIM_H #define _KIM_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include "mex.h" #include #include #include #include #include #include #include /* * --------------------------------------------------------------------------------- * Constants * --------------------------------------------------------------------------------- */ /* Linear solver types */ enum {LS_NONE, LS_DENSE, LS_BAND, LS_SPGMR, LS_SPBCG, LS_SPTFQMR}; /* Preconditioner modules */ enum {PM_NONE, PM_BBDPRE}; /* * --------------------------------------------------------------------------------- * Types for global data structures * --------------------------------------------------------------------------------- */ typedef struct kimInterfaceData_ { void *kin_mem; /* KINSOL solver memory */ long int n; /* problem dimension */ N_Vector Y; /* solution vector */ int LS; /* linear solver type */ int PM; /* preconditioner module */ booleantype errMsg; /* post error/warning messages? */ int fig_handle; /* figure for posting info */ /* Matlab functions and data associated with this problem */ mxArray *SYSfct; mxArray *JACfct; mxArray *PSETfct; mxArray *PSOLfct; mxArray *GLOCfct; mxArray *GCOMfct; mxArray *mtlb_data; } *kimInterfaceData; /* * --------------------------------------------------------------------------------- * Error and info handler functions * --------------------------------------------------------------------------------- */ void kimErrHandler(int error_code, const char *module, const char *function, char *msg, void *eh_data); void kimInfoHandler(const char *module, const char *function, char *msg, void *ih_data); /* * --------------------------------------------------------------------------------- * Wrapper functions * --------------------------------------------------------------------------------- */ int mxW_KINSys(N_Vector y, N_Vector fy, void *user_data ); /* Dense direct linear solver */ int mxW_KINDenseJac(long int N, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2); /* Band direct linear solver */ int mxW_KINBandJac(long int N, long int mupper, long int mlower, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2); /* Scaled Preconditioned Iterative Linear Solver (SPGMR or SPBCG) */ int mxW_KINSpilsJac(N_Vector v, N_Vector Jv, N_Vector y, booleantype *new_y, void *user_data); int mxW_KINSpilsPset(N_Vector y, N_Vector yscale, N_Vector fy, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int mxW_KINSpilsPsol(N_Vector y, N_Vector yscale, N_Vector fy, N_Vector fscale, N_Vector v, void *user_data, N_Vector vtemp); /* BBD Preconditioner */ int mxW_KINGloc(long int Nlocal, N_Vector y, N_Vector gval, void *user_data); int mxW_KINGcom(long int Nlocal, N_Vector y, void *user_data); /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_SolverOptions(const mxArray *options, booleantype *verbose, booleantype *errmsg, int *mxiter, int *msbset, int *msbsetsub, int *etachoice, int *mxnbcf, double *eta, double *egamma, double *ealpha, double *mxnewtstep, double *relfunc, double *fnormtol, double *scsteptol, double **constraints, booleantype *noInitSetup, booleantype *noMinEps); int get_LinSolvOptions(const mxArray *options, long int *mupper, long int *mlower, long int *mudq, long int *mldq, double *dqrely, int *ptype, int *maxrs, int *maxl); #ifdef __cplusplus } #endif #endif sundials-2.5.0/sundialsTB/kinsol/kim/src/kimOpts.c0000600000175000017500000002737711741421121022734 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2012/03/07 21:50:32 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see sundials-x.y.z/src/kinsol/LICENSE. * ----------------------------------------------------------------- * Option parsing functions for the KINSOL Matlab interface. * ----------------------------------------------------------------- */ #include #include "kim.h" /* * --------------------------------------------------------------------------------- * Global interface data variable (defined in kim.c) * --------------------------------------------------------------------------------- */ extern kimInterfaceData kimData; /* * --------------------------------------------------------------------------------- * Redability replacements * --------------------------------------------------------------------------------- */ #define N (kimData->n) #define ls (kimData->LS) #define pm (kimData->PM) #define mtlb_data (kimData->mtlb_data) #define mtlb_JACfct (kimData->JACfct) #define mtlb_PSETfct (kimData->PSETfct) #define mtlb_PSOLfct (kimData->PSOLfct) #define mtlb_GLOCfct (kimData->GLOCfct) #define mtlb_GCOMfct (kimData->GCOMfct) /* * --------------------------------------------------------------------------------- * Option handling functions * --------------------------------------------------------------------------------- */ int get_SolverOptions(const mxArray *options, booleantype *verbose, booleantype *errmsg, int *mxiter, int *msbset, int *msbsetsub, int *etachoice, int *mxnbcf, double *eta, double *egamma, double *ealpha, double *mxnewtstep, double *relfunc, double *fnormtol, double *scsteptol, double **constraints, booleantype *noInitSetup, booleantype *noMinEps) { mxArray *opt; char *bufval; int buflen, status; long int i, m, n; double *tmp; /* Set default values (pass 0 values. KINSOL does the rest) */ *mxiter = 0; *msbset = 0; *msbsetsub = 0; *mxnbcf = 0; *etachoice = KIN_ETACHOICE1; *eta = 0.0; *egamma = 0.0; *ealpha = 0.0; *mxnewtstep = 0.0; *relfunc = 0.0; *fnormtol = 0.0; *scsteptol = 0.0; *noInitSetup = FALSE; *noMinEps = FALSE; *constraints = NULL; *verbose = FALSE; *errmsg = TRUE; /* Return now if options was empty */ if (mxIsEmpty(options)) return(0); /* User data */ opt = mxGetField(options,0,"UserData"); if ( !mxIsEmpty(opt) ) { mxDestroyArray(mtlb_data); mtlb_data = mxDuplicateArray(opt); } /* Integer values */ opt = mxGetField(options,0,"MaxNumIter"); if ( !mxIsEmpty(opt) ) *mxiter = (int)*mxGetPr(opt); opt = mxGetField(options,0,"MaxNumSetups"); if ( !mxIsEmpty(opt) ) *msbset = (int)*mxGetPr(opt); opt = mxGetField(options,0,"MaxNumSubSetups"); if ( !mxIsEmpty(opt) ) *msbsetsub = (int)*mxGetPr(opt); opt = mxGetField(options,0,"MaxNumBetaFails"); if ( !mxIsEmpty(opt) ) *mxnbcf = (int)*mxGetPr(opt); opt = mxGetField(options,0,"EtaForm"); if ( !mxIsEmpty(opt) ) { buflen = mxGetM(opt) * mxGetN(opt) + 1; bufval = mxCalloc(buflen, sizeof(char)); status = mxGetString(opt, bufval, buflen); if(status != 0) { kimErrHandler(-999, "KINSOL", "KINInit", "Cannot parse EtaForm.", NULL); return(-1); } if(!strcmp(bufval,"Type1")) *etachoice = KIN_ETACHOICE1; else if(!strcmp(bufval,"Type2")) *etachoice = KIN_ETACHOICE2; else if(!strcmp(bufval,"Constant")) *etachoice = KIN_ETACONSTANT; else { kimErrHandler(-999, "KINSOL", "KINInit", "EtaForm has an illegal value.", NULL); return(-1); } } /* Real values */ opt = mxGetField(options,0,"Eta"); if ( !mxIsEmpty(opt) ) *eta = (double)*mxGetPr(opt); opt = mxGetField(options,0,"EtaAlpha"); if ( !mxIsEmpty(opt) ) *ealpha = (double)*mxGetPr(opt); opt = mxGetField(options,0,"EtaGamma"); if ( !mxIsEmpty(opt) ) *egamma = (double)*mxGetPr(opt); opt = mxGetField(options,0,"MaxNewtonStep"); if ( !mxIsEmpty(opt) ) *mxnewtstep = (double)*mxGetPr(opt); opt = mxGetField(options,0,"FuncRelErr"); if ( !mxIsEmpty(opt) ) *relfunc = (double)*mxGetPr(opt); opt = mxGetField(options,0,"FuncNormTol"); if ( !mxIsEmpty(opt) ) *fnormtol = (double)*mxGetPr(opt); opt = mxGetField(options,0,"ScaledStepTol"); if ( !mxIsEmpty(opt) ) *scsteptol = (double)*mxGetPr(opt); /* Boolean values */ opt = mxGetField(options,0,"ErrorMessages"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { kimErrHandler(-999, "KINSOL", "KINInit", "ErrorMessages is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *errmsg = TRUE; else *errmsg = FALSE; } opt = mxGetField(options,0,"Verbose"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { kimErrHandler(-999, "KINSOL", "KINInit", "Verbose is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *verbose = TRUE; else *verbose = FALSE; } opt = mxGetField(options,0,"InitialSetup"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { kimErrHandler(-999, "KINSOL", "KINInit", "InitialSetup is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *noInitSetup = FALSE; else *noInitSetup = TRUE; } opt = mxGetField(options,0,"MinBoundEps"); if ( !mxIsEmpty(opt) ) { if (!mxIsLogical(opt)) { kimErrHandler(-999, "KINSOL", "KINInit", "MinBoundEps is not a logical scalar.", NULL); return(-1); } if (mxIsLogicalScalarTrue(opt)) *noMinEps = FALSE; else *noMinEps = TRUE; } /* Constraints */ opt = mxGetField(options,0,"Constraints"); if ( !mxIsEmpty(opt) ) { m = mxGetM(opt); n = mxGetN(opt); if ( (n != 1) && (m != 1) ) { kimErrHandler(-999, "KINSOL", "KINInit", "constraints is not a vector.", NULL); return(-1); } if ( m > n ) n = m; if ( n != N ) { kimErrHandler(-999, "KINSOL", "KINInit", "constraints has wrong number of components.", NULL); return(-1); } tmp = mxGetPr(opt); *constraints = (double *) malloc(N*sizeof(double)); for (i=0;in) #define ls (kimData->LS) #define pm (kimData->PM) /* * --------------------------------------------------------------------------------- * Wrapper functions * --------------------------------------------------------------------------------- */ int mxW_KINSys(N_Vector y, N_Vector fy, void *user_data ) { kimInterfaceData kimData; mxArray *mx_in[3], *mx_out[3]; int ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = kimData->SYSfct; /* matlab function handle */ mx_in[2] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); mexCallMATLAB(3,mx_out,3,mx_in,"kim_sys"); PutData(fy, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_KINDenseJac(long int Neq, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2) { kimInterfaceData kimData; double *J_data; mxArray *mx_in[4], *mx_out[3]; int i, ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fy */ mx_in[2] = kimData->JACfct; /* matlab function handle */ mx_in[3] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); GetData(fy, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"kim_djac"); J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[3] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); GetData(fy, mxGetPr(mx_in[1]), N); mexCallMATLAB(3,mx_out,4,mx_in,"kim_bjac"); eband = mupper + mlower + 1; J_data = mxGetPr(mx_out[0]); for (i=0;iJACfct; /* matlab function handle */ mx_in[4] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); GetData(v, mxGetPr(mx_in[1]), N); mexCallMATLAB(4,mx_out,5,mx_in,"kim_jtv"); PutData(Jv, mxGetPr(mx_out[0]), N); *new_y = mxIsLogicalScalarTrue(mx_out[1]); ret = (int)*mxGetPr(mx_out[2]); if (!mxIsEmpty(mx_out[3])) { UpdateUserData(mx_out[3], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); mxDestroyArray(mx_out[3]); return(ret); } int mxW_KINSpilsPset(N_Vector y, N_Vector yscale, N_Vector fy, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { kimInterfaceData kimData; mxArray *mx_in[6], *mx_out[2]; int ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yscale */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fscale */ mx_in[4] = kimData->PSETfct; /* matlab function handle */ mx_in[5] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); GetData(yscale, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); GetData(fscale, mxGetPr(mx_in[3]), N); mexCallMATLAB(2,mx_out,6,mx_in,"kim_pset"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } int mxW_KINSpilsPsol(N_Vector y, N_Vector yscale, N_Vector fy, N_Vector fscale, N_Vector v, void *user_data, N_Vector vtemp) { kimInterfaceData kimData; mxArray *mx_in[7], *mx_out[3]; int ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = mxCreateDoubleMatrix(N,1,mxREAL); /* current yscale */ mx_in[2] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fy */ mx_in[3] = mxCreateDoubleMatrix(N,1,mxREAL); /* current fscale */ mx_in[4] = mxCreateDoubleMatrix(N,1,mxREAL); /* right hand side */ mx_in[5] = kimData->PSOLfct; /* matlab function handle */ mx_in[6] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); GetData(yscale, mxGetPr(mx_in[1]), N); GetData(fy, mxGetPr(mx_in[2]), N); GetData(fscale, mxGetPr(mx_in[3]), N); GetData(v, mxGetPr(mx_in[4]), N); mexCallMATLAB(3,mx_out,7,mx_in,"kim_psol"); PutData(v, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_in[1]); mxDestroyArray(mx_in[2]); mxDestroyArray(mx_in[3]); mxDestroyArray(mx_in[4]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_KINGloc(long int Nlocal, N_Vector y, N_Vector gval, void *user_data) { kimInterfaceData kimData; mxArray *mx_in[3], *mx_out[3]; int ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = kimData->GLOCfct; /* matlab function handle */ mx_in[2] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); mexCallMATLAB(3,mx_out,3,mx_in,"kim_gloc"); PutData(gval, mxGetPr(mx_out[0]), N); ret = (int)*mxGetPr(mx_out[1]); if (!mxIsEmpty(mx_out[2])) { UpdateUserData(mx_out[2], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); mxDestroyArray(mx_out[2]); return(ret); } int mxW_KINGcom(long int Nlocal, N_Vector y, void *user_data) { kimInterfaceData kimData; mxArray *mx_in[5], *mx_out[2]; int ret; /* Extract global interface data from user-data */ kimData = (kimInterfaceData) user_data; /* Inputs to the Matlab function */ mx_in[0] = mxCreateDoubleMatrix(N,1,mxREAL); /* current y */ mx_in[1] = kimData->GCOMfct; /* matlab function handle */ mx_in[2] = kimData->mtlb_data; /* matlab user data */ /* Call matlab wrapper */ GetData(y, mxGetPr(mx_in[0]), N); mexCallMATLAB(2,mx_out,3,mx_in,"kim_gcom"); ret = (int)*mxGetPr(mx_out[0]); if (!mxIsEmpty(mx_out[1])) { UpdateUserData(mx_out[1], kimData); } /* Free temporary space */ mxDestroyArray(mx_in[0]); mxDestroyArray(mx_out[0]); mxDestroyArray(mx_out[1]); return(ret); } /* * --------------------------------------------------------------------------------- * Private function to update the user data structure * --------------------------------------------------------------------------------- */ static void UpdateUserData(mxArray *new_mtlb_data, kimInterfaceData kimData) { mexUnlock(); mxDestroyArray(kimData->mtlb_data); kimData->mtlb_data = mxDuplicateArray(new_mtlb_data); mexMakeArrayPersistent(kimData->mtlb_data); mexLock(); } sundials-2.5.0/sundialsTB/kinsol/kim/kim_pset.m0000600000175000017500000000042211741421121022322 0ustar sylvestresylvestrefunction [flag, new_data] = kim_pset(y, yscale, fy, fscale, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) flag = feval(fct,y,yscale,fy,fscale); new_data =[]; else [flag, new_data] = feval(fct,y,yscale,fy,fscale,data); end sundials-2.5.0/sundialsTB/kinsol/kim/kim_bjac.m0000600000175000017500000000037011741421121022250 0ustar sylvestresylvestrefunction [ret, flag, new_data] = kim_bjac(y, fy, fct, data) % % Wrapper around the actual user-provided Matlab function % if isempty(data) [ret, flag] = feval(fct,y,fy); new_data = []; else [ret, flag, new_data] = feval(fct,y,fy,data); end sundials-2.5.0/sundialsTB/kinsol/KINGetStats.m0000600000175000017500000000306511741421121022035 0ustar sylvestresylvestrefunction [si, status] = KINGetStats() %KINGetStats returns statistics for the main KINSOL solver and the linear %solver used. % % Usage: STATS = KINGetStats % %Fields in the structure STATS % %o nfe - total number evaluations of the nonlinear system function SYSFUN %o nni - total number of nonlinear iterations %o nbcf - total number of beta-condition failures %o nbops - total number of backtrack operations (step length adjustments) % performed by the line search algorithm %o fnorm - scaled norm of the nonlinear system function f(y) evaluated at the % current iterate: ||fscale*f(y)||_L2 %o step - scaled norm (or length) of the step used during the previous % iteration: ||uscale*p||_L2 %o LSInfo - structure with linear solver statistics % %The structure LSinfo has different fields, depending on the linear solver used. % % Fields in LSinfo for the 'Dense' linear solver % %o name - 'Dense' %o njeD - number of Jacobian evaluations %o nfeD - number of right-hand side function evaluations for difference-quotient % Jacobian approximation % % Fields in LSinfo for the 'GMRES' or 'BiCGStab' linear solver % %o name - 'GMRES' or 'BiCGStab' %o nli - number of linear solver iterations %o npe - number of preconditioner setups %o nps - number of preconditioner solve function calls %o ncfl - number of linear system convergence test failures % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ mode = 3; [si, status] = kim(mode); sundials-2.5.0/sundialsTB/kinsol/KINInit.m0000600000175000017500000000146211741421121021201 0ustar sylvestresylvestrefunction status = KINInit(fct, n, options) %KINInit allocates and initializes memory for KINSOL. % % Usage: KINInit ( SYSFUN, N [, OPTIONS ] ); % % SYSFUN is a function defining the nonlinear problem f(y) = 0. % This function must return a column vector FY containing the % current value of the residual % N is the (local) problem dimension. % OPTIONS is an (optional) set of integration options, created with % the KINSetOptions function. % % See also: KINSetOptions, KINSysFn % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/12/05 21:58:19 $ mode = 1; if nargin < 2 error('Too few input arguments'); end if nargin < 3 options = []; end status = kim(mode, fct, n, options); sundials-2.5.0/sundialsTB/kinsol/examples_ser/0000755000175000017500000000000011767174700022272 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/examples_ser/mkinRoboKin_dns.m0000600000175000017500000001234111741421121025507 0ustar sylvestresylvestrefunction mkinRoboKin_dns % mkinRoboKin_dns - nonlinear system from robot kinematics. % % Source: "Handbook of Test Problems in Local and Global Optimization", % C.A. Floudas, P.M. Pardalos et al. % Kluwer Academic Publishers, 1999. % Test problem 6 from Section 14.1, Chapter 14 % % The nonlinear system is solved by KINSOL using the DENSE linear solver. % % Constraints are imposed to make all components of the solution be % within [-1,1]. This is achieved by introducing additional "bound variables", % l_i = x_i + 1 and u-i = 1 - x_i, i = 1,...,nvar % and using the Constraints option to KINSOL to enforce l_i >=0 and u_i >= 0. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/12/05 21:58:19 $ fprintf('\nRobot Kinematics Example\n'); fprintf('8 variables; -1 <= x_i <= 1\n'); fprintf('KINSOL problem size: 8 + 2*8 = 24 \n\n'); % Number of problem variables nvar = 8; % Number of equations = number of problem vars. + number of bound variables neq = nvar + 2*nvar; % Function tolerance ftol = 1.0e-5; % Step tolerance stol = 1.0e-5; % Constraints (all bound variables non-negative) constraints = [ zeros(nvar,1); ones(nvar,1) ; ones(nvar,1) ]; % Force exact Newton msbset = 1; % Initialize solver options = KINSetOptions('FuncNormTol', ftol, ... 'ScaledStepTol', stol, ... 'Constraints', constraints, ... 'MaxNumSetups', msbset, ... 'LinearSolver', 'Dense', ... 'JacobianFn', @sysjac); KINInit(@sysfn, neq, options); % Initial guess y = ones(neq,1); y(1:nvar) = 1.0/sqrt(2); fprintf('Initial guess:\n'); PrintOutput(y); % Call KINSol to solve the problem yscale = ones(neq,1); fscale = ones(neq,1); strategy = 'LineSearch'; [status, y] = KINSol(y, strategy, yscale, fscale); fprintf('\nComputed solution:\n'); PrintOutput(y); % Print final statistics and free memory stats = KINGetStats; ls_stats = stats.LSInfo; fprintf('\nSolver statistics:'); stats ls_stats KINFree; return; % System function % --------------- function [fy, flag] = sysfn(y) % Extract problem variables and bound variables x1 = y(1); l1 = y( 9); u1 = y(17); x2 = y(2); l2 = y(10); u2 = y(18); x3 = y(3); l3 = y(11); u3 = y(19); x4 = y(4); l4 = y(12); u4 = y(20); x5 = y(5); l5 = y(13); u5 = y(21); x6 = y(6); l6 = y(14); u6 = y(22); x7 = y(7); l7 = y(15); u7 = y(23); x8 = y(8); l8 = y(16); u8 = y(24); % Nonlinear equations eq1 = - 0.1238*x1 + x7 - 0.001637*x2 - 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571; eq2 = 0.2638*x1 - x7 - 0.07745*x2 - 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022; eq3 = 0.3578*x1 + 0.004731*x2 + x6*x8; eq4 = - 0.7623*x1 + 0.2238*x2 + 0.3461; eq5 = x1*x1 + x2*x2 - 1; eq6 = x3*x3 + x4*x4 - 1; eq7 = x5*x5 + x6*x6 - 1; eq8 = x7*x7 + x8*x8 - 1; % Lower bounds ( l_i = 1 + x_i >= 0) lb1 = l1 - 1.0 - x1; lb2 = l2 - 1.0 - x2; lb3 = l3 - 1.0 - x3; lb4 = l4 - 1.0 - x4; lb5 = l5 - 1.0 - x5; lb6 = l6 - 1.0 - x6; lb7 = l7 - 1.0 - x7; lb8 = l8 - 1.0 - x8; % Upper bounds ( u_i = 1 - x_i >= 0) ub1 = u1 - 1.0 + x1; ub2 = u2 - 1.0 + x2; ub3 = u3 - 1.0 + x3; ub4 = u4 - 1.0 + x4; ub5 = u5 - 1.0 + x5; ub6 = u6 - 1.0 + x6; ub7 = u7 - 1.0 + x7; ub8 = u8 - 1.0 + x8; % Load residuals for the problem equations % and the equations encoding the constraints fy(1) = eq1; fy( 9) = lb1; fy(17) = ub1; fy(2) = eq2; fy(10) = lb2; fy(18) = ub2; fy(3) = eq3; fy(11) = lb3; fy(19) = ub3; fy(4) = eq4; fy(12) = lb4; fy(20) = ub4; fy(5) = eq5; fy(13) = lb5; fy(21) = ub5; fy(6) = eq6; fy(14) = lb6; fy(22) = ub6; fy(7) = eq7; fy(15) = lb7; fy(23) = ub7; fy(8) = eq8; fy(16) = lb8; fy(24) = ub8; flag = 0; return; % System Jacobian % --------------- function [J, flag] = sysjac(y, fy) % Extract problem variables x1 = y(1); x2 = y(2); x3 = y(3); x4 = y(4); x5 = y(5); x6 = y(6); x7 = y(7); x8 = y(8); % Nonlinear equations % - 0.1238*x1 + x7 - 0.001637*x2 - 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571 J(1,1) = - 0.1238 + 0.004731*x3; J(1,2) = - 0.001637 - 0.3578*x3; J(1,3) = 0.004731*x1 - 0.3578*x2; J(1,4) = - 0.9338; J(1,7) = 1.0; % 0.2638*x1 - x7 - 0.07745*x2 - 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022 J(2,1) = 0.2638 + 0.2238*x3; J(2,2) = - 0.07745 + 0.7623*x3; J(2,3) = 0.2238*x1 + 0.7623*x2; J(2,4) = - 0.6734; J(2,7) = -1.0; % 0.3578*x1 + 0.004731*x2 + x6*x8 J(3,1) = 0.3578; J(3,2) = 0.004731; J(3,6) = x8; J(3,8) = x6; % - 0.7623*x1 + 0.2238*x2 + 0.3461 J(4,1) = - 0.7623; J(4,2) = 0.2238; % x1*x1 + x2*x2 - 1 J(5,1) = 2.0*x1; J(5,2) = 2.0*x2; % x3*x3 + x4*x4 - 1 J(6,3) = 2.0*x3; J(6,4) = 2.0*x4; % x5*x5 + x6*x6 - 1 J(7,5) = 2.0*x5; J(7,6) = 2.0*x6; % x7*x7 + x8*x8 - 1 J(8,7) = 2.0*x7; J(8,8) = 2.0*x8; % Lower bounds ( l_i = 1 + x_i >= 0) % l_i - 1.0 - x_i for i=1:8 J(8+i,i) = -1.0; J(8+i,8+i) = 1.0; end % Upper bounds ( u_i = 1 - x_i >= 0) % u_i - 1.0 + x_i for i=1:8 J(16+i,i) = 1.0; J(16+i,16+i) = 1.0; end flag = 0; return % Print solution % -------------- function PrintOutput(y) nvar = 8; fprintf(' l=x+1 x u=1-x\n'); fprintf(' ----------------------------------\n'); for i = 1:nvar fprintf(' %10.6g %10.6g %10.6g\n', y(i+nvar), y(i), y(i+2*nvar)); end return sundials-2.5.0/sundialsTB/kinsol/examples_ser/mkinTest_dns.m0000600000175000017500000000244111741421121025063 0ustar sylvestresylvestrefunction mkinTest_dns %mkinTest_dns - KINSOL example problem (serial, dense) % Simple test problem for the Dense linear solver in KINSOL % This example solves the system % y(1)^2 + y(2)^2 = 1 % y(2) = y(1)^2 % % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ % Initialize problem neq = 2; fnormtol = 1.0e-5; scsteptol = 1.0e-4; msbset = 1; % force exact Newton options = KINSetOptions('FuncNormTol', fnormtol,... 'ScaledStepTol',scsteptol,... 'LinearSolver','Dense',.... 'MaxNumSetups', msbset); KINInit(@sysfn, neq, options); % Solve problem y0 = ones(neq,1); scale = ones(neq,1); strategy = 'LineSearch'; [status, y] = KINSol(y0, strategy, scale, scale); % Evaluate system function at solution [fy, flag] = sysfn(y); % Print results fprintf('Solution: %10.4e %10.4e\n', y(1), y(2)); fprintf('Residual: %10.4e %10.4e\n', fy(1), fy(2)); slv_stats = KINGetStats; ls_stats = slv_stats.LSInfo; slv_stats ls_stats % Free memory KINFree; return % =================================================================== function [fy, flag] = sysfn(y) fy(1) = y(1)^2 + y(2)^2 - 1.0; fy(2) = y(2) - y(1)^2; flag = 0; return sundials-2.5.0/sundialsTB/kinsol/examples_ser/mkinFerTron_dns.m0000600000175000017500000001122311741421121025521 0ustar sylvestresylvestrefunction mkinFerTron_dns % mkinFerTron_dns - Ferraris-Tronconi test problem % % Source: "Handbook of Test Problems in Local and Global Optimization", % C.A. Floudas, P.M. Pardalos et al. % Kluwer Academic Publishers, 1999. % Test problem 4 from Section 14.1, Chapter 14: Ferraris and Tronconi % % This problem involves a blend of trigonometric and exponential terms. % 0.5 sin(x1 x2) - 0.25 x2/pi - 0.5 x1 = 0 % (1-0.25/pi) ( exp(2 x1)-e ) + e x2 / pi - 2 e x1 = 0 % such that % 0.25 <= x1 <=1.0 % 1.5 <= x2 <= 2 pi % % The treatment of the bound constraints on x1 and x2 is done using % the additional variables % l1 = x1 - x1_min >= 0 % L1 = x1 - x1_max <= 0 % l2 = x2 - x2_min >= 0 % L2 = x2 - x2_max >= 0 % % and using the constraint feature in KINSOL to impose % l1 >= 0 l2 >= 0 % L1 <= 0 L2 <= 0 % % The Ferraris-Tronconi test problem has two known solutions. % The nonlinear system is solved by KINSOL using different % combinations of globalization and Jacobian update strategies % and with different initial guesses (leading to one or the other % of the known solutions). % % Constraints are imposed to make all components of the solution % positive. % Radu Serban % Copyright (c) 2007, The Regents of the University of California. % $Revision: 1.1 $Date: 2007/12/05 21:58:19 $ % Initializations % --------------- % User data lb = [0.25 ; 1.5]; ub = [1.0 ; 2*pi]; data.lb = lb; data.ub = ub; % Number of problem variables nvar = 2; % Number of equations = number of problem vars. + number of bound variables neq = nvar + 2*nvar; % Function tolerance ftol = 1.0e-5; % Step tolerance stol = 1.0e-5; % Constraints constraints = [ 0 0 1 -1 1 -1]; % Modified/exact Newton % msbset = 0 -> modified Newton % msbset = 1 -> exact Newton msbset = 0; % Initialize solver options = KINSetOptions('UserData', data, ... 'FuncNormTol', ftol, ... 'ScaledStepTol', stol, ... 'Constraints', constraints, ... 'MaxNumSetups', msbset, ... 'LinearSolver', 'Dense'); KINInit(@sysfn, neq, options); % Initial guess % ------------- % % There are two known solutions for this problem % % the following initial guess should take us to (0.29945; 2.83693) x1 = lb(1); x2 = lb(2); u1 = [ x1 ; x2 ; x1-lb(1) ; x1-ub(1) ; x2-lb(2) ; x2-ub(2) ]; % while this one should take us to (0.5; 3.1415926) x1 = 0.5*(lb(1)+ub(1)); x2 = 0.5*(lb(2)+ub(2)); u2 = [ x1 ; x2 ; x1-lb(1) ; x1-ub(1) ; x2-lb(2) ; x2-ub(2) ]; % No Y and F scaling yscale = ones(neq,1); fscale = ones(neq,1); % No globalization strategy = 'None'; fprintf('\nFerraris and Tronconi test problem\n'); fprintf('Tolerance parameters:\n'); fprintf(' fnormtol = %10.6g\n scsteptol = %10.6g\n', ftol, stol); if msbset == 1 fprintf('Exact Newton'); else fprintf('Modified Newton'); end if strcmp(strategy,'None') fprintf('\n'); else fprintf(' with line search\n'); end % Solve problem starting from the 1st initial guess % ------------------------------------------------- fprintf('\n------------------------------------------\n'); fprintf('\nInitial guess on lower bounds\n'); fprintf(' [x1,x2] = %8.6g %8.6g', u1(1), u1(2)); [status, u1] = KINSol(u1, strategy, yscale, fscale); stats = KINGetStats; fprintf('\nsolution\n'); fprintf(' [x1,x2] = %8.6g %8.6g', u1(1), u1(2)); fprintf('\nSolver statistics:\n'); fprintf(' nni = %5d nfe = %5d \n', stats.nni, stats.nfe); fprintf(' nje = %5d nfeD = %5d \n', stats.LSInfo.njeD, stats.LSInfo.nfeD); % Solve problem starting from the 2nd initial guess % ------------------------------------------------- fprintf('\n------------------------------------------\n'); fprintf('\nInitial guess in middle of feasible region\n'); fprintf(' [x1,x2] = %8.6g %8.6g', u2(1), u2(2)); [status, u2] = KINSol(u2, strategy, yscale, fscale); stats = KINGetStats; fprintf('\nsolution\n'); fprintf(' [x1,x2] = %8.6g %8.6g', u2(1), u2(2)); fprintf('\nSolver statistics:\n'); fprintf(' nni = %5d nfe = %5d \n', stats.nni, stats.nfe); fprintf(' nje = %5d nfeD = %5d \n', stats.LSInfo.njeD, stats.LSInfo.nfeD); % Free memory % -------------------------------------- KINFree; return % System function % --------------- function [fu, flag, new_data] = sysfn(u, data) lb = data.lb; ub = data.ub; x1 = u(1); x2 = u(2); l1 = u(3); L1 = u(4); l2 = u(5); L2 = u(6); e = exp(1); fu(1) = 0.5 * sin(x1*x2) - 0.25 * x2 / pi - 0.5 * x1; fu(2) = (1.0 - 0.25/pi)*(exp(2.0*x1)-e) + e*x2/pi - 2.0*e*x1; fu(3) = l1 - x1 + lb(1); fu(4) = L1 - x1 + ub(1); fu(5) = l2 - x2 + lb(2); fu(6) = L2 - x2 + ub(2); flag = 0; new_data = []; return sundials-2.5.0/sundialsTB/kinsol/examples_ser/mkinDiagon_kry.m0000600000175000017500000000450511741421121025371 0ustar sylvestresylvestrefunction mkinDiagon_kry %mkinDiagon_kry - KINSOL example problem (serial, GMRES) % Simple diagonal test, using user-supplied preconditioner setup and % solve routines. % % This example does a basic test of the solver by solving the system: % f(y) = 0 for % f(y) = y(i)^2 - i^2 % % No scaling is done. % An approximate diagonal preconditioner is used. % % See also: kindiag_sys kindag_pset kindiag_psol % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ neq = 128; strategy = 'None'; fnormtol = 1.0e-5; scsteptol = 1.0e-4; maxl = 10; maxrs = 2; msbset = 5; data.P = []; options = KINSetOptions('UserData', data,... 'Verbose',true,... 'FuncNormTol', fnormtol,... 'ScaledStepTol',scsteptol,... 'LinearSolver','GMRES',.... 'KrylovMaxDim', maxl,... 'MaxNumRestarts', maxrs,... 'MaxNumSetups', msbset,... 'PrecSetupFn',@psetfn,... 'PrecSolveFn',@psolfn); KINInit(@sysfn, neq, options); y0 = 2.0*[1:neq]'; scale = ones(neq,1); [status, y] = KINSol(y0, strategy, scale, scale); if status < 0 fprintf('KINSOL failed. status = %d\n',status); else for i = 1:4:neq fprintf('%4d | %6.2f %6.2f %6.2f %6.2f\n',... i, y(i), y(i+1), y(i+2), y(i+3)); end end stats = KINGetStats; ls_stats = stats.LSInfo; stats ls_stats KINFree; % ============================================================ function [fy, flag, new_data] = sysfn(y, data) neq = length(y); for i = 1:neq fy(i) = y(i)^2 - i^2; end new_data = []; % data was not modified flag = 0; % success % ============================================================ function [flag, new_data] = psetfn(y,yscale,fy,fscale,data) neq = length(y); for i = 1:neq P(i) = 0.5 / (y(i)+5.0); end new_data.P = P; % updated P in data structure flag = 0; % success % ============================================================ function [x, flag, new_data] = psolfn(y,yscale,fy,fscale,v,data) P = data.P; neq = length(y); for i=1:neq x(i) = v(i) * P(i); end new_data = []; % data was not modified flag = 0; % success sundials-2.5.0/sundialsTB/kinsol/KINSol.m0000600000175000017500000000415111741421121021031 0ustar sylvestresylvestrefunction [status, y] = KINSol(y0, strategy, yscale, fscale) %KINSol solves the nonlinear problem. % % Usage: [STATUS, Y] = KINSol(Y0, STRATEGY, YSCALE, FSCALE) % % KINSol manages the computational process of computing an approximate % solution of the nonlinear system. If the initial guess (initial value % assigned to vector Y0) doesn't violate any user-defined constraints, % then KINSol attempts to solve the system f(y)=0. If an iterative linear % solver was specified (see KINSetOptions), KINSol uses a nonlinear Krylov % subspace projection method. The Newton-Krylov iterations are stopped % if either of the following conditions is satisfied: % % ||f(y)||_L-infinity <= 0.01*fnormtol % % ||y[i+1] - y[i]||_L-infinity <= scsteptol % % However, if the current iterate satisfies the second stopping % criterion, it doesn't necessarily mean an approximate solution % has been found since the algorithm may have stalled, or the % user-specified step tolerance may be too large. % % STRATEGY specifies the global strategy applied to the Newton step if it is % unsatisfactory. Valid choices are 'None' or 'LineSearch'. % YSCALE is a vector containing diagonal elements of scaling matrix for vector % Y chosen so that the components of YSCALE*Y (as a matrix multiplication) all % have about the same magnitude when Y is close to a root of f(y) % FSCALE is a vector containing diagonal elements of scaling matrix for f(y) % chosen so that the components of FSCALE*f(Y) (as a matrix multiplication) % all have roughly the same magnitude when u is not too near a root of f(y) % % On return, status is one of the following: % 0: KINSol succeeded % 1: The initial y0 already satisfies the stopping criterion given above % 2: Stopping tolerance on scaled step length satisfied % -1: An error occurred (see printed error message) % % See also KINSetOptions, KINGetstats % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2007/12/05 21:58:19 $ mode = 2; [status, y] = kim(mode, y0, strategy, yscale, fscale); sundials-2.5.0/sundialsTB/kinsol/function_types/0000755000175000017500000000000011767174700022654 5ustar sylvestresylvestresundials-2.5.0/sundialsTB/kinsol/function_types/KINGlocalFn.m0000600000175000017500000000243611741421121025036 0ustar sylvestresylvestre%KINGlocalFn - type for user provided RHS approximation function (BBDPre). % % The function GLOCFUN must be defined as % FUNCTION [G, FLAG] = GLOCFUN(Y) % and must return a vector G corresponding to an approximation to f(y) % which will be used in the BBDPRE preconditioner module. The case where % G is mathematically identical to F is allowed. % If a user data structure DATA was specified in KINInit, then % GLOCFUN must be defined as % FUNCTION [G, FLAG, NEW_DATA] = GLOCFUN(Y, DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector G, % the GLOCFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function GLOCFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also KINGcommFn, KINSetOptions % % NOTE: GLOCFUN is specified through the GlocalFn property in KINSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINBandJacFn.m0000600000175000017500000000235111741421121025113 0ustar sylvestresylvestre%KINBandJacFn - type for user provided banded Jacobian function. % % The function BJACFUN must be defined as % FUNCTION [J, FLAG] = BJACFUN(Y, FY) % and must return a matrix J corresponding to the banded Jacobian of f(y). % The input argument FY contains the current value of f(y). % If a user data structure DATA was specified in KINInit, then % BJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = BJACFUN(Y, FY, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J and % the flag FLAG, the BJACFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead % to unnecessary copying). % % The function BJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also KINSetOptions % % NOTE: BJACFUN is specified through the property JacobianFn to KINSetOptions % and is used only if the property LinearSolver was set to 'Band'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINGcommFn.m0000600000175000017500000000303011741421121024666 0ustar sylvestresylvestre%KINGcommFn - type for user provided communication function (BBDPre). % % The function GCOMFUN must be defined as % FUNCTION FLAG = GCOMFUN(Y) % and can be used to perform all interprocess communication necessary % to evaluate the approximate right-hand side function for the BBDPre % preconditioner module. % If a user data structure DATA was specified in KINInit, then % GCOMFUN must be defined as % FUNCTION [FLAG, NEW_DATA] = GCOMFUN(Y, DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then the GCOMFUN function must also % set NEW_DATA. Otherwise, it should set NEW_DATA=[] (do not set % NEW_DATA = DATA as it would lead to unnecessary copying). % % The function GCOMFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also KINGlocalFn, KINSetOptions % % NOTES: % GCOMFUN is specified through the GcommFn property in KINSetOptions % and is used only if the property PrecModule is set to 'BBDPre'. % % Each call to GCOMFUN is preceded by a call to the system function % SYSFUN with the same argument Y. Thus GCOMFUN can omit any communication % done by SYSFUN if relevant to the evaluation of G by GLOCFUN. If all % necessary communication was done by SYSFUN, GCOMFUN need not be provided. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINJacTimesVecFn.m0000600000175000017500000000262711741421121025774 0ustar sylvestresylvestre%KINJacTimesVecFn - type for user provided Jacobian times vector function. % % The function JTVFUN must be defined as % FUNCTION [JV, NEW_Y, FLAG] = JTVFUN(Y, V, NEW_Y) % and must return a vector JV corresponding to the product of the % Jacobian of f(y) with the vector v. On input, NEW_Y indicates if % the iterate has been updated in the interim. JV must be update % or reevaluated, if appropriate, unless NEW_Y=false. This flag must % be reset by the user. % If a user data structure DATA was specified in KINInit, then % JTVFUN must be defined as % FUNCTION [JV, NEW_Y, FLAG, NEW_DATA] = JTVFUN(Y, V, NEW_Y, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector JV, and % flags NEW_Y and FLAG, the JTVFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % If successful, FLAG should be set to 0. If an error occurs, FLAG should % be set to a nonzero value. % % See also KINSetOptions % % NOTE: JTVFUN is specified through the property JacobianFn to KINSetOptions % and is used only if the property LinearSolver was set to 'GMRES' or 'BiCGStab'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINDenseJacFn.m0000600000175000017500000000234011741421121025303 0ustar sylvestresylvestre%KINDenseJacFn - type for user provided dense Jacobian function. % % The function DJACFUN must be defined as % FUNCTION [J, FLAG] = DJACFUN(Y,FY) % and must return a matrix J corresponding to the Jacobian of f(y). % The input argument FY contains the current value of f(y). % If a user data structure DATA was specified in KINInit, then % DJACFUN must be defined as % FUNCTION [J, FLAG, NEW_DATA] = DJACFUN(Y,FY,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the matrix J and % the flag FLAG, the DJACFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead % to unnecessary copying). % % The function DJACFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also KINSetOptions % % NOTE: DJACFUN is specified through the property JacobianFn to KINSetOptions % and is used only if the property LinearSolver was set to 'Dense'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINSysFn.m0000600000175000017500000000201111741421121024400 0ustar sylvestresylvestre%KINSysFn - type for user provided system function % % The function SYSFUN must be defined as % FUNCTION [FY, FLAG] = SYSFUN(Y) % and must return a vector FY corresponding to f(y). % If a user data structure DATA was specified in KINInit, then % SYSFUN must be defined as % FUNCTION [FY, FLAG, NEW_DATA] = SYSFUN(Y,DATA) % If the local modifications to the user data structure are needed % in other user-provided functions then, besides setting the vector FY, % the SYSFUN function must also set NEW_DATA. Otherwise, it should set % NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead to % unnecessary copying). % % The function SYSFUN must set FLAG=0 if successful, FLAG<0 if an % unrecoverable failure occurred, or FLAG>0 if a recoverable error % occurred. % % See also KINInit % % NOTE: SYSFUN is specified through the KINInit function. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINPrecSetupFn.m0000600000175000017500000000436711741421121025554 0ustar sylvestresylvestre%KINPrecSetupFn - type for user provided preconditioner setup function. % % The user-supplied preconditioner setup subroutine should compute % the right-preconditioner matrix P used to form the scaled preconditioned % linear system: % % (Df*J(y)*(P^-1)*(Dy^-1)) * (Dy*P*x) = Df*(-F(y)) % % where Dy and Df denote the diagonal scaling matrices whose diagonal elements % are stored in the vectors YSCALE and FSCALE, respectively. % % The preconditioner setup routine (referenced by iterative linear % solver modules via pset (type KINSpilsPrecSetupFn)) will not be % called prior to every call made to the psolve function, but will % instead be called only as often as necessary to achieve convergence % of the Newton iteration. % % NOTE: If the PRECSOLVE function requires no preparation, then a % preconditioner setup function need not be given. % % The function PSETFUN must be defined as % FUNCTION FLAG = PSETFUN(Y, YSCALE, FY, FSCALE) % The input argument FY contains the current value of f(y), while YSCALE % and FSCALE are the scaling vectors for solution and system function, % respectively (as passed to KINSol) % % If a user data structure DATA was specified in KINInit, then % PSETFUN must be defined as % FUNCTION [FLAG, NEW_DATA] = PSETFUN(Y, YSCALE, FY, FSCALE, DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the flag FLAG, % the PSETFUN function must also set NEW_DATA. Otherwise, it should % set NEW_DATA=[] (do not set NEW_DATA = DATA as it would lead % to unnecessary copying). % % If successful, PSETFUN must return FLAG=0. For a recoverable error (in % which case the setup will be retried) it must set FLAG to a positive % integer value. If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the solver will halt. % % See also KINPrecSolveFn, KINSetOptions, KINSol % % NOTE: PSETFUN is specified through the property PrecSetupFn to KINSetOptions % and is used only if the property LinearSolver was set to 'GMRES' or 'BiCGStab'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/kinsol/function_types/KINPrecSolveFn.m0000600000175000017500000000334611741421121025540 0ustar sylvestresylvestre%KINPrecSolveFn - type for user provided preconditioner solve function. % % The user-supplied preconditioner solve function PSOLFN % is to solve a linear system P z = r in which the matrix P is % the preconditioner matrix (possibly set implicitely by PSETFUN) % % The function PSOLFUN must be defined as % FUNCTION [Z, FLAG] = PSOLFUN(Y, YSCALE, FY, FSCALE, R) % and must return a vector Z containing the solution of Pz=r. % The input argument FY contains the current value of f(y), while YSCALE % and FSCALE are the scaling vectors for solution and system function, % respectively (as passed to KINSol) % % If a user data structure DATA was specified in KINInit, then % PSOLFUN must be defined as % FUNCTION [Z, FLAG, NEW_DATA] = PSOLFUN(Y,YSCALE,FY,FSCALE,R,DATA) % If the local modifications to the user data structure are needed in % other user-provided functions then, besides setting the vector Z and % the flag FLAG, the PSOLFUN function must also set NEW_DATA. Otherwise, % it should set NEW_DATA=[] (do not set NEW_DATA = DATA as it would % lead to unnecessary copying). % % If successful, PSOLFUN must return FLAG=0. For a recoverable error it % must set FLAG to a positive value (in which case the solver will attempt % to correct). If an unrecoverable error occurs, it must set FLAG % to a negative value, in which case the solver will halt. % % See also KINPrecSetupFn, KINSetOptions % % NOTE: PSOLFUN is specified through the property PrecSolveFn to KINSetOptions % and is used only if the property LinearSolver was set to 'GMRES' or 'BiCGStab'. % Radu Serban % Copyright (c) 2005, The Regents of the University of California. % $Revision: 1.2 $Date: 2011/06/01 21:01:10 $ sundials-2.5.0/sundialsTB/README0000600000175000017500000002003611741421121017135 0ustar sylvestresylvestre sundialsTB A MATLAB interface to SUNDIALS Release 2.5.0, March 2012 Radu Serban Center for Applied Scientific Computing, LLNL sundialsTB provides a MATLAB interface to the following SUNDIALS solvers: CVODES: a variable-order, variable-step ODE solver with sensitivity analysis capabilities IDAS: a variable-order, variable-sttp DAE and implicit ODE solver KINSOL: a nonlinear system solver The core of each MATLAB interface in sundialsTB is a single mex file which interfaces to the various user-callable functions for that solver. However, this mex file should not be called directly, but rather through the user-callable functions provided for each MATLAB interface. The distribution file also contains a user guide, as well as several examples. sundialsTB v. 2.5.0 requires SUNDIALS v 2.5.0 and, optionally (for parallel support), MPITB with LAM 7.1.1 for MPI-2 features. SUNDIALS: http://www.llnl.gov/CASC/sundials MPITB: http://atc.ugr.es/javier-bin/mpitb_eng LAM: http://www.lam-mpi.org/ A. Documentation ---------------- /sundialsTB/doc contains a PDF file for the sundialsTB User Guide. B. Installation --------------- B.1. Compilation and installation of sundialsTB As of version 2.3.0, sundialsTB is distributed only with the complete SUNDIALS package and, on *nix systems (or under cygwin in Windows), the Matlab toolbox can be configured, built, and installed using the main SUNDIALS configure script. For details see the SUNDIALS file INSTALL_NOTES. For systems that do not support configure scripts (or if the configure script fails to configure sundialsTB), we provide a Matlab script (install_STB.m) which can be used to build and install sundialsTB from within Matlab. In the sequel, we assume that the SUNDIALS package was unpacked under the directory 'srcdir'. The sundialsTB files are therefore in 'srcdir'/sundialsTB. To facilitate the compilation of sundialsTB on platforms that do not have a make system, we rely on Matlab's mex command. Compilation of sundialsTB is done by running from under Matlab the install_STB.m script which is present in the sundialsTB top directory. 1. Launch matlab in sundialsTB: % cd 'srcdir'/sundialsTB % matlab 2. Run the install_STB matlab script. Note that parallel support will be compiled into the MEX files only if ALL of the following conditions are met: - $LAMHOME is defined - $MPITB_ROOT is defined - 'srcdir'/src/nvec_par exists After the MEX files are generated, you will be asked if you wish to install the sundialsTB toolbox. If you answer yes, you will be then asked for the installation directory (called in the sequel 'instdir'). To install sundialsTB for all Matlab users (not usual), assuming Matlab is installed under /usr/local/matlab7, specify 'instdir' = /usr/local/matlab7/toolbox To install sundialsTB for just one user (usual configuration), install sundialsTB under a directory of your choice (typically under your 'matlab' working directory). In other words, specify 'instdir' = /home/user/matlab B.2. Configuring Matlab's startup After a successful installation, a sundialsTB.m startup script is generated in 'instdir'/sundialsTB. This file must be called by Matlab at initialization. If sundialsTB was installed for all Matlab users (not usual), add the sundialsTB startup to the system-wide startup file (by linking or copying): % cd /usr/local/matlab7/toolbox/local % ln -s ../sundialsTB/startup_STB.m . and add these lines to your original local startup.m % SUNDIALS Toolbox startup M-file, if it exists. if exist('startup_STB','file') startup_STB end If sundialsTB was installed for just one user (usual configuration) and assuming you do not need to keep any previously existing startup.m, link or copy the startup_STB.m script to your working 'matlab' directory: % cd ~/matlab % ln -s sundialsTB/startup_STB.m startup.m If you already have a startup.m, use the method described above, first linking (or copying) startup_STB.m to the destination subdir and then editing ~/matlab/startup.m to run startup_STB.m B.3. Testing the installation If everything went fine, you should now be able to try one of the CVODES, IDAS, or KINSOL examples (in matlab, type 'help cvodes', 'help idas', or 'help kinsol' to see a list of all examples available). For example, cd to the CVODES serial example directory: % cd 'instdir'/sundialsTB/cvode/examples_ser and then launch matlab and execute cvdx. C. References ------------- [1] R. Serban, "sundialsTB, a MATLAB Interface to SUNDIALS", LLNL technical report UCRL-SM-212121, May 2005. [2] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 2.5.0 - Mar. 2012 v. 2.4.0 - May 2009 v. 2.3.0 - Nov. 2006 v. 2.2.0 - Mar. 2006 v. 2.1.1 - May. 2005 (first sundialsTB release) E. Revision History ------------------- v. 2.4.0 (May 2009) ---> v. 2.5.0 (Mar. 2012) --------------------------------------------------------- - Minor bug fixes: - in kimOpts.c, fixed lines setting etachoice. - in cvm.c and idm.c, fixed size of rootsfound array; added lines to free rootsfound and ckpnt arrays when done using each. - in all .c files, changed mxCreateScalarDouble to mxCreateDoubleScalar. - in all .c files, changed problem sizes, bandwidths, etc. from type int to type long int. - Minor fixes to documentation v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (May 2009) --------------------------------------------------------- - New features - Updated IDAS monitoring functionality. - Added functionality to reinitialize adjoint module. - Added functions to allow changing optional inputs during integration. - Added option to disable error message output. - Bug fixes - Minor fixes to installation files. - Bug fix in argument order in IDAS dense and band Jacobian interfaces. - Fixed bug in CVODES reinitialization. - Fixed a bug in initialization of backward quadratures in IDAS. - Changes to user interface - Updated interfaces to linear solvers corresponding to DLS/SPILS split. - Added several missing wrapper functions. - Changed CVODES API to require LMM and ITER. - Added return flags to all interface functions. -Other - Added CVODES examples showing integration over a discontinuity. - Added two KINSOL examples. - Relocated user function type files to function_types subdirectories. - Reorganized IDAS files to expose Sensitivity Analysis abilities. v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) --------------------------------------------------------- - New features - added IDAS module, a MEX interface to the SUNDIALS IDA integrator. - startup_STB.m is automatically created from a template. - Bug fixes - install_STB.m was modified to be more robust w.r.t. file naming conventions omn different platforms. - Changes to user interface - updated to reflect changes to the SUNDIALS libraries in v.2.3.0 v. 2.1.1 (May. 2005) ---> v. 2.2.0 (Mar. 2006) --------------------------------------------------------- - New features - modified installation procedure to use a Matlab script - added sample Matlab startup file - expanded CVodeMonitor - added interface to KINSOL's performance monitoring function ('Verbose' option to KINSetOptions) - Bug fixes - fixed bug in interface to quadrature integration which was causing a segmentatin violation when monitoring was turned on. - Changes to user interface - updated to reflect changes to the SUNDIALS libraries in v.2.2.0 - changed the interface for sensitivity analysis (both forward and adjoint) to follow more closely the CVODES calling sequence - optional inputs for forward sensitivity analysis are now provided through a separate function, CVodeSetFSAOptions - removed NVM mex interfacesundials-2.5.0/configure0000700000175000017500000335132411741421116016130 0ustar sylvestresylvestre#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for SUNDIALS 2.5.0. # # Report bugs to . # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # # # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Check that we are running under the correct shell. SHELL=${CONFIG_SHELL-/bin/sh} case X$ECHO in X*--fallback-echo) # Remove one level of quotation (which was required for Make). ECHO=`echo "$ECHO" | sed 's,\\\\\$\\$0,'$0','` ;; esac echo=${ECHO-echo} if test "X$1" = X--no-reexec; then # Discard the --no-reexec flag, and continue. shift elif test "X$1" = X--fallback-echo; then # Avoid inline document here, it may be left over : elif test "X`($echo '\t') 2>/dev/null`" = 'X\t' ; then # Yippee, $echo works! : else # Restart under the correct shell. exec $SHELL "$0" --no-reexec ${1+"$@"} fi if test "X$1" = X--fallback-echo; then # used as fallback echo shift cat </dev/null 2>&1 && unset CDPATH if test -z "$ECHO"; then if test "X${echo_test_string+set}" != Xset; then # find a string as large as possible, as long as the shell can cope with it for cmd in 'sed 50q "$0"' 'sed 20q "$0"' 'sed 10q "$0"' 'sed 2q "$0"' 'echo test'; do # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ... if (echo_test_string=`eval $cmd`) 2>/dev/null && echo_test_string=`eval $cmd` && (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null then break fi done fi if test "X`($echo '\t') 2>/dev/null`" = 'X\t' && echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then : else # The Solaris, AIX, and Digital Unix default echo programs unquote # backslashes. This makes it impossible to quote backslashes using # echo "$something" | sed 's/\\/\\\\/g' # # So, first we look for a working echo in the user's PATH. lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR for dir in $PATH /usr/ucb; do IFS="$lt_save_ifs" if (test -f $dir/echo || test -f $dir/echo$ac_exeext) && test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' && echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then echo="$dir/echo" break fi done IFS="$lt_save_ifs" if test "X$echo" = Xecho; then # We didn't find a better echo, so look for alternatives. if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' && echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then # This shell has a builtin print -r that does the trick. echo='print -r' elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) && test "X$CONFIG_SHELL" != X/bin/ksh; then # If we have ksh, try running configure again with it. ORIGINAL_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} export ORIGINAL_CONFIG_SHELL CONFIG_SHELL=/bin/ksh export CONFIG_SHELL exec $CONFIG_SHELL "$0" --no-reexec ${1+"$@"} else # Try using printf. echo='printf %s\n' if test "X`($echo '\t') 2>/dev/null`" = 'X\t' && echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then # Cool, printf works : elif echo_testing_string=`($ORIGINAL_CONFIG_SHELL "$0" --fallback-echo '\t') 2>/dev/null` && test "X$echo_testing_string" = 'X\t' && echo_testing_string=`($ORIGINAL_CONFIG_SHELL "$0" --fallback-echo "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then CONFIG_SHELL=$ORIGINAL_CONFIG_SHELL export CONFIG_SHELL SHELL="$CONFIG_SHELL" export SHELL echo="$CONFIG_SHELL $0 --fallback-echo" elif echo_testing_string=`($CONFIG_SHELL "$0" --fallback-echo '\t') 2>/dev/null` && test "X$echo_testing_string" = 'X\t' && echo_testing_string=`($CONFIG_SHELL "$0" --fallback-echo "$echo_test_string") 2>/dev/null` && test "X$echo_testing_string" = "X$echo_test_string"; then echo="$CONFIG_SHELL $0 --fallback-echo" else # maybe with a smaller string... prev=: for cmd in 'echo test' 'sed 2q "$0"' 'sed 10q "$0"' 'sed 20q "$0"' 'sed 50q "$0"'; do if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null then break fi prev="$cmd" done if test "$prev" != 'sed 50q "$0"'; then echo_test_string=`eval $prev` export echo_test_string exec ${ORIGINAL_CONFIG_SHELL-${CONFIG_SHELL-/bin/sh}} "$0" ${1+"$@"} else # Oops. We lost completely, so just stick with echo. echo=echo fi fi fi fi fi fi # Copy echo and quote the copy suitably for passing to libtool from # the Makefile, instead of quoting the original, which is used later. ECHO=$echo if test "X$ECHO" = "X$CONFIG_SHELL $0 --fallback-echo"; then ECHO="$CONFIG_SHELL \\\$\$0 --fallback-echo" fi tagnames=${tagnames+${tagnames},}CXX tagnames=${tagnames+${tagnames},}F77 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='SUNDIALS' PACKAGE_TARNAME='sundials' PACKAGE_VERSION='2.5.0' PACKAGE_STRING='SUNDIALS 2.5.0' PACKAGE_BUGREPORT='radu@llnl.gov' ac_unique_file="/src/sundials/sundials_nvector.c" # Factoring default headers for most tests. ac_includes_default="\ #include #if HAVE_SYS_TYPES_H # include #endif #if HAVE_SYS_STAT_H # include #endif #if STDC_HEADERS # include # include #else # if HAVE_STDLIB_H # include # endif #endif #if HAVE_STRING_H # if !STDC_HEADERS && HAVE_MEMORY_H # include # endif # include #endif #if HAVE_STRINGS_H # include #endif #if HAVE_INTTYPES_H # include #else # if HAVE_STDINT_H # include # endif #endif #if HAVE_UNISTD_H # include #endif" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os SET_MAKE INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP FGREP F77 FFLAGS ac_ct_F77 FLIBS MPICC_COMP MPIF77_COMP SED LN_S ECHO AR ac_ct_AR RANLIB ac_ct_RANLIB STRIP ac_ct_STRIP DLLTOOL ac_ct_DLLTOOL AS ac_ct_AS OBJDUMP ac_ct_OBJDUMP CXX CXXFLAGS ac_ct_CXX CXXCPP LIBTOOL SHARED_LIBS MPICC MPIF77 MPI_INC_DIR MPI_LIB_DIR MPI_LIBS MPI_FLAGS FCMIX_ENABLED FLOAT_TYPE LIBTOOL_DEPS F77_MANGLE_MACRO1 F77_MANGLE_MACRO2 F77_CASE F77_UNDERSCORES PRECISION_LEVEL GENERIC_MATH_LIB BLAS_LAPACK_MACRO SUNDIALS_EXPORT F77_MPI_COMM_F2C F77_LNKR F77_LIBS F77_LDFLAGS LAPACK_ENABLED BLAS_LAPACK_LIBS MPIF77_LNKR SLV_MODULES EXS_MODULES EXS_INSTDIR LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS ac_env_CPP_set=${CPP+set} ac_env_CPP_value=$CPP ac_cv_env_CPP_set=${CPP+set} ac_cv_env_CPP_value=$CPP ac_env_F77_set=${F77+set} ac_env_F77_value=$F77 ac_cv_env_F77_set=${F77+set} ac_cv_env_F77_value=$F77 ac_env_FFLAGS_set=${FFLAGS+set} ac_env_FFLAGS_value=$FFLAGS ac_cv_env_FFLAGS_set=${FFLAGS+set} ac_cv_env_FFLAGS_value=$FFLAGS ac_env_CXX_set=${CXX+set} ac_env_CXX_value=$CXX ac_cv_env_CXX_set=${CXX+set} ac_cv_env_CXX_value=$CXX ac_env_CXXFLAGS_set=${CXXFLAGS+set} ac_env_CXXFLAGS_value=$CXXFLAGS ac_cv_env_CXXFLAGS_set=${CXXFLAGS+set} ac_cv_env_CXXFLAGS_value=$CXXFLAGS ac_env_CXXCPP_set=${CXXCPP+set} ac_env_CXXCPP_value=$CXXCPP ac_cv_env_CXXCPP_set=${CXXCPP+set} ac_cv_env_CXXCPP_value=$CXXCPP # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures SUNDIALS 2.5.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF System types: --build=BUILD configure for building on BUILD [guessed] --host=HOST cross-compile to build programs to run on HOST [BUILD] _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of SUNDIALS 2.5.0:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --disable-cvode disable configuration of CVODE --disable-cvodes disable configuration of CVODES --disable-ida disable configuration of IDA --disable-idas disable configuration of IDAS --disable-kinsol disable configuration of KINSOL --disable-cpodes disable configuration of CPODES --disable-fcmix disable Fortran-C support --disable-lapack disable Lapack support --disable-mpi disable MPI support --enable-examples enable configuration of examples --enable-shared[=PKGS] build shared libraries [default=no] --enable-static[=PKGS] build static libraries [default=yes] --enable-fast-install[=PKGS] optimize for fast installation [default=yes] --disable-libtool-lock avoid locking (might break parallel builds) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-precision=ARG specify floating-point precision (single/double/extended) [double] --with-cflags=ARG specify C compiler flags (CFLAGS will be overridden) --with-cppflags=ARG specify C/C++ preprocessor flags (CPPFLAGS will be overridden) --with-ldflags=ARG specify linker flags (LDFLAGS will be overridden) --with-libs=ARG add extra libraries --with-fflags=ARG add extra Fortran compiler flags --with-blas=ARG specify Blas library --with-lapack=ARG specify Lapack library --with-mpi-root=MPIROOT use MPI root directory --with-mpi-incdir=DIR MPI include directory [MPIROOT/include] --with-mpi-libdir=DIR MPI library directory [MPIROOT/lib] --with-mpi-libs=ARG MPI libraries --with-mpi-flags=ARG MPI-specific flags --with-mpicc[=ARG] specify MPI-C compiler to use [mpicc] --with-mpif77[=ARG] specify MPI-Fortran compiler to use [mpif77] --with-exinstdir=DIR install SUNDIALS examples in DIR [EPREFIX/examples] --with-gnu-ld assume the C compiler uses GNU ld [default=no] --with-pic try to use only PIC/non-PIC objects [default=use both] --with-tags[=TAGS] include additional configurations [automatic] NOTES It is legal to set --with-exinstdir to "no", in which case the examples are built but not installed. Enabling the compilation of the examples (--enable-examples) but disabling their installation (--with-exinstdir=no) can be used to test the SUNDIALS libraries. Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor F77 Fortran 77 compiler command FFLAGS Fortran 77 compiler flags CXX C++ compiler command CXXFLAGS C++ compiler flags CXXCPP C++ preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF SUNDIALS configure 2.5.0 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. Copyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. All rights reserved. For details, see the LICENSE file. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by SUNDIALS $as_me 2.5.0, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Display greeting # Say Hi! echo " --------------------------------- Running SUNDIALS Configure Script --------------------------------- " # Specify directory containing auxillary build tools and M4 files ac_aux_dir= for ac_dir in config $srcdir/config; do if test -f $ac_dir/install-sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f $ac_dir/install.sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f $ac_dir/shtool; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in config $srcdir/config" >&5 echo "$as_me: error: cannot find install-sh or install.sh in config $srcdir/config" >&2;} { (exit 1); exit 1; }; } fi ac_config_guess="$SHELL $ac_aux_dir/config.guess" ac_config_sub="$SHELL $ac_aux_dir/config.sub" ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. # Miscellaneous SUNDIALS initializations echo "Initialization" echo "--------------" echo "" # Reference custom macros # This file is part of Autoconf. -*- Autoconf -*- # Fortran languages support. # Copyright (C) 2001, 2003 # Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # Fortran vs. Fortran 77: # This file contains macros for both "Fortran 77" and "Fortran", where # the former is the "classic" autoconf Fortran interface and is intended # for legacy F77 codes, while the latter is intended to support newer Fortran # dialects. Fortran 77 uses environment variables F77, FFLAGS, and FLIBS, # while Fortran uses FC, FCFLAGS, and FCLIBS. For each user-callable AC_* # macro, there is generally both an F77 and an FC version, where both versions # share the same _AC_*_FC_* backend. This backend macro requires that # the appropriate language be AC_LANG_PUSH'ed, and uses _AC_LANG_ABBREV and # _AC_LANG_PREFIX in order to name cache and environment variables, etc. # _AC_PROG_FC_V_OUTPUT([FLAG = $ac_cv_prog_{f77/fc}_v]) # ------------------------------------------------- # Link a trivial Fortran program, compiling with a verbose output FLAG # (whose default value, $ac_cv_prog_{f77/fc}_v, is computed by # _AC_PROG_FC_V), and return the output in $ac_{f77/fc}_v_output. This # output is processed in the way expected by _AC_FC_LIBRARY_LDFLAGS, # so that any link flags that are echoed by the compiler appear as # space-separated items. # _AC_PROG_FC_V_OUTPUT # This file is part of Autoconf. -*- Autoconf -*- # Programming languages support. # Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # AC_LANG(C) # ---------- # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. # This file is part of Autoconf. -*- Autoconf -*- # Parameterized macros. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # As a special exception, the Free Software Foundation gives unlimited # permission to copy, distribute and modify the configure scripts that # are the output of Autoconf. You need not follow the terms of the GNU # General Public License when using or distributing such scripts, even # though portions of the text of Autoconf appear in them. The GNU # General Public License (GPL) does govern all other use of the material # that constitutes the Autoconf program. # # Certain portions of the Autoconf source text are designed to be copied # (in certain cases, depending on the input) into the output of # Autoconf. We call these the "data" portions. The rest of the Autoconf # source text consists of comments plus executable code that decides which # of the data portions to output in any given case. We call these # comments and executable code the "non-data" portions. Autoconf never # copies any of the non-data portions into its output. # # This special exception to the GPL applies to versions of Autoconf # released by the Free Software Foundation. When you make and # distribute a modified version of Autoconf, you may extend this special # exception to the GPL to apply to your modified version as well, *unless* # your modified version has the potential to copy into its output some # of the text that was the non-data portion of the version that you started # with. (In other words, unless your change moves or copies text from # the non-data portions to the data portions.) If your modification has # such potential, you must delete any notice of this special exception # to the GPL from your modified version. # # Written by David MacKenzie, with help from # Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor, # Roland McGrath, Noah Friedman, david d zuhn, and many others. # _AC_MSG_LOG_CONFTEST_GENERAL # ---------------------------- # _AC_LINKONLY_IFELSE(PROGRAM, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # ------------------------------------------------------------------ # Try to link PROGRAM (empty). # This macro can be used during the selection of a compiler. # _AC_LINKONLY_IFELSE # AC_LINKONLY_IFELSE(PROGRAM, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # ----------------------------------------------------------------- # Try to link PROGRAM. Requires that the compiler for the current # language was checked for, hence do not use this macro in macros looking # for a compiler. # Make input filename DOS compatible (change config.h.in to config.hin) ac_config_headers="$ac_config_headers config.h:config.hin" # Make user aware of copyright notice (input COPYRIGHT information) # Specify root of source tree # Given file is guaranteed to exist in all SUNDIALS packages # Get host information # AC_CANONICAL_BUILD defines the following variables: build, build_cpu, # build_vendor, and build_os # Make sure we can run config.sub. $ac_config_sub sun4 >/dev/null 2>&1 || { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5 echo "$as_me: error: cannot run $ac_config_sub" >&2;} { (exit 1); exit 1; }; } echo "$as_me:$LINENO: checking build system type" >&5 echo $ECHO_N "checking build system type... $ECHO_C" >&6 if test "${ac_cv_build+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_build_alias=$build_alias test -z "$ac_cv_build_alias" && ac_cv_build_alias=`$ac_config_guess` test -z "$ac_cv_build_alias" && { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5 echo "$as_me: error: cannot guess build type; you must specify one" >&2;} { (exit 1); exit 1; }; } ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5 echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: result: $ac_cv_build" >&5 echo "${ECHO_T}$ac_cv_build" >&6 build=$ac_cv_build build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` # AC_CANONICAL_HOST defines the following variables: host, host_cpu, # host_vendor, and host_os echo "$as_me:$LINENO: checking host system type" >&5 echo $ECHO_N "checking host system type... $ECHO_C" >&6 if test "${ac_cv_host+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_host_alias=$host_alias test -z "$ac_cv_host_alias" && ac_cv_host_alias=$ac_cv_build_alias ac_cv_host=`$ac_config_sub $ac_cv_host_alias` || { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5 echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: result: $ac_cv_host" >&5 echo "${ECHO_T}$ac_cv_host" >&6 host=$ac_cv_host host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` # Set MAKE if necessary # Must include @SET_MAKE@ in each Makefile.in file # AC_SUBST is called automatically for SET_MAKE echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF all: @echo 'ac_maketemp="$(MAKE)"' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi # Defines INSTALL (sets to path of "install" program) # Also sets INSTALL_PROGRAM and INSTALL_SCRIPT # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install # AmigaOS /C/install, which installs bootblocks on floppy discs # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 if test -z "$INSTALL"; then if test "${ac_cv_path_install+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. # Account for people who put trailing slashes in PATH elements. case $as_dir/ in ./ | .// | /cC/* | \ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \ /usr/ucb/* ) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. # Don't use installbsd from OSF since it installs stuff as root # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. : elif test $ac_prog = install && grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # program-specific install script used by HP pwplus--don't use. : else ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" break 3 fi fi done done ;; esac done fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else # As a last resort, use the slow shell script. We don't cache a # path for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the path is relative. INSTALL=$ac_install_sh fi fi echo "$as_me:$LINENO: result: $INSTALL" >&5 echo "${ECHO_T}$INSTALL" >&6 # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' # Set defaults for config/sundials_config.in file F77_MANGLE_MACRO1="" F77_MANGLE_MACRO2="" PRECISION_LEVEL="" GENERIC_MATH_LIB="" BLAS_LAPACK_MACRO="" F77_MPI_COMM_F2C="" SUNDIALS_EXPORT="#define SUNDIALS_EXPORT" # Initialize enable status of various modules, options, and features # to their default values # # NOTE: when CPODES is released, change its default to enabled. # CVODE_ENABLED="yes" CVODES_ENABLED="yes" IDA_ENABLED="yes" IDAS_ENABLED="yes" KINSOL_ENABLED="yes" LAPACK_ENABLED="yes" FCMIX_ENABLED="yes" MPI_ENABLED="yes" # CPODES_ENABLED="no" # EXAMPLES_ENABLED="no" F77_EXAMPLES_ENABLED="no" # Initialize variables that may NOT necessarily be initialized # during normal execution. Should NOT use uninitialized variables F77_OK="no" LAPACK_OK="no" MPI_C_COMP_OK="no" MPI_F77_COMP_OK="no" # This variable is set to "yes" if an AC_MSG_WARN statement # was executed SUNDIALS_WARN_FLAG="no" # Test enable/disable features # Check if user wants to disable CVODE module # If not, then make certain source directory actually exists # Check whether --enable-cvode or --disable-cvode was given. if test "${enable_cvode+set}" = set; then enableval="$enable_cvode" if test "X${enableval}" = "Xno"; then CVODE_ENABLED="no" fi else if test -d ${srcdir}/src/cvode ; then CVODE_ENABLED="yes" else CVODE_ENABLED="no" fi fi; # Check if user wants to disable CVODES module # If not, then make certain source directory actually exists # Check whether --enable-cvodes or --disable-cvodes was given. if test "${enable_cvodes+set}" = set; then enableval="$enable_cvodes" if test "X${enableval}" = "Xno"; then CVODES_ENABLED="no" fi else if test -d ${srcdir}/src/cvodes ; then CVODES_ENABLED="yes" else CVODES_ENABLED="no" fi fi; # Check if user wants to disable IDA module # If not, then make certain source directory actually exists # Check whether --enable-ida or --disable-ida was given. if test "${enable_ida+set}" = set; then enableval="$enable_ida" if test "X${enableval}" = "Xno"; then IDA_ENABLED="no" fi else if test -d ${srcdir}/src/ida ; then IDA_ENABLED="yes" else IDA_ENABLED="no" fi fi; # Check if user wants to disable IDAS module # If not, then make certain source directory actually exists # Check whether --enable-idas or --disable-idas was given. if test "${enable_idas+set}" = set; then enableval="$enable_idas" if test "X${enableval}" = "Xno"; then IDAS_ENABLED="no" fi else if test -d ${srcdir}/src/idas ; then IDAS_ENABLED="yes" else IDAS_ENABLED="no" fi fi; # Check if user wants to disable KINSOL MODULE # If not, then make certain source directory actually exists # Check whether --enable-kinsol or --disable-kinsol was given. if test "${enable_kinsol+set}" = set; then enableval="$enable_kinsol" if test "X${enableval}" = "Xno"; then KINSOL_ENABLED="no" fi else if test -d ${srcdir}/src/kinsol ; then KINSOL_ENABLED="yes" else KINSOL_ENABLED="no" fi fi; # Check if user wants to disable CPODES module # If not, then make certain source directory actually exists # Check whether --enable-cpodes or --disable-cpodes was given. if test "${enable_cpodes+set}" = set; then enableval="$enable_cpodes" if test "X${enableval}" = "Xno"; then CPODES_ENABLED="no" fi else if test -d ${srcdir}/src/cpodes ; then CPODES_ENABLED="yes" else CPODES_ENABLED="no" fi fi; # Check if user wants to disable Fortran support (FCMIX components). # Check whether --enable-fcmix or --disable-fcmix was given. if test "${enable_fcmix+set}" = set; then enableval="$enable_fcmix" if test "X${enableval}" = "Xno"; then FCMIX_ENABLED="no" fi else if test "X${CVODE_ENABLED}" = "Xno" && test "X${KINSOL_ENABLED}" = "Xno" && test "X${IDA_ENABLED}" = "Xno"; then FCMIX_ENABLED="no" fi fi; # Check if user wants to disable Lapack support. # Check whether --enable-lapack or --disable-lapack was given. if test "${enable_lapack+set}" = set; then enableval="$enable_lapack" if test "X${enableval}" = "Xno"; then LAPACK_ENABLED="no" fi fi; # Check if user wants to disable support for MPI. # If not, set the default based on whetehr certain source directories exist # Check whether --enable-mpi or --disable-mpi was given. if test "${enable_mpi+set}" = set; then enableval="$enable_mpi" if test "X${enableval}" = "Xno"; then MPI_ENABLED="no" fi else if test -d ${srcdir}/src/nvec_par || test -d ${srcdir}/src/nvec_spcpar; then MPI_ENABLED="yes" else MPI_ENABLED="no" fi fi; # Check if user wants to enable all examples. # Examples are NOT built by default # Check whether --enable-examples or --disable-examples was given. if test "${enable_examples+set}" = set; then enableval="$enable_examples" if test "X${enableval}" = "Xno"; then EXAMPLES_ENABLED="no" else EXAMPLES_ENABLED="yes" fi fi; # Fortran examples are enabled only if both FCMIX and EXAMPLES are enabled if test "X${FCMIX_ENABLED}" = "Xyes" && test "X${EXAMPLES_ENABLED}" = "Xyes"; then F77_EXAMPLES_ENABLED="yes" fi # Set C compilation (Required) echo "" echo "C Compiler Settings" echo "-------------------" echo "" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in cc gcc do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cc gcc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep # On IRIX 5.3, sys/types and inttypes.h are conflicting. for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ inttypes.h stdint.h unistd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Header=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Header=no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done if test "X${CC}" = "X"; then echo "" echo " Unable to find a working C compiler" echo "" echo " Try using CC to explicitly specify a C compiler" echo "" { { echo "$as_me:$LINENO: error: cannot find a C compiler" >&5 echo "$as_me: error: cannot find a C compiler" >&2;} { (exit 1); exit 1; }; } else # Default is C programming language (initialize language stack) ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Set floating-point precision: single [C type 'float'] # double [C type 'double'] (default) # extended [C type 'long double'] # Provide variable description templates for config.hin and config.h files # Required by autoheader utility echo "$as_me:$LINENO: checking floating-point data type to use" >&5 echo $ECHO_N "checking floating-point data type to use... $ECHO_C" >&6 # Check whether --with-precision or --without-precision was given. if test "${with_precision+set}" = set; then withval="$with_precision" if test "X${withval}" = "Xsingle"; then echo "$as_me:$LINENO: result: float" >&5 echo "${ECHO_T}float" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_SINGLE_PRECISION 1 _ACEOF FLOAT_TYPE="single" PRECISION_LEVEL="#define SUNDIALS_SINGLE_PRECISION 1" elif test "X${withval}" = "Xdouble"; then echo "$as_me:$LINENO: result: double" >&5 echo "${ECHO_T}double" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_DOUBLE_PRECISION 1 _ACEOF FLOAT_TYPE="double" PRECISION_LEVEL="#define SUNDIALS_DOUBLE_PRECISION 1" elif test "X${withval}" = "Xextended"; then echo "$as_me:$LINENO: result: long double" >&5 echo "${ECHO_T}long double" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_EXTENDED_PRECISION 1 _ACEOF FLOAT_TYPE="extended" PRECISION_LEVEL="#define SUNDIALS_EXTENDED_PRECISION 1" else { { echo "$as_me:$LINENO: error: invalid input" >&5 echo "$as_me: error: invalid input" >&2;} { (exit 1); exit 1; }; } fi else # Use 'double' by default echo "$as_me:$LINENO: result: double" >&5 echo "${ECHO_T}double" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_DOUBLE_PRECISION 1 _ACEOF FLOAT_TYPE="double" PRECISION_LEVEL="#define SUNDIALS_DOUBLE_PRECISION 1" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Overwrite CFLAGS echo "$as_me:$LINENO: checking for C compiler flags" >&5 echo $ECHO_N "checking for C compiler flags... $ECHO_C" >&6 # Check whether --with-cflags or --without-cflags was given. if test "${with_cflags+set}" = set; then withval="$with_cflags" echo "$as_me:$LINENO: result: ${withval}" >&5 echo "${ECHO_T}${withval}" >&6 CFLAGS="${withval}" else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi; # Set CPP to command that runs C preprocessor ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test "${ac_cv_prog_CPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi echo "$as_me:$LINENO: result: $CPP" >&5 echo "${ECHO_T}$CPP" >&6 ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Overwrite CPPFLAGS echo "$as_me:$LINENO: checking for C/C++ preprocessor flags" >&5 echo $ECHO_N "checking for C/C++ preprocessor flags... $ECHO_C" >&6 # Check whether --with-cppflags or --without-cppflags was given. if test "${with_cppflags+set}" = set; then withval="$with_cppflags" echo "$as_me:$LINENO: result: ${withval}" >&5 echo "${ECHO_T}${withval}" >&6 CPPFLAGS="${withval}" else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi; # Overwrite LDFLAGS echo "$as_me:$LINENO: checking for linker flags" >&5 echo $ECHO_N "checking for linker flags... $ECHO_C" >&6 # Check whether --with-ldflags or --without-ldflags was given. if test "${with_ldflags+set}" = set; then withval="$with_ldflags" echo "$as_me:$LINENO: result: ${withval}" >&5 echo "${ECHO_T}${withval}" >&6 LDFLAGS="${withval}" else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi; # Add any additional libraries echo "$as_me:$LINENO: checking for extra libraries" >&5 echo $ECHO_N "checking for extra libraries... $ECHO_C" >&6 # Check whether --with-libs or --without-libs was given. if test "${with_libs+set}" = set; then withval="$with_libs" echo "$as_me:$LINENO: result: ${withval}" >&5 echo "${ECHO_T}${withval}" >&6 if test "X${LIBS}" = "X"; then LIBS="${withval}" else LIBS="${LIBS} ${withval}" fi else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi; # Defines STDC_HEADERS if the following header files are found: stdlib.h, # stdarg.h, string.h, and float.h # We really only need stdlib.h and float.h echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 if test "${ac_cv_header_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_header_stdc=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "memchr" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "free" >/dev/null 2>&1; then : else ac_cv_header_stdc=no fi rm -f conftest* fi if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #if ((' ' & 0x0FF) == 0x020) # define ISLOWER(c) ('a' <= (c) && (c) <= 'z') # define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #else # define ISLOWER(c) \ (('a' <= (c) && (c) <= 'i') \ || ('j' <= (c) && (c) <= 'r') \ || ('s' <= (c) && (c) <= 'z')) # define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) #endif #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_header_stdc=no fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi fi echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 echo "${ECHO_T}$ac_cv_header_stdc" >&6 if test $ac_cv_header_stdc = yes; then cat >>confdefs.h <<\_ACEOF #define STDC_HEADERS 1 _ACEOF fi for ac_header in stdlib.h float.h math.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ---------------------------- ## ## Report this to radu@llnl.gov ## ## ---------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done # Set flag indicating if generic function names should be used # Provide variable description template for config.hin and config.h files # Required by autoheader utility # Check if math library contains abs(), fabs(), pow(), and sqrt() functions (required) # May update LIBS (meaning add additional library, namely libm) MATH_FABS_OK="yes" MATH_POW_OK="yes" MATH_SQRT_OK="yes" # Save copy of LIBS variable and unset LIBS SAVED_LIBS="${LIBS}" LIBS="" # The abs routine is defined for an integer argument, so check for it regardless of # the level of precision chosen echo "$as_me:$LINENO: checking for abs in -lm" >&5 echo $ECHO_N "checking for abs in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_abs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char abs (); int main () { abs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_abs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_abs=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_abs" >&5 echo "${ECHO_T}$ac_cv_lib_m_abs" >&6 if test $ac_cv_lib_m_abs = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find abs function" >&5 echo "$as_me: error: cannot find abs function" >&2;} { (exit 1); exit 1; }; } fi TEMP_MATH_LIB="${LIBS}" LIBS="" # Check for single-precision math routines if test "X${FLOAT_TYPE}" = "Xsingle"; then echo "$as_me:$LINENO: checking for fabsf in -lm" >&5 echo $ECHO_N "checking for fabsf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_fabsf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fabsf (); int main () { fabsf (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_fabsf=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_fabsf=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabsf" >&5 echo "${ECHO_T}$ac_cv_lib_m_fabsf" >&6 if test $ac_cv_lib_m_fabsf = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_FABS_OK="no" fi echo "$as_me:$LINENO: checking for powf in -lm" >&5 echo $ECHO_N "checking for powf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_powf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char powf (); int main () { powf (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_powf=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_powf=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_powf" >&5 echo "${ECHO_T}$ac_cv_lib_m_powf" >&6 if test $ac_cv_lib_m_powf = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_POW_OK="no" fi echo "$as_me:$LINENO: checking for sqrtf in -lm" >&5 echo $ECHO_N "checking for sqrtf in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sqrtf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sqrtf (); int main () { sqrtf (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_sqrtf=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_sqrtf=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrtf" >&5 echo "${ECHO_T}$ac_cv_lib_m_sqrtf" >&6 if test $ac_cv_lib_m_sqrtf = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_SQRT_OK="no" fi # Check for extended-precision math routines elif test "X${FLOAT_TYPE}" = "Xextended"; then echo "$as_me:$LINENO: checking for fabsl in -lm" >&5 echo $ECHO_N "checking for fabsl in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_fabsl+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fabsl (); int main () { fabsl (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_fabsl=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_fabsl=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabsl" >&5 echo "${ECHO_T}$ac_cv_lib_m_fabsl" >&6 if test $ac_cv_lib_m_fabsl = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_FABS_OK="no" fi echo "$as_me:$LINENO: checking for powl in -lm" >&5 echo $ECHO_N "checking for powl in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_powl+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char powl (); int main () { powl (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_powl=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_powl=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_powl" >&5 echo "${ECHO_T}$ac_cv_lib_m_powl" >&6 if test $ac_cv_lib_m_powl = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_POW_OK="no" fi echo "$as_me:$LINENO: checking for sqrtl in -lm" >&5 echo $ECHO_N "checking for sqrtl in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sqrtl+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sqrtl (); int main () { sqrtl (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_sqrtl=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_sqrtl=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrtl" >&5 echo "${ECHO_T}$ac_cv_lib_m_sqrtl" >&6 if test $ac_cv_lib_m_sqrtl = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else MATH_SQRT_OK="no" fi # Check for (generic) double-precision math routines elif test "X${FLOAT_TYPE}" = "Xdouble"; then echo "$as_me:$LINENO: checking for fabs in -lm" >&5 echo $ECHO_N "checking for fabs in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_fabs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fabs (); int main () { fabs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_fabs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_fabs=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabs" >&5 echo "${ECHO_T}$ac_cv_lib_m_fabs" >&6 if test $ac_cv_lib_m_fabs = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find fabs function" >&5 echo "$as_me: error: cannot find fabs function" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for pow in -lm" >&5 echo $ECHO_N "checking for pow in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_pow+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pow (); int main () { pow (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_pow=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_pow=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_pow" >&5 echo "${ECHO_T}$ac_cv_lib_m_pow" >&6 if test $ac_cv_lib_m_pow = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find pow function" >&5 echo "$as_me: error: cannot find pow function" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for sqrt in -lm" >&5 echo $ECHO_N "checking for sqrt in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sqrt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sqrt (); int main () { sqrt (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_sqrt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_sqrt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrt" >&5 echo "${ECHO_T}$ac_cv_lib_m_sqrt" >&6 if test $ac_cv_lib_m_sqrt = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find sqrt function" >&5 echo "$as_me: error: cannot find sqrt function" >&2;} { (exit 1); exit 1; }; } fi fi # If cannot find precision-specific implementations, then check for generic versions if test "X${MATH_FABS_OK}" = "Xno" || test "X${MATH_POW_OK}" = "Xno" || test "X${MATH_SQRT_OK}" = "Xno"; then echo "$as_me:$LINENO: checking for fabs in -lm" >&5 echo $ECHO_N "checking for fabs in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_fabs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char fabs (); int main () { fabs (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_fabs=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_fabs=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_fabs" >&5 echo "${ECHO_T}$ac_cv_lib_m_fabs" >&6 if test $ac_cv_lib_m_fabs = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find fabs function" >&5 echo "$as_me: error: cannot find fabs function" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for pow in -lm" >&5 echo $ECHO_N "checking for pow in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_pow+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char pow (); int main () { pow (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_pow=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_pow=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_pow" >&5 echo "${ECHO_T}$ac_cv_lib_m_pow" >&6 if test $ac_cv_lib_m_pow = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find pow function" >&5 echo "$as_me: error: cannot find pow function" >&2;} { (exit 1); exit 1; }; } fi echo "$as_me:$LINENO: checking for sqrt in -lm" >&5 echo $ECHO_N "checking for sqrt in -lm... $ECHO_C" >&6 if test "${ac_cv_lib_m_sqrt+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lm $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char sqrt (); int main () { sqrt (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_m_sqrt=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_m_sqrt=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_m_sqrt" >&5 echo "${ECHO_T}$ac_cv_lib_m_sqrt" >&6 if test $ac_cv_lib_m_sqrt = yes; then cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF LIBS="-lm $LIBS" else { { echo "$as_me:$LINENO: error: cannot find sqrt function" >&5 echo "$as_me: error: cannot find sqrt function" >&2;} { (exit 1); exit 1; }; } fi # If all generic math routines are available, then set SUNDIALS_USE_GENERIC_MATH flag # for use by sundials_math.c file (preprocessor macros) cat >>confdefs.h <<\_ACEOF #define SUNDIALS_USE_GENERIC_MATH 1 _ACEOF GENERIC_MATH_LIB="#define SUNDIALS_USE_GENERIC_MATH" # If found all precision-specific routines, then set SUNDIALS_USE_GENERIC_MATH only if # building SUNDIALS libraries with double-precision else if test "X${FLOAT_TYPE}" = "Xdouble"; then cat >>confdefs.h <<\_ACEOF #define SUNDIALS_USE_GENERIC_MATH 1 _ACEOF GENERIC_MATH_LIB="#define SUNDIALS_USE_GENERIC_MATH" else cat >>confdefs.h <<\_ACEOF #define SUNDIALS_USE_GENERIC_MATH 0 _ACEOF fi fi # Add math library to LIBS environment variable LIBS="${TEMP_MATH_LIB}" echo "$as_me:$LINENO: checking for additional required C libraries" >&5 echo $ECHO_N "checking for additional required C libraries... $ECHO_C" >&6 if test "X${LIBS}" = "X"; then if test "X${SAVED_LIBS}" = "X"; then LIBS="" else LIBS="${SAVED_LIBS}" fi echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 else echo "$as_me:$LINENO: result: ${LIBS}" >&5 echo "${ECHO_T}${LIBS}" >&6 if test "X${SAVED_LIBS}" = "X"; then LIBS="${LIBS}" else LIBS="${LIBS} ${SAVED_LIBS}" fi fi # Check sizeof(int) - used to modify Fortran examples echo "$as_me:$LINENO: checking for int" >&5 echo $ECHO_N "checking for int... $ECHO_C" >&6 if test "${ac_cv_type_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((int *) 0) return 0; if (sizeof (int)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_int=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 echo "${ECHO_T}$ac_cv_type_int" >&6 echo "$as_me:$LINENO: checking size of int" >&5 echo $ECHO_N "checking size of int... $ECHO_C" >&6 if test "${ac_cv_sizeof_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_int" = yes; then # The cast to unsigned long works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (int))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (int))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (int))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_int=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default long longval () { return (long) (sizeof (int)); } unsigned long ulongval () { return (long) (sizeof (int)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) exit (1); if (((long) (sizeof (int))) < 0) { long i = longval (); if (i != ((long) (sizeof (int)))) exit (1); fprintf (f, "%ld\n", i); } else { unsigned long i = ulongval (); if (i != ((long) (sizeof (int)))) exit (1); fprintf (f, "%lu\n", i); } exit (ferror (f) || fclose (f) != 0); ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (int), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.val else ac_cv_sizeof_int=0 fi fi echo "$as_me:$LINENO: result: $ac_cv_sizeof_int" >&5 echo "${ECHO_T}$ac_cv_sizeof_int" >&6 cat >>confdefs.h <<_ACEOF #define SIZEOF_INT $ac_cv_sizeof_int _ACEOF # Check sizeof(long int) - used to modify Fortran examples echo "$as_me:$LINENO: checking for long int" >&5 echo $ECHO_N "checking for long int... $ECHO_C" >&6 if test "${ac_cv_type_long_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((long int *) 0) return 0; if (sizeof (long int)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_int=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_int=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_long_int" >&5 echo "${ECHO_T}$ac_cv_type_long_int" >&6 echo "$as_me:$LINENO: checking size of long int" >&5 echo $ECHO_N "checking size of long int... $ECHO_C" >&6 if test "${ac_cv_sizeof_long_int+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_long_int" = yes; then # The cast to unsigned long works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long int))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long int))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long int))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long int))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long int))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_long_int=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (long int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long int), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default long longval () { return (long) (sizeof (long int)); } unsigned long ulongval () { return (long) (sizeof (long int)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) exit (1); if (((long) (sizeof (long int))) < 0) { long i = longval (); if (i != ((long) (sizeof (long int)))) exit (1); fprintf (f, "%ld\n", i); } else { unsigned long i = ulongval (); if (i != ((long) (sizeof (long int)))) exit (1); fprintf (f, "%lu\n", i); } exit (ferror (f) || fclose (f) != 0); ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_long_int=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (long int), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long int), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.val else ac_cv_sizeof_long_int=0 fi fi echo "$as_me:$LINENO: result: $ac_cv_sizeof_long_int" >&5 echo "${ECHO_T}$ac_cv_sizeof_long_int" >&6 cat >>confdefs.h <<_ACEOF #define SIZEOF_LONG_INT $ac_cv_sizeof_long_int _ACEOF # Check sizeof(realtype), where realtype is either float, double # or long double - used to modify Fortran examples if test "X${FLOAT_TYPE}" = "Xsingle"; then echo "$as_me:$LINENO: checking for float" >&5 echo $ECHO_N "checking for float... $ECHO_C" >&6 if test "${ac_cv_type_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((float *) 0) return 0; if (sizeof (float)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_float=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_float=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_float" >&5 echo "${ECHO_T}$ac_cv_type_float" >&6 echo "$as_me:$LINENO: checking size of float" >&5 echo $ECHO_N "checking size of float... $ECHO_C" >&6 if test "${ac_cv_sizeof_float+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_float" = yes; then # The cast to unsigned long works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (float))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (float))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (float))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (float))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (float))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_float=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (float), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default long longval () { return (long) (sizeof (float)); } unsigned long ulongval () { return (long) (sizeof (float)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) exit (1); if (((long) (sizeof (float))) < 0) { long i = longval (); if (i != ((long) (sizeof (float)))) exit (1); fprintf (f, "%ld\n", i); } else { unsigned long i = ulongval (); if (i != ((long) (sizeof (float)))) exit (1); fprintf (f, "%lu\n", i); } exit (ferror (f) || fclose (f) != 0); ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_float=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (float), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (float), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.val else ac_cv_sizeof_float=0 fi fi echo "$as_me:$LINENO: result: $ac_cv_sizeof_float" >&5 echo "${ECHO_T}$ac_cv_sizeof_float" >&6 cat >>confdefs.h <<_ACEOF #define SIZEOF_FLOAT $ac_cv_sizeof_float _ACEOF elif test "X${FLOAT_TYPE}" = "Xdouble"; then echo "$as_me:$LINENO: checking for double" >&5 echo $ECHO_N "checking for double... $ECHO_C" >&6 if test "${ac_cv_type_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((double *) 0) return 0; if (sizeof (double)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_double=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_double=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_double" >&5 echo "${ECHO_T}$ac_cv_type_double" >&6 echo "$as_me:$LINENO: checking size of double" >&5 echo $ECHO_N "checking size of double... $ECHO_C" >&6 if test "${ac_cv_sizeof_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_double" = yes; then # The cast to unsigned long works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (double))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (double))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (double))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (double))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (double))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_double=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (double), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default long longval () { return (long) (sizeof (double)); } unsigned long ulongval () { return (long) (sizeof (double)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) exit (1); if (((long) (sizeof (double))) < 0) { long i = longval (); if (i != ((long) (sizeof (double)))) exit (1); fprintf (f, "%ld\n", i); } else { unsigned long i = ulongval (); if (i != ((long) (sizeof (double)))) exit (1); fprintf (f, "%lu\n", i); } exit (ferror (f) || fclose (f) != 0); ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_double=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (double), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (double), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.val else ac_cv_sizeof_double=0 fi fi echo "$as_me:$LINENO: result: $ac_cv_sizeof_double" >&5 echo "${ECHO_T}$ac_cv_sizeof_double" >&6 cat >>confdefs.h <<_ACEOF #define SIZEOF_DOUBLE $ac_cv_sizeof_double _ACEOF elif test "X${FLOAT_TYPE}" = "Xextended"; then echo "$as_me:$LINENO: checking for long double" >&5 echo $ECHO_N "checking for long double... $ECHO_C" >&6 if test "${ac_cv_type_long_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { if ((long double *) 0) return 0; if (sizeof (long double)) return 0; ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_long_double=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_type_long_double=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_long_double" >&5 echo "${ECHO_T}$ac_cv_type_long_double" >&6 echo "$as_me:$LINENO: checking size of long double" >&5 echo $ECHO_N "checking size of long double... $ECHO_C" >&6 if test "${ac_cv_sizeof_long_double+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$ac_cv_type_long_double" = yes; then # The cast to unsigned long works around a bug in the HP C Compiler # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. # This bug is HP SR number 8606223364. if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long double))) >= 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long double))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr $ac_mid + 1` if test $ac_lo -le $ac_mid; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long double))) < 0)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long double))) >= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_hi=`expr '(' $ac_mid ')' - 1` if test $ac_mid -le $ac_hi; then ac_lo= ac_hi= break fi ac_mid=`expr 2 '*' $ac_mid` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo= ac_hi= fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Binary search between lo and hi bounds. while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default int main () { static int test_array [1 - 2 * !(((long) (sizeof (long double))) <= $ac_mid)]; test_array [0] = 0 ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_lo=`expr '(' $ac_mid ')' + 1` fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done case $ac_lo in ?*) ac_cv_sizeof_long_double=$ac_lo;; '') { { echo "$as_me:$LINENO: error: cannot compute sizeof (long double), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long double), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } ;; esac else if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default long longval () { return (long) (sizeof (long double)); } unsigned long ulongval () { return (long) (sizeof (long double)); } #include #include int main () { FILE *f = fopen ("conftest.val", "w"); if (! f) exit (1); if (((long) (sizeof (long double))) < 0) { long i = longval (); if (i != ((long) (sizeof (long double)))) exit (1); fprintf (f, "%ld\n", i); } else { unsigned long i = ulongval (); if (i != ((long) (sizeof (long double)))) exit (1); fprintf (f, "%lu\n", i); } exit (ferror (f) || fclose (f) != 0); ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_long_double=`cat conftest.val` else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) { { echo "$as_me:$LINENO: error: cannot compute sizeof (long double), 77 See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute sizeof (long double), 77 See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.val else ac_cv_sizeof_long_double=0 fi fi echo "$as_me:$LINENO: result: $ac_cv_sizeof_long_double" >&5 echo "${ECHO_T}$ac_cv_sizeof_long_double" >&6 cat >>confdefs.h <<_ACEOF #define SIZEOF_LONG_DOUBLE $ac_cv_sizeof_long_double _ACEOF fi # Defines EGREP and exports via AC_SUBST - used by FCMIX Makefile's echo "$as_me:$LINENO: checking for egrep" >&5 echo $ECHO_N "checking for egrep... $ECHO_C" >&6 if test "${ac_cv_prog_egrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo a | (grep -E '(a|b)') >/dev/null 2>&1 then ac_cv_prog_egrep='grep -E' else ac_cv_prog_egrep='egrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 echo "${ECHO_T}$ac_cv_prog_egrep" >&6 EGREP=$ac_cv_prog_egrep # Defines FGREP and exports via AC_SUBST - used by FCMIX Makefile's echo "$as_me:$LINENO: checking for fgrep" >&5 echo $ECHO_N "checking for fgrep... $ECHO_C" >&6 if test "${ac_cv_prog_fgrep+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if echo 'ab*c' | (grep -F 'ab*c') >/dev/null 2>&1 then ac_cv_prog_fgrep='grep -F' else ac_cv_prog_fgrep='fgrep' fi fi echo "$as_me:$LINENO: result: $ac_cv_prog_fgrep" >&5 echo "${ECHO_T}$ac_cv_prog_fgrep" >&6 FGREP=$ac_cv_prog_fgrep # Check if CC is a C++ compiler # Note: If CC is a C++ compiler and MPI is enabled, then we will # check for "mpiCC" instead of "mpicc" if an MPI compiler was NOT specified # Rename argument COMP_NAME="${CC}" # Update the language stack ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check if using a C++ compiler echo "$as_me:$LINENO: checking if ${COMP_NAME} is a C++ compiler" >&5 echo $ECHO_N "checking if ${COMP_NAME} is a C++ compiler... $ECHO_C" >&6 if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifdef __cplusplus return(0); #else return(1); #endif ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 # COMP_NAME is a C++ compiler USING_CPLUSPLUS_COMP="yes" else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 # COMP_NAMPE is NOT a C++ compiler USING_CPLUSPLUS_COMP="no" fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi # Revert back to previous language ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu fi # Set Fortran support if test "X${FCMIX_ENABLED}" = "Xyes" || test "X${LAPACK_ENABLED}" = "Xyes"; then echo "" echo "Fortran Settings" echo "----------------" echo "" F77_OK="yes" # Look for a F77 compiler # If unsuccessful, disable all Fortran support ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in f77 g77 do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_F77+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$F77"; then ac_cv_prog_F77="$F77" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_F77="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi F77=$ac_cv_prog_F77 if test -n "$F77"; then echo "$as_me:$LINENO: result: $F77" >&5 echo "${ECHO_T}$F77" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$F77" && break done fi if test -z "$F77"; then ac_ct_F77=$F77 for ac_prog in f77 g77 do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_F77+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_F77"; then ac_cv_prog_ac_ct_F77="$ac_ct_F77" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_F77="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_F77=$ac_cv_prog_ac_ct_F77 if test -n "$ac_ct_F77"; then echo "$as_me:$LINENO: result: $ac_ct_F77" >&5 echo "${ECHO_T}$ac_ct_F77" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_F77" && break done F77=$ac_ct_F77 fi # Provide some information about the compiler. echo "$as_me:7176:" \ "checking for Fortran 77 compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } rm -f a.out # If we don't use `.F' as extension, the preprocessor is not run on the # input file. (Note that this only needs to work for GNU compilers.) ac_save_ext=$ac_ext ac_ext=F echo "$as_me:$LINENO: checking whether we are using the GNU Fortran 77 compiler" >&5 echo $ECHO_N "checking whether we are using the GNU Fortran 77 compiler... $ECHO_C" >&6 if test "${ac_cv_f77_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF program main #ifndef __GNUC__ choke me #endif end _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_f77_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_f77_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_f77_compiler_gnu" >&6 ac_ext=$ac_save_ext ac_test_FFLAGS=${FFLAGS+set} ac_save_FFLAGS=$FFLAGS FFLAGS= echo "$as_me:$LINENO: checking whether $F77 accepts -g" >&5 echo $ECHO_N "checking whether $F77 accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_f77_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else FFLAGS=-g cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_f77_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_f77_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_f77_g" >&5 echo "${ECHO_T}$ac_cv_prog_f77_g" >&6 if test "$ac_test_FFLAGS" = set; then FFLAGS=$ac_save_FFLAGS elif test $ac_cv_prog_f77_g = yes; then if test "x$ac_cv_f77_compiler_gnu" = xyes; then FFLAGS="-g -O2" else FFLAGS="-g" fi else if test "x$ac_cv_f77_compiler_gnu" = xyes; then FFLAGS="-O2" else FFLAGS= fi fi G77=`test $ac_compiler_gnu = yes && echo yes` ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "X${F77}" = "X"; then F77_OK="no" SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to find a working Fortran compiler" echo "" echo " Try using F77 to explicitly specify a C compiler" echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" FCMIX_ENABLED="no" LAPACK_ENABLED="no" F77_EXAMPLES_ENABLED="no" fi # Check Fortran compiler # If unsuccessful, disable all Fortran support if test "X${F77_OK}" = "Xyes"; then ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # Add any additional FFLAGS echo "$as_me:$LINENO: checking for extra Fortran compiler flags" >&5 echo $ECHO_N "checking for extra Fortran compiler flags... $ECHO_C" >&6 # Check whether --with-fflags or --without-fflags was given. if test "${with_fflags+set}" = set; then withval="$with_fflags" echo "$as_me:$LINENO: result: ${withval}" >&5 echo "${ECHO_T}${withval}" >&6 FFLAGS="${FFLAGS} ${withval}" else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi; # Add any required linker flags to FLIBS # Note: if FLIBS is defined, it is left unchanged ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu echo "$as_me:$LINENO: checking how to get verbose linking output from $F77" >&5 echo $ECHO_N "checking how to get verbose linking output from $F77... $ECHO_C" >&6 if test "${ac_cv_prog_f77_v+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_f77_v= # Try some options frequently used verbose output for ac_verb in -v -verbose --verbose -V -\#\#\#; do cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF # Compile and link our simple test program by passing a flag (argument # 1 to this macro) to the Fortran compiler in order to get # "verbose" output that we can then parse for the Fortran linker # flags. ac_save_FFLAGS=$FFLAGS FFLAGS="$FFLAGS $ac_verb" (eval echo $as_me:7431: \"$ac_link\") >&5 ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'` echo "$ac_f77_v_output" >&5 FFLAGS=$ac_save_FFLAGS rm -f conftest* # On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where # /foo, /bar, and /baz are search directories for the Fortran linker. # Here, we change these into -L/foo -L/bar -L/baz (and put it first): ac_f77_v_output="`echo $ac_f77_v_output | grep 'LPATH is:' | sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $ac_f77_v_output" case $ac_f77_v_output in # If we are using xlf then replace all the commas with spaces. *xlfentry*) ac_f77_v_output=`echo $ac_f77_v_output | sed 's/,/ /g'` ;; # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted # $LIBS confuse us, and the libraries appear later in the output anyway). *mGLOB_options_string*) ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; # Portland Group compiler has quoted -cmdline argument *-cmdline*) ac_f77_v_output=`echo $ac_f77_v_output | sed "s/-cmdline '[^']*'/ /g"` ;; # If we are using Cray Fortran then delete quotes. # Use "\"" instead of '"' for font-lock-mode. # FIXME: a more general fix for quoted arguments with spaces? *cft90*) ac_f77_v_output=`echo $ac_f77_v_output | sed "s/\"//g"` ;; esac # look for -l* and *.a constructs in the output for ac_arg in $ac_f77_v_output; do case $ac_arg in [\\/]*.a | ?:[\\/]*.a | -[lLRu]*) ac_cv_prog_f77_v=$ac_verb break 2 ;; esac done done if test -z "$ac_cv_prog_f77_v"; then { echo "$as_me:$LINENO: WARNING: cannot determine how to obtain linking information from $F77" >&5 echo "$as_me: WARNING: cannot determine how to obtain linking information from $F77" >&2;} fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { echo "$as_me:$LINENO: WARNING: compilation failed" >&5 echo "$as_me: WARNING: compilation failed" >&2;} fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_f77_v" >&5 echo "${ECHO_T}$ac_cv_prog_f77_v" >&6 echo "$as_me:$LINENO: checking for Fortran libraries of $F77" >&5 echo $ECHO_N "checking for Fortran libraries of $F77... $ECHO_C" >&6 if test "${ac_cv_f77_libs+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "x$FLIBS" != "x"; then ac_cv_f77_libs="$FLIBS" # Let the user override the test. else cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF # Compile and link our simple test program by passing a flag (argument # 1 to this macro) to the Fortran compiler in order to get # "verbose" output that we can then parse for the Fortran linker # flags. ac_save_FFLAGS=$FFLAGS FFLAGS="$FFLAGS $ac_cv_prog_f77_v" (eval echo $as_me:7513: \"$ac_link\") >&5 ac_f77_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'` echo "$ac_f77_v_output" >&5 FFLAGS=$ac_save_FFLAGS rm -f conftest* # On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where # /foo, /bar, and /baz are search directories for the Fortran linker. # Here, we change these into -L/foo -L/bar -L/baz (and put it first): ac_f77_v_output="`echo $ac_f77_v_output | grep 'LPATH is:' | sed 's,.*LPATH is\(: *[^ ]*\).*,\1,;s,: */, -L/,g'` $ac_f77_v_output" case $ac_f77_v_output in # If we are using xlf then replace all the commas with spaces. *xlfentry*) ac_f77_v_output=`echo $ac_f77_v_output | sed 's/,/ /g'` ;; # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted # $LIBS confuse us, and the libraries appear later in the output anyway). *mGLOB_options_string*) ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;; # Portland Group compiler has quoted -cmdline argument *-cmdline*) ac_f77_v_output=`echo $ac_f77_v_output | sed "s/-cmdline '[^']*'/ /g"` ;; # If we are using Cray Fortran then delete quotes. # Use "\"" instead of '"' for font-lock-mode. # FIXME: a more general fix for quoted arguments with spaces? *cft90*) ac_f77_v_output=`echo $ac_f77_v_output | sed "s/\"//g"` ;; esac ac_cv_f77_libs= # Save positional arguments (if any) ac_save_positional="$@" set X $ac_f77_v_output while test $# != 1; do shift ac_arg=$1 case $ac_arg in [\\/]*.a | ?:[\\/]*.a) ac_exists=false for ac_i in $ac_cv_f77_libs; do if test x"$ac_arg" = x"$ac_i"; then ac_exists=true break fi done if test x"$ac_exists" = xtrue; then : else ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" fi ;; -bI:*) ac_exists=false for ac_i in $ac_cv_f77_libs; do if test x"$ac_arg" = x"$ac_i"; then ac_exists=true break fi done if test x"$ac_exists" = xtrue; then : else if test "$ac_compiler_gnu" = yes; then for ac_link_opt in $ac_arg; do ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" done else ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" fi fi ;; # Ignore these flags. -lang* | -lcrt[01].o | -lcrtbegin.o | -lc | -lgcc | -libmil | -LANG:=*) ;; -lkernel32) test x"$CYGWIN" != xyes && ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" ;; -[LRuY]) # These flags, when seen by themselves, take an argument. # We remove the space between option and argument and re-iterate # unless we find an empty arg or a new option (starting with -) case $2 in "" | -*);; *) ac_arg="$ac_arg$2" shift; shift set X $ac_arg "$@" ;; esac ;; -YP,*) for ac_j in `echo $ac_arg | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do ac_exists=false for ac_i in $ac_cv_f77_libs; do if test x"$ac_j" = x"$ac_i"; then ac_exists=true break fi done if test x"$ac_exists" = xtrue; then : else ac_arg="$ac_arg $ac_j" ac_cv_f77_libs="$ac_cv_f77_libs $ac_j" fi done ;; -[lLR]*) ac_exists=false for ac_i in $ac_cv_f77_libs; do if test x"$ac_arg" = x"$ac_i"; then ac_exists=true break fi done if test x"$ac_exists" = xtrue; then : else ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg" fi ;; # Ignore everything else. esac done # restore positional arguments set X $ac_save_positional; shift # We only consider "LD_RUN_PATH" on Solaris systems. If this is seen, # then we insist that the "run path" must be an absolute path (i.e. it # must begin with a "/"). case `(uname -sr) 2>/dev/null` in "SunOS 5"*) ac_ld_run_path=`echo $ac_f77_v_output | sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'` test "x$ac_ld_run_path" != x && if test "$ac_compiler_gnu" = yes; then for ac_link_opt in $ac_ld_run_path; do ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt" done else ac_cv_f77_libs="$ac_cv_f77_libs $ac_ld_run_path" fi ;; esac fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x" fi echo "$as_me:$LINENO: result: $ac_cv_f77_libs" >&5 echo "${ECHO_T}$ac_cv_f77_libs" >&6 FLIBS="$ac_cv_f77_libs" ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # Try to compile a simple Fortran program (no linking) cat >conftest.$ac_ext <<_ACEOF SUBROUTINE SUNDIALS() RETURN END _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then F77_OK="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 F77_OK="no" fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # If CC is a C++ compiler (decided in SUNDIALS_CPLUSPLUS_CHECK), we must use # it to link the Fortran examples. In this case, test if that is successful. # Otherwise, simply use F77 as the linker if test "X${F77_OK}" = "Xyes"; then echo "$as_me:$LINENO: checking which linker to use" >&5 echo $ECHO_N "checking which linker to use... $ECHO_C" >&6 if test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then F77_LNKR_CHECK_OK="no" # Compile simple Fortran example, but do NOT link # Note: result stored as conftest.${ac_objext} cat >conftest.$ac_ext <<_ACEOF PROGRAM SUNDIALS WRITE(*,*)'TEST' END _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="${LIBS} ${FLIBS}" # Switch working language to C for next test ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check if CC can link Fortran example # Note: AC_LINKONLY_IFELSE is a custom macro (modifications made to # general.m4 and c.m4) (see config/cust_general.m4 and config/mod_c.m4) if { (eval echo "$as_me:$LINENO: \"$ac_linkonly\"") >&5 (eval $ac_linkonly) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then F77_LNKR_CHECK_OK="yes" else echo "$as_me: failed program was:" >&5 if test -f conftest.c ; then sed 's/^/| /' conftest.c >&5 elif test -f conftest.cc ; then sed 's/^/| /' conftest.cc >&5 elif test -f conftest.f ; then sed 's/^/| /' conftest.f >&5 elif test -f conftest.${FC_SRCEXT-f} ; then sed 's/^/| /' conftest.${FC_SRCEXT-f} >&5 fi F77_LNKR_CHECK_OK="no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext # Revert back to previous language (Fortran 77) ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # If either the compilation or the linking failed, we should # disable building the Fortran examples # For now, use F77 as the linker... if test "X${F77_LNKR_CHECK_OK}" = "Xyes"; then F77_LNKR="${CC}" else F77_LNKR="${F77}" fi else F77_LNKR="${F77}" fi echo "$as_me:$LINENO: result: ${F77_LNKR}" >&5 echo "${ECHO_T}${F77_LNKR}" >&6 fi # Reset language (remove 'Fortran 77' from stack) ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "X${F77_OK}" = "Xno"; then SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to compile test program using given Fortran compiler." echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" FCMIX_ENABLED="no" LAPACK_ENABLED="no" F77_EXAMPLES_ENABLED="no" fi fi # Determine the Fortran name-mangling scheme # If successfull, provide variable description templates for config.hin # and config.h files required by autoheader utility # Otherwise, disable all Fortran support. if test "X${F77_OK}" = "Xyes"; then ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # (1) Compile a dummy Fortran subroutine named SUNDIALS FNAME_STATUS="none" cat >conftest.$ac_ext <<_ACEOF SUBROUTINE SUNDIALS() RETURN END _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then mv conftest.${ac_objext} f77_wrapper_check.${ac_objext} # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="f77_wrapper_check.${ac_objext} ${LIBS} ${FLIBS}" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu for i in "sundials" "SUNDIALS" do for j in "" "_" "__" do F77_MANGLED_NAME="${i}${j}" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char ${F77_MANGLED_NAME} (); int main () { ${F77_MANGLED_NAME} (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then FNAME_STATUS="set" ; break 2 else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext done done ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # If test succeeded, then set the F77_MANGLE_MACRO1 macro if test "X${FNAME_STATUS}" = "Xset"; then if test "X${i}" = "Xsundials"; then FNAME_MSG="lower case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name" dgemm="dgemm" dgetrf="dgetrf" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name ## _ _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name ## _" dgemm="dgemm_" dgetrf="dgetrf_" else FNAME_MSG="${FNAME_MSG} + two underscores" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name ## __ _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name ## __" dgemm="dgemm__" dgetrf="dgetrf__" fi else FNAME_MSG="upper case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME" dgemm="DGEMM" dgetrf="DGETRF" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name ## _ _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME ## _" dgemm="DGEMM_" dgetrf="DGETRF_" else FNAME_MSG="${FNAME_MSG} + two underscores" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC(name,NAME) name ## __ _ACEOF F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME ## __" dgemm="DGEMM__" dgetrf="DGETRF__" fi fi echo "$as_me:$LINENO: checking for Fortran name-mangling scheme of C identifiers" >&5 echo $ECHO_N "checking for Fortran name-mangling scheme of C identifiers... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${FNAME_MSG}" >&5 echo "${ECHO_T}${FNAME_MSG}" >&6 else F77_OK="no" fi # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Remove temporary file rm -f f77_wrapper_check.${ac_objext} # (2) Compile a dummy Fortran subroutine named SUN_DIALS FNAME_STATUS="none" cat >conftest.$ac_ext <<_ACEOF SUBROUTINE SUN_DIALS() RETURN END _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then mv conftest.${ac_objext} f77_wrapper_check.${ac_objext} # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="f77_wrapper_check.${ac_objext} ${LIBS} ${FLIBS}" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu for i in "sun_dials" "SUN_DIALS" do for j in "" "_" "__" do F77_MANGLED_NAME="${i}${j}" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char ${F77_MANGLED_NAME} (); int main () { ${F77_MANGLED_NAME} (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then FNAME_STATUS="set" ; break 2 else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext done done ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # If test succeeded, then set the F77_MANGLE_MACRO2 macro if test "X${FNAME_STATUS}" = "Xset"; then if test "X${i}" = "Xsun_dials"; then FNAME_MSG="lower case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name ## _ _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name ## _" else FNAME_MSG="${FNAME_MSG} + two underscores" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name ## __ _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name ## __" fi else FNAME_MSG="upper case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name ## _ _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## _" else FNAME_MSG="${FNAME_MSG} + two underscores" cat >>confdefs.h <<\_ACEOF #define SUNDIALS_F77_FUNC_(name,NAME) name ## __ _ACEOF F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## __" fi fi echo "$as_me:$LINENO: checking for Fortran name-mangling scheme of C identifiers with underscores" >&5 echo $ECHO_N "checking for Fortran name-mangling scheme of C identifiers with underscores... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${FNAME_MSG}" >&5 echo "${ECHO_T}${FNAME_MSG}" >&6 else F77_OK="no" fi # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # Remove temporary file rm -f f77_wrapper_check.${ac_objext} ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "X${F77_OK}" = "Xno"; then SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to determine Fortran name-mangling scheme." echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" F77_EXAMPLES_ENABLED="no" FCMIX_ENABLED="no" LAPACK_ENABLED="no" fi fi # If LAPACK is enabled, determine the proper library linkage # If successful, set the libaries # Otherwise, disable all Blas/Lapack support. if test "X${LAPACK_ENABLED}" = "Xyes" && test "X${F77_OK}" = "Xyes"; then # Check if the user specifies Blas libraries # Check whether --with-blas or --without-blas was given. if test "${with_blas+set}" = set; then withval="$with_blas" case $withval in -* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$withval" ;; *) BLAS_LIBS="-l$withval" ;; esac fi; # Check if the user specifies Lapack libraries # Check whether --with-lapack or --without-lapack was given. if test "${with_lapack+set}" = set; then withval="$with_lapack" case $withval in -* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$withval" ;; *) LAPACK_LIBS="-l$withval" ;; esac fi; acx_blas_ok=no acx_lapack_ok=no # BLAS_LIBS # --------- acx_blas_save_LIBS="$LIBS" LIBS="$LIBS $FLIBS" # First, check BLAS_LIBS environment variable if test "x$BLAS_LIBS" != x; then save_LIBS="$LIBS" LIBS="$BLAS_LIBS $LIBS" echo "$as_me:$LINENO: checking aha for $dgemm in $BLAS_LIBS" >&5 echo $ECHO_N "checking aha for $dgemm in $BLAS_LIBS... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then acx_blas_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 BLAS_LIBS="" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext echo "$as_me:$LINENO: result: $acx_blas_ok" >&5 echo "${ECHO_T}$acx_blas_ok" >&6 LIBS="$save_LIBS" fi # BLAS linked to by default? (happens on some supercomputers) if test $acx_blas_ok = no; then save_LIBS="$LIBS"; LIBS="$LIBS" as_ac_var=`echo "ac_cv_func_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm" >&5 echo $ECHO_N "checking for $dgemm... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $dgemm to an innocuous variant, in case declares $dgemm. For example, HP-UX 11i declares gettimeofday. */ #define $dgemm innocuous_$dgemm /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $dgemm (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $dgemm /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$dgemm) || defined (__stub___$dgemm) choke me #else char (*f) () = $dgemm; #endif #ifdef __cplusplus } #endif int main () { return f != $dgemm; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then acx_blas_ok=yes fi LIBS="$save_LIBS" fi # BLAS in Alpha CXML library? if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_cxml_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lcxml" >&5 echo $ECHO_N "checking for $dgemm in -lcxml... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lcxml $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes;BLAS_LIBS="-lcxml" fi fi # BLAS in Alpha DXML library? (now called CXML, see above) if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_dxml_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -ldxml" >&5 echo $ECHO_N "checking for $dgemm in -ldxml... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldxml $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes;BLAS_LIBS="-ldxml" fi fi # BLAS in Sun Performance library? if test $acx_blas_ok = no; then if test "x$GCC" != xyes; then # only works with Sun CC echo "$as_me:$LINENO: checking for acosp in -lsunmath" >&5 echo $ECHO_N "checking for acosp in -lsunmath... $ECHO_C" >&6 if test "${ac_cv_lib_sunmath_acosp+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsunmath $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char acosp (); int main () { acosp (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_sunmath_acosp=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_sunmath_acosp=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_sunmath_acosp" >&5 echo "${ECHO_T}$ac_cv_lib_sunmath_acosp" >&6 if test $ac_cv_lib_sunmath_acosp = yes; then as_ac_Lib=`echo "ac_cv_lib_sunperf_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lsunperf" >&5 echo $ECHO_N "checking for $dgemm in -lsunperf... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsunperf -lsunmath $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then BLAS_LIBS="-xlic_lib=sunperf -lsunmath" acx_blas_ok=yes fi fi fi fi # BLAS in SCSL library? (SGI/Cray Scientific Library) if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_scs_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lscs" >&5 echo $ECHO_N "checking for $dgemm in -lscs... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lscs $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes; BLAS_LIBS="-lscs" fi fi # BLAS in SGIMATH library? if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_complib.sgimath_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lcomplib.sgimath" >&5 echo $ECHO_N "checking for $dgemm in -lcomplib.sgimath... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lcomplib.sgimath $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath" fi fi # BLAS in IBM ESSL library? (requires generic BLAS lib, too) if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_blas_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lblas" >&5 echo $ECHO_N "checking for $dgemm in -lblas... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lblas $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then as_ac_Lib=`echo "ac_cv_lib_essl_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lessl" >&5 echo $ECHO_N "checking for $dgemm in -lessl... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lessl -lblas $FLIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes; BLAS_LIBS="-lessl -lblas" fi fi fi # Generic BLAS library? if test $acx_blas_ok = no; then as_ac_Lib=`echo "ac_cv_lib_blas_$dgemm" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgemm in -lblas" >&5 echo $ECHO_N "checking for $dgemm in -lblas... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lblas $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgemm (); int main () { $dgemm (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_blas_ok=yes; BLAS_LIBS="-lblas" fi fi LIBS="$acx_blas_save_LIBS" # LAPACK # ------ # If we didn't find a Blas implementation, disable tests for Lapack if test $acx_blas_ok = no; then acx_lapack_ok=disabled fi # Check LAPACK_LIBS environment variable if test $acx_lapack_ok = no; then if test "x$LAPACK_LIBS" != x; then save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS" echo "$as_me:$LINENO: checking for $dgetrf in $LAPACK_LIBS" >&5 echo $ECHO_N "checking for $dgetrf in $LAPACK_LIBS... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgetrf (); int main () { $dgetrf (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then acx_lapack_ok=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 LAPACK_LIBS="" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext echo "$as_me:$LINENO: result: $acx_lapack_ok" >&5 echo "${ECHO_T}$acx_lapack_ok" >&6 LIBS="$save_LIBS" if test acx_lapack_ok = no; then LAPACK_LIBS="" fi fi fi # LAPACK linked to by default? (is sometimes included in BLAS lib) if test $acx_lapack_ok = no; then save_LIBS="$LIBS" LIBS="$LIBS $BLAS_LIBS $FLIBS" as_ac_var=`echo "ac_cv_func_$dgetrf" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgetrf" >&5 echo $ECHO_N "checking for $dgetrf... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define $dgetrf to an innocuous variant, in case declares $dgetrf. For example, HP-UX 11i declares gettimeofday. */ #define $dgetrf innocuous_$dgetrf /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $dgetrf (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $dgetrf /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgetrf (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$dgetrf) || defined (__stub___$dgetrf) choke me #else char (*f) () = $dgetrf; #endif #ifdef __cplusplus } #endif int main () { return f != $dgetrf; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_var=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_var=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 if test `eval echo '${'$as_ac_var'}'` = yes; then acx_lapack_ok=yes fi LIBS="$save_LIBS" fi # Generic LAPACK library? for lapack in lapack lapack_rs6k; do if test $acx_lapack_ok = no; then save_LIBS="$LIBS" LIBS="$BLAS_LIBS $LIBS" as_ac_Lib=`echo "ac_cv_lib_$lapack''_$dgetrf" | $as_tr_sh` echo "$as_me:$LINENO: checking for $dgetrf in -l$lapack" >&5 echo $ECHO_N "checking for $dgetrf in -l$lapack... $ECHO_C" >&6 if eval "test \"\${$as_ac_Lib+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-l$lapack $FLIBS $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char $dgetrf (); int main () { $dgetrf (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then eval "$as_ac_Lib=yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 eval "$as_ac_Lib=no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Lib'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Lib'}'`" >&6 if test `eval echo '${'$as_ac_Lib'}'` = yes; then acx_lapack_ok=yes; LAPACK_LIBS="-l$lapack" fi LIBS="$save_LIBS" fi done # If we have both libraries, set LAPACK_OK to yes # ----------------------------------------------------- if test $acx_blas_ok = yes && test $acx_lapack_ok = yes; then LAPACK_OK="yes" else LAPACK_OK="no" fi if test "X${LAPACK_OK}" = "Xyes"; then echo "$as_me:$LINENO: checking for Blas/Lapack library linkage" >&5 echo $ECHO_N "checking for Blas/Lapack library linkage... $ECHO_C" >&6 BLAS_LAPACK_LIBS="${LAPACK_LIBS} ${BLAS_LIBS} ${LIBS} ${FLIBS}" echo "$as_me:$LINENO: result: ${LAPACK_LIBS} ${BLAS_LIBS}" >&5 echo "${ECHO_T}${LAPACK_LIBS} ${BLAS_LIBS}" >&6 else SUNDIALS_WARN_FLAG="yes" echo "$as_me:$LINENO: checking for Blas/Lapack library linkage" >&5 echo $ECHO_N "checking for Blas/Lapack library linkage... $ECHO_C" >&6 echo "$as_me:$LINENO: result: \"no\"" >&5 echo "${ECHO_T}\"no\"" >&6 echo "" echo " Unable to determine Blas/Lapack library linkage." echo "" echo " Try using --with-blas and --with-lapack." echo "" echo " Disabling compilation of Blas/Lapack interfaces..." LAPACK_ENABLED="no" fi fi # Set the macro BLAS_LAPACK_MACRO for expansion in sundials_config.h if test "X${LAPACK_ENABLED}" = "Xyes"; then cat >>confdefs.h <<\_ACEOF #define SUNDIALS_BLAS_LAPACK 1 _ACEOF BLAS_LAPACK_MACRO="#define SUNDIALS_BLAS_LAPACK 1" else cat >>confdefs.h <<\_ACEOF #define SUNDIALS_BLAS_LAPACK 0 _ACEOF BLAS_LAPACK_MACRO="#define SUNDIALS_BLAS_LAPACK 0" fi fi # Set MPI support (Optional) if test "X${MPI_ENABLED}" = "Xyes"; then echo "" echo "MPI-C Settings" echo "--------------" echo "" # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # MPI root directory # Check whether --with-mpi-root or --without-mpi-root was given. if test "${with_mpi_root+set}" = set; then withval="$with_mpi_root" MPI_ROOT_DIR="${withval}" else MPI_ROOT_DIR="" fi; # MPI include directory # Check whether --with-mpi-incdir or --without-mpi-incdir was given. if test "${with_mpi_incdir+set}" = set; then withval="$with_mpi_incdir" MPI_INC_DIR="${withval}" else MPI_INC_DIR="" fi; # MPI library directory # Check whether --with-mpi-libdir or --without-mpi-libdir was given. if test "${with_mpi_libdir+set}" = set; then withval="$with_mpi_libdir" MPI_LIB_DIR="${withval}" else MPI_LIB_DIR="" fi; # MPI libraries # Check whether --with-mpi-libs or --without-mpi-libs was given. if test "${with_mpi_libs+set}" = set; then withval="$with_mpi_libs" MPI_LIBS="${withval}" else MPI_LIBS="" fi; # MPI flags # Check whether --with-mpi-flags or --without-mpi-flags was given. if test "${with_mpi_flags+set}" = set; then withval="$with_mpi_flags" MPI_FLAGS="${withval}" MPI_FLAGS_OK="yes" else MPI_FLAGS="" MPI_FLAGS_OK="no" fi; # MPI-C compiler MPICC_COMP_GIVEN="yes" echo "$as_me:$LINENO: checking if using MPI-C script" >&5 echo $ECHO_N "checking if using MPI-C script... $ECHO_C" >&6 # Check whether --with-mpicc or --without-mpicc was given. if test "${with_mpicc+set}" = set; then withval="$with_mpicc" if test "X${withval}" = "Xno"; then USE_MPICC_SCRIPT="no" else USE_MPICC_SCRIPT="yes" MPICC_COMP="${withval}" fi else USE_MPICC_SCRIPT="yes" MPICC_COMP="mpicc" MPICC_COMP_GIVEN="no" fi; echo "$as_me:$LINENO: result: ${USE_MPICC_SCRIPT}" >&5 echo "${ECHO_T}${USE_MPICC_SCRIPT}" >&6 # If CC is a C++ compiler, then we certainly do NOT want to use an MPI-C script # Note: USING_CPLUSPLUS_COMP was defined by a call to SUNDIALS_CPLUSPLUS_CHECK # in SUNDIALS_SET_CC # Note: If the user specified an MPI-C script, then we will NOT do anything for now if test "X${MPICC_COMP_GIVEN}" = "Xno" && test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then MPICC_COMP="mpiCC" fi # Check MPI-C compiler (either MPI compiler script or regular C compiler) if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then # Test MPI-C compiler (meaning test MPICC_COMP) # Check if MPI-C compiler can be found echo "$as_me:$LINENO: checking if absolute path to ${MPICC_COMP} was given" >&5 echo $ECHO_N "checking if absolute path to ${MPICC_COMP} was given... $ECHO_C" >&6 # CASE 1: MPICC_COMP was found (cannot check if executable because the # "-x" flag is NOT portable) if test -f ${MPICC_COMP} ; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPICC_COMP_EXISTS="yes" # Determine MPI_INC_DIR and MPI_LIB_DIR for use by Makefile MPI_BASE_DIR=`(dirname "${MPICC_COMP}") 2>/dev/null || $as_expr X"${MPICC_COMP}" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"${MPICC_COMP}" : 'X\(//\)[^/]' \| \ X"${MPICC_COMP}" : 'X\(//\)$' \| \ X"${MPICC_COMP}" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"${MPICC_COMP}" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` TMP_MPI_INC_DIR="${MPI_BASE_DIR}/../include" TMP_MPI_LIB_DIR="${MPI_BASE_DIR}/../lib" # CASE 2: MPICC_COMP could NOT be found and MPI_ROOT_DIR was NOT specified, # so search in PATH else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 if test "X${MPI_ROOT_DIR}" = "X"; then # Try to find location of executable (perhaps directory was entered # incorrectly) TEMP_MPICC_COMP=`basename "${MPICC_COMP}"` # Extract the first word of "${TEMP_MPICC_COMP}", so it can be a program name with args. set dummy ${TEMP_MPICC_COMP}; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_MPICC_COMP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $MPICC_COMP in [\\/]* | ?:[\\/]*) ac_cv_path_MPICC_COMP="$MPICC_COMP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_MPICC_COMP="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_path_MPICC_COMP" && ac_cv_path_MPICC_COMP="none" ;; esac fi MPICC_COMP=$ac_cv_path_MPICC_COMP if test -n "$MPICC_COMP"; then echo "$as_me:$LINENO: result: $MPICC_COMP" >&5 echo "${ECHO_T}$MPICC_COMP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Cannot find executable in PATH if test "X${MPICC_COMP}" = "Xnone"; then MPICC_COMP_EXISTS="no" MPICC_COMP="" # Found executable and set MPICC_COMP to absolute pathname else MPICC_COMP_EXISTS="yes" MPI_BASE_DIR=`(dirname "${MPICC_COMP}") 2>/dev/null || $as_expr X"${MPICC_COMP}" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"${MPICC_COMP}" : 'X\(//\)[^/]' \| \ X"${MPICC_COMP}" : 'X\(//\)$' \| \ X"${MPICC_COMP}" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"${MPICC_COMP}" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` TMP_MPI_INC_DIR="${MPI_BASE_DIR}/../include" TMP_MPI_LIB_DIR="${MPI_BASE_DIR}/../lib" fi # CASE 3: MPICC_COMP could NOT be found, but MPI_ROOT_DIR was specified else echo "$as_me:$LINENO: checking if ${MPICC_COMP} exists in ${MPI_ROOT_DIR}/bin" >&5 echo $ECHO_N "checking if ${MPICC_COMP} exists in ${MPI_ROOT_DIR}/bin... $ECHO_C" >&6 # MPICC_COMP should really only contain an executable name # Found location of MPICC_COMP if test -f ${MPI_ROOT_DIR}/bin/${MPICC_COMP} ; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPICC_COMP_EXISTS="yes" MPICC_COMP="${MPI_ROOT_DIR}/bin/${MPICC_COMP}" TMP_MPI_INC_DIR="${MPI_ROOT_DIR}/include" TMP_MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" # Could NOT find MPICC_COMP anywhere else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 MPICC_COMP_EXISTS="no" MPICC_COMP="" fi fi fi # If MPICC_COMP exists, set MPICC and (conditionally) set MPI_INC_DIR # and MPI_LIB_DIR so that we do not end up with empty -I options. # Otherwise, issue warning message if test "X${MPICC_COMP_EXISTS}" = "Xyes"; then MPICC="${MPICC_COMP}" MPI_C_COMP_OK="yes" # If MPI_INC_DIR is empty, set it to TMP_MPI_INC_DIR if test "X${MPI_INC_DIR}" = "X"; then MPI_INC_DIR="$TMP_MPI_INC_DIR" fi # If MPI_LIB_DIR is empty, set it to TMP_MPI_LIB_DIR if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="$TMP_MPI_LIB_DIR" fi else { echo "$as_me:$LINENO: WARNING: cannot find MPI-C compiler" >&5 echo "$as_me: WARNING: cannot find MPI-C compiler" >&2;} echo "" echo " Unable to find a functional MPI-C compiler." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPICC="" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi else MPICC_COMP="${CC}" MPICC="${CC}" # Test if we can compile MPI programs using the CC compiler # and current MPI settings { echo "$as_me:$LINENO: Testing CC with MPI settings" >&5 echo "$as_me: Testing CC with MPI settings" >&6;} # Save copies of CPPFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_CPPFLAGS="${CPPFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" echo "$as_me:$LINENO: checking for location of MPI implementation" >&5 echo $ECHO_N "checking for location of MPI implementation... $ECHO_C" >&6 # If MPI include directory was NOT explicitly specified, check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # If MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then echo "$as_me:$LINENO: result: not found" >&5 echo "${ECHO_T}not found" >&6 MPI_EXISTS="no" { echo "$as_me:$LINENO: WARNING: cannot find MPI implementation files" >&5 echo "$as_me: WARNING: cannot find MPI implementation files" >&2;} echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update CPPFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" echo "$as_me:$LINENO: result: ${MPI_INC_DIR}" >&5 echo "${ECHO_T}${MPI_INC_DIR}" >&6 if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # MPI include directory was specified so update CPPFLAGS else echo "$as_me:$LINENO: result: ${MPI_INC_DIR}" >&5 echo "${ECHO_T}${MPI_INC_DIR}" >&6 if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then echo "$as_me:$LINENO: checking for location of MPI libraries" >&5 echo $ECHO_N "checking for location of MPI libraries... $ECHO_C" >&6 # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" echo "$as_me:$LINENO: result: ${MPI_LIB_DIR}" >&5 echo "${ECHO_T}${MPI_LIB_DIR}" >&6 if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else echo "$as_me:$LINENO: result: ${MPI_LIB_DIR}" >&5 echo "${ECHO_T}${MPI_LIB_DIR}" >&6 if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries must be included # If no libraries are given, then issue a warning message echo "$as_me:$LINENO: checking for MPI libraries" >&5 echo $ECHO_N "checking for MPI libraries... $ECHO_C" >&6 if test "X${MPI_LIBS}" = "X"; then echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 { echo "$as_me:$LINENO: WARNING: no MPI libraries were given" >&5 echo "$as_me: WARNING: no MPI libraries were given" >&2;} echo "" echo " Unable to compile MPI program using C compiler because" echo " MPI libraries were not specified." echo "" echo " Try using --with-mpi-libdir and --with-mpi-libs to" echo " specify the location and names of the MPI libraries." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" # MPI libraries were specified so update LIBS else echo "$as_me:$LINENO: result: ${MPI_LIBS}" >&5 echo "${ECHO_T}${MPI_LIBS}" >&6 if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi # Set the MPI_C_COMP_OK variable to NULL so we can conditionally execute # the next test MPI_C_COMP_OK="" fi if test "X${MPI_C_COMP_OK}" = "X"; then echo "$as_me:$LINENO: checking if C compiler can compile MPI programs" >&5 echo $ECHO_N "checking if C compiler can compile MPI programs... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include "mpi.h" int main () { int c; char **v; MPI_Init(&c,&v); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPI_C_COMP_OK="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 { echo "$as_me:$LINENO: WARNING: C compiler cannot compile MPI programs" >&5 echo "$as_me: WARNING: C compiler cannot compile MPI programs" >&2;} echo "" echo " Unable to compile MPI program using C compiler." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi else MPI_C_COMP_OK="no" fi # Restore CPPFLAGS, LDFLAGS and LIBS CPPFLAGS="${SAVED_CPPFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" fi fi if test "X${MPI_C_COMP_OK}" = "Xyes"; then if test "X${FCMIX_ENABLED}" = "Xyes"; then echo "" echo "MPI-2 Functionality" echo "-------------------" echo "" # Determine if MPI implementation used to build SUNDIALS provides # MPI-2 functionality. # # Test for MPI_Comm_f2c() function: # (1) NO : FNVECTOR_PARALLEL module will NOT allow user to specify # an MPI communicator and MPI_COMM_WORLD will be used # (2) YES : FNVECTOR_PARALLEL module will allow user to specify # an MPI communicator # # Provide variable description templates for config.hin and config.h files # Required by autoheader utility # Save copies of CPPFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_CPPFLAGS="${CPPFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" # MPI include directory was NOT explicitly specified so check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then MPI_EXISTS="no" { echo "$as_me:$LINENO: WARNING: cannot find MPI implementation files" >&5 echo "$as_me: WARNING: cannot find MPI implementation files" >&2;} echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling FNVECTOR_PARALLEL support for user-specified" echo " MPI communicator..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update CPPFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # MPI include directory was specified so update CPPFLAGS else if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries linker should be use if test "X${MPI_LIBS}" = "X"; then : # MPI libraries were specified so update LIBS else if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi fi # Since AC_LINK_IFELSE uses CC, set CC = MPICC if using # an MPI compiler script if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then SAVED_CC="${CC}" CC="${MPICC_COMP}" fi # Check if MPI implementation supports MPI_Comm_f2c() from # MPI-2 specification if test "X${FCMIX_ENABLED}" = "Xyes"; then echo "$as_me:$LINENO: checking for MPI_Comm_f2c() from MPI-2 specification" >&5 echo $ECHO_N "checking for MPI_Comm_f2c() from MPI-2 specification... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include "mpi.h" int main () { int c; char **v; MPI_Comm C_comm; MPI_Init(&c, &v); C_comm = MPI_Comm_f2c((MPI_Fint) 1); MPI_Finalize(); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_MPI_COMM_F2C 1 _ACEOF F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 1" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 cat >>confdefs.h <<\_ACEOF #define SUNDIALS_MPI_COMM_F2C 0 _ACEOF F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 0" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi # Reset CC if necessary if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then CC="${SAVED_CC}" fi else cat >>confdefs.h <<\_ACEOF #define SUNDIALS_MPI_COMM_F2C 0 _ACEOF F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 0" fi # Restore CPPFLAGS, LDFLAGS and LIBS CPPFLAGS="${SAVED_CPPFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" fi if test "X${F77_EXAMPLES_ENABLED}" = "Xyes"; then echo "" echo "MPI-Fortran Settings" echo "--------------------" echo "" echo "$as_me:$LINENO: checking if using MPI-Fortran script" >&5 echo $ECHO_N "checking if using MPI-Fortran script... $ECHO_C" >&6 # Check whether --with-mpif77 or --without-mpif77 was given. if test "${with_mpif77+set}" = set; then withval="$with_mpif77" if test "X${withval}" = "Xno"; then USE_MPIF77_SCRIPT="no" else USE_MPIF77_SCRIPT="yes" MPIF77_COMP="${withval}" fi else USE_MPIF77_SCRIPT="yes" MPIF77_COMP="mpif77" fi; echo "$as_me:$LINENO: result: ${USE_MPIF77_SCRIPT}" >&5 echo "${ECHO_T}${USE_MPIF77_SCRIPT}" >&6 # Check MPI-Fortran compiler (either MPI compiler script or regular Fortran compiler) if test "X${USE_MPIF77_SCRIPT}" = "Xyes"; then # Test the MPI-Fortran compiler (meaning test MPIF77_COMP) # Check if MPI-Fortran compiler can be found echo "$as_me:$LINENO: checking if absolute path to ${MPIF77_COMP} was given" >&5 echo $ECHO_N "checking if absolute path to ${MPIF77_COMP} was given... $ECHO_C" >&6 # CASE 1: MPIF77_COMP was found (cannot check if executable because the # "-x" flag is NOT portable) if test -f ${MPIF77_COMP} ; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPIF77_COMP_EXISTS="yes" # Determine MPI_INC_DIR and MPI_LIB_DIR for use by Makefile MPI_BASE_DIR=`(dirname "${MPIF77_COMP}") 2>/dev/null || $as_expr X"${MPIF77_COMP}" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"${MPIF77_COMP}" : 'X\(//\)[^/]' \| \ X"${MPIF77_COMP}" : 'X\(//\)$' \| \ X"${MPIF77_COMP}" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"${MPIF77_COMP}" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # CASE 2: MPIF77_COMP could NOT be found and MPI_ROOT_DIR was NOT specified, # so search in PATH else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 if test "X${MPI_ROOT_DIR}" = "X"; then # Try to find location of executable (perhaps directory was entered incorrectly) TEMP_MPIF77_COMP=`basename "${MPIF77_COMP}"` # Extract the first word of "${TEMP_MPIF77_COMP}", so it can be a program name with args. set dummy ${TEMP_MPIF77_COMP}; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_MPIF77_COMP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $MPIF77_COMP in [\\/]* | ?:[\\/]*) ac_cv_path_MPIF77_COMP="$MPIF77_COMP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_MPIF77_COMP="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_path_MPIF77_COMP" && ac_cv_path_MPIF77_COMP="none" ;; esac fi MPIF77_COMP=$ac_cv_path_MPIF77_COMP if test -n "$MPIF77_COMP"; then echo "$as_me:$LINENO: result: $MPIF77_COMP" >&5 echo "${ECHO_T}$MPIF77_COMP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Cannot find executable in PATH if test "X${MPIF77_COMP}" = "Xnone"; then MPIF77_COMP_EXISTS="no" MPIF77_COMP="" # Found executable and set MPIF77_COMP to absolute pathname else MPIF77_COMP_EXISTS="yes" MPI_BASE_DIR=`(dirname "${MPIF77_COMP}") 2>/dev/null || $as_expr X"${MPIF77_COMP}" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"${MPIF77_COMP}" : 'X\(//\)[^/]' \| \ X"${MPIF77_COMP}" : 'X\(//\)$' \| \ X"${MPIF77_COMP}" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"${MPIF77_COMP}" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` fi # CASE 3: MPIF77_COMP could NOT be found, but MPI_ROOT_DIR was specified else echo "$as_me:$LINENO: checking if ${MPIF77_COMP} exists in ${MPI_ROOT_DIR}/bin" >&5 echo $ECHO_N "checking if ${MPIF77_COMP} exists in ${MPI_ROOT_DIR}/bin... $ECHO_C" >&6 # MPIF77_COMP should really only contain an executable name # Found location of MPIF77_COMP if test -f ${MPI_ROOT_DIR}/bin/${MPIF77_COMP} ; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPIF77_COMP_EXISTS="yes" MPIF77_COMP="${MPI_ROOT_DIR}/bin/${MPIF77_COMP}" # Could NOT find MPIF77_COMP anywhere else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 MPIF77_COMP_EXISTS="no" MPIF77_COMP="" fi fi fi # Issue warning message if MPIF77_COMP does NOT exist, else set MPIF77 if test "X${MPIF77_COMP_EXISTS}" = "Xyes"; then MPIF77="${MPIF77_COMP}" MPI_F77_COMP_OK="yes" # Note that we do not have to worry about empty MPI_INC_DIR and MPI_LIB_DIR # here as they were set in SUNDIALS_CHECK_MPICC # Check if we must use the MPI-Fortran compiler script (MPIF77) to link # the Fortran examples (default is to use MPICC) # If we are NOT using an MPI script, then MPICC_COMP == CC and we do NOT need # to check again if CC is a C++ compiler as we already know the answer if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then # Check if using a C++ compiler (meaning MPI-C++ script) # Save result from CC check SAVED_USING_CPLUSPLUS_COMP="${USING_CPLUSPLUS_COMP}" # Rename argument COMP_NAME="${MPICC_COMP}" # Update the language stack ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check if using a C++ compiler echo "$as_me:$LINENO: checking if ${COMP_NAME} is a C++ compiler" >&5 echo $ECHO_N "checking if ${COMP_NAME} is a C++ compiler... $ECHO_C" >&6 if test "$cross_compiling" = yes; then { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling See \`config.log' for more details." >&5 echo "$as_me: error: cannot run test program while cross compiling See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifdef __cplusplus return(0); #else return(1); #endif ; return 0; } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 # COMP_NAME is a C++ compiler USING_CPLUSPLUS_COMP="yes" else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 # COMP_NAMPE is NOT a C++ compiler USING_CPLUSPLUS_COMP="no" fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi # Revert back to previous language ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # MPICC uses a C++ compiler so run the next test if test "X${USING_CPLUSPLUS_COMP}" = "Xyes" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xyes"; then RUN_MPIF77_LNKR_CHECK="yes" # ERROR elif test "X${USING_CPLUSPLUS_COMP}" = "Xyes" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xno"; then { { echo "$as_me:$LINENO: error: ${MPICC_COMP} is a C++ compiler but ${CC} is a C compiler" >&5 echo "$as_me: error: ${MPICC_COMP} is a C++ compiler but ${CC} is a C compiler" >&2;} { (exit 1); exit 1; }; } # MPICC uses a C compiler so skip the next test elif test "X${USING_CPLUSPLUS_COMP}" = "Xno" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xno" ; then RUN_MPIF77_LNKR_CHECK="no" # ERROR elif test "X${USING_CPLUSPLUS_COMP}" = "Xno" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xyes" ; then { { echo "$as_me:$LINENO: error: ${MPICC_COMP} is a C compiler but ${CC} is a C++ compiler" >&5 echo "$as_me: error: ${MPICC_COMP} is a C compiler but ${CC} is a C++ compiler" >&2;} { (exit 1); exit 1; }; } fi # Restore result from CC check USING_CPLUSPLUS_COMP="${SAVED_USING_CPLUSPLUS_COMP}" else echo "$as_me:$LINENO: checking if ${MPICC_COMP} is a C++ compiler" >&5 echo $ECHO_N "checking if ${MPICC_COMP} is a C++ compiler... $ECHO_C" >&6 if test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi echo "$as_me:$LINENO: checking which linker to use" >&5 echo $ECHO_N "checking which linker to use... $ECHO_C" >&6 # Perform the next test only if using a C++ compiler to build NVECTOR_PARALLEL if test "X${RUN_MPIF77_LNKR_CHECK}" = "Xyes"; then MPIF77_LNKR_CHECK_OK="no" # Switch language to "Fortran 77" ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # Temporarily reset F77 environment variable to perform test SAVED_F77="${F77}" F77="${MPIF77_COMP}" # Compile simple Fortran example, but do NOT link # Note: result stored as conftest.${ac_objext} cat >conftest.$ac_ext <<_ACEOF PROGRAM SUNDIALS INTEGER IER CALL MPI_INIT(IER) END _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # Reset F77 to original value F77="${SAVED_F77}" # Revert to previous language ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="${LIBS} ${FLIBS}" # Switch working language to C for next test ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Temporarily reset CC environment variable to perform next test SAVED_CC="${CC}" CC="${MPICC_COMP}" # Check if MPICC_COMP can link Fortran example # Note: AC_LINKONLY_IFELSE is a custom macro (modifications made to # general.m4 and c.m4) if { (eval echo "$as_me:$LINENO: \"$ac_linkonly\"") >&5 (eval $ac_linkonly) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then MPIF77_LNKR_CHECK_OK="yes" else echo "$as_me: failed program was:" >&5 if test -f conftest.c ; then sed 's/^/| /' conftest.c >&5 elif test -f conftest.cc ; then sed 's/^/| /' conftest.cc >&5 elif test -f conftest.f ; then sed 's/^/| /' conftest.f >&5 elif test -f conftest.${FC_SRCEXT-f} ; then sed 's/^/| /' conftest.${FC_SRCEXT-f} >&5 fi MPIF77_LNKR_CHECK_OK="no" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext # Reset CC to original value CC="${SAVED_CC}" # Revert back to previous language (Fortran 77) ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext # If either the compilation or the linking failed, we should # disable building the parallel Fortran examples # For now, use MPIF77 as the linker... if test "X${MPIF77_LNKR_CHECK_OK}" = "Xyes"; then MPIF77_LNKR="${MPICC}" else MPIF77_LNKR="${MPIF77}" fi else # Using a C compiler so use MPIF77 to link parallel Fortran examples MPIF77_LNKR="${MPIF77}" fi echo "$as_me:$LINENO: result: ${MPIF77_LNKR}" >&5 echo "${ECHO_T}${MPIF77_LNKR}" >&6 else { echo "$as_me:$LINENO: WARNING: cannot find MPI-Fortran compiler" >&5 echo "$as_me: WARNING: cannot find MPI-Fortran compiler" >&2;} echo "" echo " Unable to find a functional MPI-Fortran compiler." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling parallel Fortran examples...." echo "" MPIF77="" MPI_F77_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi else MPIF77_COMP="${F77}" MPIF77="${F77}" # Test if we can compile MPI programs using the F77 compiler # and current MPI settings { echo "$as_me:$LINENO: Testing F77 with MPI settings" >&5 echo "$as_me: Testing F77 with MPI settings" >&6;} ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu # Save copies of FFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_FFLAGS="${FFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # This may seem redundant, but we are not guaranteed that # SUNDIALS_CC_WITH_MPI_CHECK has been executed # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" echo "$as_me:$LINENO: checking for location of MPI implementation" >&5 echo $ECHO_N "checking for location of MPI implementation... $ECHO_C" >&6 # If MPI include directory was NOT explicitly specified so check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # If MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then echo "$as_me:$LINENO: result: not found" >&5 echo "${ECHO_T}not found" >&6 MPI_EXISTS="no" { echo "$as_me:$LINENO: WARNING: cannot find MPI implementation files" >&5 echo "$as_me: WARNING: cannot find MPI implementation files" >&2;} echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling all parallel Fortran examples..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update FFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" echo "$as_me:$LINENO: result: ${MPI_INC_DIR}" >&5 echo "${ECHO_T}${MPI_INC_DIR}" >&6 if test "X${FFLAGS}" = "X"; then FFLAGS="-I${MPI_INC_DIR}" else FFLAGS="${FFLAGS} -I${MPI_INC_DIR}" fi fi # MPI include directory was specified so update FFLAGS else echo "$as_me:$LINENO: result: ${MPI_INC_DIR}" >&5 echo "${ECHO_T}${MPI_INC_DIR}" >&6 if test "X${FFLAGS}" = "X"; then FFLAGS="-I${MPI_INC_DIR}" else FFLAGS="${FFLAGS} -I${MPI_INC_DIR}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then echo "$as_me:$LINENO: checking for location of MPI libraries" >&5 echo $ECHO_N "checking for location of MPI libraries... $ECHO_C" >&6 # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" echo "$as_me:$LINENO: result: ${MPI_LIB_DIR}" >&5 echo "${ECHO_T}${MPI_LIB_DIR}" >&6 if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else echo "$as_me:$LINENO: result: ${MPI_LIB_DIR}" >&5 echo "${ECHO_T}${MPI_LIB_DIR}" >&6 if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries must be included # If no libraries are given, then issue a warning message echo "$as_me:$LINENO: checking for MPI libraries" >&5 echo $ECHO_N "checking for MPI libraries... $ECHO_C" >&6 if test "X${MPI_LIBS}" = "X"; then echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 echo "" echo " Unable to compile MPI program using Fortran compiler because" echo " MPI libraries were not specified." echo "" echo " Try using --with-mpi-libdir and --with-mpi-libs to" echo " specify the location and names of the MPI libraries." echo "" echo " Disabling all parallel Fortran examples..." echo "" MPI_F77_COMP_OK="no" # MPI libraries were specified so update LIBS else echo "$as_me:$LINENO: result: ${MPI_LIBS}" >&5 echo "${ECHO_T}${MPI_LIBS}" >&6 if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi # Set the MPI_F77_COMP_OK variable to NULL so we can conditionally execute # the next test MPI_F77_COMP_OK="" fi if test "X${MPI_F77_COMP_OK}" = "X"; then echo "$as_me:$LINENO: checking if Fortran compiler can compile MPI programs" >&5 echo $ECHO_N "checking if Fortran compiler can compile MPI programs... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF program main INCLUDE "mpif.h" CALL MPI_INIT(IER) end _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 MPI_F77_COMP_OK="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 { echo "$as_me:$LINENO: WARNING: Fortran compiler cannot compile MPI programs" >&5 echo "$as_me: WARNING: Fortran compiler cannot compile MPI programs" >&2;} echo "" echo " Unable to compile MPI program using Fortran compiler." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling all parallel Fortran examples..." echo "" MPI_F77_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext # Set MPIF77_LNKR based on value of F77_LNKR # Note: setting MPIF77_LNKR is trivial if NOT using the MPI compiler script # since the SUNDIALS_F77_LNKR_CHECK macro already checked if CC or F77 # should be used echo "$as_me:$LINENO: checking which linker to use" >&5 echo $ECHO_N "checking which linker to use... $ECHO_C" >&6 if test "X${F77_LNKR}" = "X${CC}"; then MPIF77_LNKR="${MPICC}" elif test "X${F77_LNKR}" = "X${F77}"; then MPIF77_LNKR="${MPIF77}" fi echo "$as_me:$LINENO: result: ${MPIF77_LNKR}" >&5 echo "${ECHO_T}${MPIF77_LNKR}" >&6 fi else MPI_F77_COMP_OK="no" fi # Restore FFLAGS, LDFLAGS and LIBS FFLAGS="${SAVED_FFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu fi fi fi # Set examples modules if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo "" echo "Examples" echo "--------" echo "" # Set proper object file extension # Must export OBJ_EXT via AC_SUBST OBJEXT=".lo" # Check if serial C examples can actually be built SERIAL_C_EXAMPLES="yes" # Check if parallel C examples can actually be built if test "X${MPI_ENABLED}" = "Xyes"; then if test "X${MPI_C_COMP_OK}" = "Xyes"; then PARALLEL_C_EXAMPLES="yes" else PARALLEL_C_EXAMPLES="no" fi else PARALLEL_C_EXAMPLES="disabled" fi # Check if serial F77 examples can actually be built if test "X${FCMIX_ENABLED}" = "Xyes"; then if test "X${F77_OK}" = "Xyes"; then SERIAL_F77_EXAMPLES="yes" else SERIAL_F77_EXAMPLES="no" fi else SERIAL_F77_EXAMPLES="disabled" fi # Check if parallel F77 examples can actually be built if test "X${FCMIX_ENABLED}" = "Xyes" && test "X${MPI_ENABLED}" = "Xyes"; then if test "X${MPI_F77_COMP_OK}" = "Xyes"; then PARALLEL_F77_EXAMPLES="yes" else PARALLEL_F77_EXAMPLES="no" fi else PARALLEL_F77_EXAMPLES="disabled" fi # Notify user echo "$as_me:$LINENO: checking if we can build serial C examples" >&5 echo $ECHO_N "checking if we can build serial C examples... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${SERIAL_C_EXAMPLES}" >&5 echo "${ECHO_T}${SERIAL_C_EXAMPLES}" >&6 echo "$as_me:$LINENO: checking if we can build parallel C examples" >&5 echo $ECHO_N "checking if we can build parallel C examples... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${PARALLEL_C_EXAMPLES}" >&5 echo "${ECHO_T}${PARALLEL_C_EXAMPLES}" >&6 echo "$as_me:$LINENO: checking if we can build serial Fortran examples" >&5 echo $ECHO_N "checking if we can build serial Fortran examples... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${SERIAL_F77_EXAMPLES}" >&5 echo "${ECHO_T}${SERIAL_F77_EXAMPLES}" >&6 echo "$as_me:$LINENO: checking if we can build parallel Fortran examples" >&5 echo $ECHO_N "checking if we can build parallel Fortran examples... $ECHO_C" >&6 echo "$as_me:$LINENO: result: ${PARALLEL_F77_EXAMPLES}" >&5 echo "${ECHO_T}${PARALLEL_F77_EXAMPLES}" >&6 # Check if the Fortran update script (bin/fortran-update.in) is needed if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" || test "X${PARALLEL_F77_EXAMPLES}" = "Xyes"; then BUILD_F77_UPDATE_SCRIPT="yes"; else BUILD_F77_UPDATE_SCRIPT="no" fi # Where should we install the examples? # Note: setting this to "no" will disable example installation! echo "$as_me:$LINENO: checking where to install the SUNDIALS examples" >&5 echo $ECHO_N "checking where to install the SUNDIALS examples... $ECHO_C" >&6 # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with-exinstdir or --without-exinstdir was given. if test "${with_exinstdir+set}" = set; then withval="$with_exinstdir" EXS_INSTDIR="${withval}" else if test "X${exec_prefix}" = "XNONE"; then if test "X${prefix}" = "XNONE"; then EXS_INSTDIR="\${exec_prefix}/examples" else EXS_INSTDIR="${prefix}/examples" fi else EXS_INSTDIR="${exec_prefix}/examples" fi fi; echo "$as_me:$LINENO: result: ${EXS_INSTDIR}" >&5 echo "${ECHO_T}${EXS_INSTDIR}" >&6 # Prepare substitution variables to create the exported example Makefiles F77_LIBS="${FLIBS} ${LIBS}" if test "X${F77_LNKR}" = "X${F77}"; then F77_LDFLAGS="${FFLAGS} ${LDFLAGS}" else F77_LDFLAGS="${CFLAGS} ${LDFLAGS}" fi fi # Run libtool checks echo "" echo "Libtool Settings" echo "----------------" echo "" # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" p=${PACKAGE-default} case $enableval in yes) enable_shared=yes ;; no) enable_shared=no ;; *) enable_shared=no # Look at the argument we got. We use all the common list separators. lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," for pkg in $enableval; do IFS="$lt_save_ifs" if test "X$pkg" = "X$p"; then enable_shared=yes fi done IFS="$lt_save_ifs" ;; esac else enable_shared=no fi; # Check whether --enable-static or --disable-static was given. if test "${enable_static+set}" = set; then enableval="$enable_static" p=${PACKAGE-default} case $enableval in yes) enable_static=yes ;; no) enable_static=no ;; *) enable_static=no # Look at the argument we got. We use all the common list separators. lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," for pkg in $enableval; do IFS="$lt_save_ifs" if test "X$pkg" = "X$p"; then enable_static=yes fi done IFS="$lt_save_ifs" ;; esac else enable_static=yes fi; # Check whether --enable-fast-install or --disable-fast-install was given. if test "${enable_fast_install+set}" = set; then enableval="$enable_fast_install" p=${PACKAGE-default} case $enableval in yes) enable_fast_install=yes ;; no) enable_fast_install=no ;; *) enable_fast_install=no # Look at the argument we got. We use all the common list separators. lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," for pkg in $enableval; do IFS="$lt_save_ifs" if test "X$pkg" = "X$p"; then enable_fast_install=yes fi done IFS="$lt_save_ifs" ;; esac else enable_fast_install=yes fi; echo "$as_me:$LINENO: checking for a sed that does not truncate output" >&5 echo $ECHO_N "checking for a sed that does not truncate output... $ECHO_C" >&6 if test "${lt_cv_path_SED+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Loop through the user's path and test for sed and gsed. # Then use that list of sed's as ones to test for truncation. as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for lt_ac_prog in sed gsed; do for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$lt_ac_prog$ac_exec_ext"; then lt_ac_sed_list="$lt_ac_sed_list $as_dir/$lt_ac_prog$ac_exec_ext" fi done done done IFS=$as_save_IFS lt_ac_max=0 lt_ac_count=0 # Add /usr/xpg4/bin/sed as it is typically found on Solaris # along with /bin/sed that truncates output. for lt_ac_sed in $lt_ac_sed_list /usr/xpg4/bin/sed; do test ! -f $lt_ac_sed && continue cat /dev/null > conftest.in lt_ac_count=0 echo $ECHO_N "0123456789$ECHO_C" >conftest.in # Check for GNU sed and select it if it is found. if "$lt_ac_sed" --version 2>&1 < /dev/null | grep 'GNU' > /dev/null; then lt_cv_path_SED=$lt_ac_sed break fi while true; do cat conftest.in conftest.in >conftest.tmp mv conftest.tmp conftest.in cp conftest.in conftest.nl echo >>conftest.nl $lt_ac_sed -e 's/a$//' < conftest.nl >conftest.out || break cmp -s conftest.out conftest.nl || break # 10000 chars as input seems more than enough test $lt_ac_count -gt 10 && break lt_ac_count=`expr $lt_ac_count + 1` if test $lt_ac_count -gt $lt_ac_max; then lt_ac_max=$lt_ac_count lt_cv_path_SED=$lt_ac_sed fi done done fi SED=$lt_cv_path_SED echo "$as_me:$LINENO: result: $SED" >&5 echo "${ECHO_T}$SED" >&6 # Check whether --with-gnu-ld or --without-gnu-ld was given. if test "${with_gnu_ld+set}" = set; then withval="$with_gnu_ld" test "$withval" = no || with_gnu_ld=yes else with_gnu_ld=no fi; ac_prog=ld if test "$GCC" = yes; then # Check if gcc -print-prog-name=ld gives a path. echo "$as_me:$LINENO: checking for ld used by $CC" >&5 echo $ECHO_N "checking for ld used by $CC... $ECHO_C" >&6 case $host in *-*-mingw*) # gcc leaves a trailing carriage return which upsets mingw ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; *) ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; esac case $ac_prog in # Accept absolute paths. [\\/]* | ?:[\\/]*) re_direlt='/[^/][^/]*/\.\./' # Canonicalize the pathname of ld ac_prog=`echo $ac_prog| $SED 's%\\\\%/%g'` while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do ac_prog=`echo $ac_prog| $SED "s%$re_direlt%/%"` done test -z "$LD" && LD="$ac_prog" ;; "") # If it fails, then pretend we aren't using GCC. ac_prog=ld ;; *) # If it is relative, then search for the first ld in PATH. with_gnu_ld=unknown ;; esac elif test "$with_gnu_ld" = yes; then echo "$as_me:$LINENO: checking for GNU ld" >&5 echo $ECHO_N "checking for GNU ld... $ECHO_C" >&6 else echo "$as_me:$LINENO: checking for non-GNU ld" >&5 echo $ECHO_N "checking for non-GNU ld... $ECHO_C" >&6 fi if test "${lt_cv_path_LD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -z "$LD"; then lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR for ac_dir in $PATH; do IFS="$lt_save_ifs" test -z "$ac_dir" && ac_dir=. if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then lt_cv_path_LD="$ac_dir/$ac_prog" # Check to see if the program is GNU ld. I'd rather use --version, # but apparently some variants of GNU ld only accept -v. # Break only if it was the GNU/non-GNU ld that we prefer. case `"$lt_cv_path_LD" -v 2>&1 &5 echo "${ECHO_T}$LD" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -z "$LD" && { { echo "$as_me:$LINENO: error: no acceptable ld found in \$PATH" >&5 echo "$as_me: error: no acceptable ld found in \$PATH" >&2;} { (exit 1); exit 1; }; } echo "$as_me:$LINENO: checking if the linker ($LD) is GNU ld" >&5 echo $ECHO_N "checking if the linker ($LD) is GNU ld... $ECHO_C" >&6 if test "${lt_cv_prog_gnu_ld+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # I'd rather use --version here, but apparently some GNU lds only accept -v. case `$LD -v 2>&1 &5 echo "${ECHO_T}$lt_cv_prog_gnu_ld" >&6 with_gnu_ld=$lt_cv_prog_gnu_ld echo "$as_me:$LINENO: checking for $LD option to reload object files" >&5 echo $ECHO_N "checking for $LD option to reload object files... $ECHO_C" >&6 if test "${lt_cv_ld_reload_flag+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_ld_reload_flag='-r' fi echo "$as_me:$LINENO: result: $lt_cv_ld_reload_flag" >&5 echo "${ECHO_T}$lt_cv_ld_reload_flag" >&6 reload_flag=$lt_cv_ld_reload_flag case $reload_flag in "" | " "*) ;; *) reload_flag=" $reload_flag" ;; esac reload_cmds='$LD$reload_flag -o $output$reload_objs' case $host_os in darwin*) if test "$GCC" = yes; then reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs' else reload_cmds='$LD$reload_flag -o $output$reload_objs' fi ;; esac echo "$as_me:$LINENO: checking for BSD-compatible nm" >&5 echo $ECHO_N "checking for BSD-compatible nm... $ECHO_C" >&6 if test "${lt_cv_path_NM+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$NM"; then # Let the user override the test. lt_cv_path_NM="$NM" else lt_nm_to_check="${ac_tool_prefix}nm" if test -n "$ac_tool_prefix" && test "$build" = "$host"; then lt_nm_to_check="$lt_nm_to_check nm" fi for lt_tmp_nm in $lt_nm_to_check; do lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do IFS="$lt_save_ifs" test -z "$ac_dir" && ac_dir=. tmp_nm="$ac_dir/$lt_tmp_nm" if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then # Check to see if the nm accepts a BSD-compat flag. # Adding the `sed 1q' prevents false positives on HP-UX, which says: # nm: unknown option "B" ignored # Tru64's nm complains that /dev/null is an invalid object file case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in */dev/null* | *'Invalid file or object type'*) lt_cv_path_NM="$tmp_nm -B" break ;; *) case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in */dev/null*) lt_cv_path_NM="$tmp_nm -p" break ;; *) lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but continue # so that we can try to find one that supports BSD flags ;; esac ;; esac fi done IFS="$lt_save_ifs" done test -z "$lt_cv_path_NM" && lt_cv_path_NM=nm fi fi echo "$as_me:$LINENO: result: $lt_cv_path_NM" >&5 echo "${ECHO_T}$lt_cv_path_NM" >&6 NM="$lt_cv_path_NM" echo "$as_me:$LINENO: checking whether ln -s works" >&5 echo $ECHO_N "checking whether ln -s works... $ECHO_C" >&6 LN_S=$as_ln_s if test "$LN_S" = "ln -s"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no, using $LN_S" >&5 echo "${ECHO_T}no, using $LN_S" >&6 fi echo "$as_me:$LINENO: checking how to recognise dependent libraries" >&5 echo $ECHO_N "checking how to recognise dependent libraries... $ECHO_C" >&6 if test "${lt_cv_deplibs_check_method+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_file_magic_cmd='$MAGIC_CMD' lt_cv_file_magic_test_file= lt_cv_deplibs_check_method='unknown' # Need to set the preceding variable on all platforms that support # interlibrary dependencies. # 'none' -- dependencies not supported. # `unknown' -- same as none, but documents that we really don't know. # 'pass_all' -- all dependencies passed with no checks. # 'test_compile' -- check by making test program. # 'file_magic [[regex]]' -- check by looking for files in library path # which responds to the $file_magic_cmd with a given extended regex. # If you have `file' or equivalent on your system and you're not sure # whether `pass_all' will *always* work, you probably want this one. case $host_os in aix4* | aix5*) lt_cv_deplibs_check_method=pass_all ;; beos*) lt_cv_deplibs_check_method=pass_all ;; bsdi[45]*) lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' lt_cv_file_magic_cmd='/usr/bin/file -L' lt_cv_file_magic_test_file=/shlib/libc.so ;; cygwin*) # func_win32_libid is a shell function defined in ltmain.sh lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' lt_cv_file_magic_cmd='func_win32_libid' ;; mingw* | pw32*) # Base MSYS/MinGW do not provide the 'file' command needed by # func_win32_libid shell function, so use a weaker test based on 'objdump'. lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?' lt_cv_file_magic_cmd='$OBJDUMP -f' ;; darwin* | rhapsody*) lt_cv_deplibs_check_method=pass_all ;; freebsd* | kfreebsd*-gnu | dragonfly*) if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then case $host_cpu in i*86 ) # Not sure whether the presence of OpenBSD here was a mistake. # Let's accept both of them until this is cleared up. lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' lt_cv_file_magic_cmd=/usr/bin/file lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` ;; esac else lt_cv_deplibs_check_method=pass_all fi ;; gnu*) lt_cv_deplibs_check_method=pass_all ;; hpux10.20* | hpux11*) lt_cv_file_magic_cmd=/usr/bin/file case $host_cpu in ia64*) lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so ;; hppa*64*) lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - PA-RISC [0-9].[0-9]' lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl ;; *) lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9].[0-9]) shared library' lt_cv_file_magic_test_file=/usr/lib/libc.sl ;; esac ;; interix3*) # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' ;; irix5* | irix6* | nonstopux*) case $LD in *-32|*"-32 ") libmagic=32-bit;; *-n32|*"-n32 ") libmagic=N32;; *-64|*"-64 ") libmagic=64-bit;; *) libmagic=never-match;; esac lt_cv_deplibs_check_method=pass_all ;; # This must be Linux ELF. linux*) lt_cv_deplibs_check_method=pass_all ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' else lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' fi ;; newos6*) lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' lt_cv_file_magic_cmd=/usr/bin/file lt_cv_file_magic_test_file=/usr/lib/libnls.so ;; nto-qnx*) lt_cv_deplibs_check_method=unknown ;; openbsd*) if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' else lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' fi ;; osf3* | osf4* | osf5*) lt_cv_deplibs_check_method=pass_all ;; solaris*) lt_cv_deplibs_check_method=pass_all ;; sysv4 | sysv4.3*) case $host_vendor in motorola) lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` ;; ncr) lt_cv_deplibs_check_method=pass_all ;; sequent) lt_cv_file_magic_cmd='/bin/file' lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' ;; sni) lt_cv_file_magic_cmd='/bin/file' lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" lt_cv_file_magic_test_file=/lib/libc.so ;; siemens) lt_cv_deplibs_check_method=pass_all ;; pc) lt_cv_deplibs_check_method=pass_all ;; esac ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) lt_cv_deplibs_check_method=pass_all ;; esac fi echo "$as_me:$LINENO: result: $lt_cv_deplibs_check_method" >&5 echo "${ECHO_T}$lt_cv_deplibs_check_method" >&6 file_magic_cmd=$lt_cv_file_magic_cmd deplibs_check_method=$lt_cv_deplibs_check_method test -z "$deplibs_check_method" && deplibs_check_method=unknown # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # Check whether --enable-libtool-lock or --disable-libtool-lock was given. if test "${enable_libtool_lock+set}" = set; then enableval="$enable_libtool_lock" fi; test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes # Some flags need to be propagated to the compiler or linker for good # libtool support. case $host in ia64-*-hpux*) # Find out which ABI we are using. echo 'int i;' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.$ac_objext` in *ELF-32*) HPUX_IA64_MODE="32" ;; *ELF-64*) HPUX_IA64_MODE="64" ;; esac fi rm -rf conftest* ;; *-*-irix6*) # Find out which ABI we are using. echo '#line 11692 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then if test "$lt_cv_prog_gnu_ld" = yes; then case `/usr/bin/file conftest.$ac_objext` in *32-bit*) LD="${LD-ld} -melf32bsmip" ;; *N32*) LD="${LD-ld} -melf32bmipn32" ;; *64-bit*) LD="${LD-ld} -melf64bmip" ;; esac else case `/usr/bin/file conftest.$ac_objext` in *32-bit*) LD="${LD-ld} -32" ;; *N32*) LD="${LD-ld} -n32" ;; *64-bit*) LD="${LD-ld} -64" ;; esac fi fi rm -rf conftest* ;; x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*|s390*-*linux*|sparc*-*linux*) # Find out which ABI we are using. echo 'int i;' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.o` in *32-bit*) case $host in x86_64-*linux*) LD="${LD-ld} -m elf_i386" ;; ppc64-*linux*|powerpc64-*linux*) LD="${LD-ld} -m elf32ppclinux" ;; s390x-*linux*) LD="${LD-ld} -m elf_s390" ;; sparc64-*linux*) LD="${LD-ld} -m elf32_sparc" ;; esac ;; *64-bit*) case $host in x86_64-*linux*) LD="${LD-ld} -m elf_x86_64" ;; ppc*-*linux*|powerpc*-*linux*) LD="${LD-ld} -m elf64ppc" ;; s390*-*linux*) LD="${LD-ld} -m elf64_s390" ;; sparc*-*linux*) LD="${LD-ld} -m elf64_sparc" ;; esac ;; esac fi rm -rf conftest* ;; *-*-sco3.2v5*) # On SCO OpenServer 5, we need -belf to get full-featured binaries. SAVE_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -belf" echo "$as_me:$LINENO: checking whether the C compiler needs -belf" >&5 echo $ECHO_N "checking whether the C compiler needs -belf... $ECHO_C" >&6 if test "${lt_cv_cc_needs_belf+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then lt_cv_cc_needs_belf=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 lt_cv_cc_needs_belf=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu fi echo "$as_me:$LINENO: result: $lt_cv_cc_needs_belf" >&5 echo "${ECHO_T}$lt_cv_cc_needs_belf" >&6 if test x"$lt_cv_cc_needs_belf" != x"yes"; then # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf CFLAGS="$SAVE_CFLAGS" fi ;; sparc*-*solaris*) # Find out which ABI we are using. echo 'int i;' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.o` in *64-bit*) case $lt_cv_prog_gnu_ld in yes*) LD="${LD-ld} -m elf64_sparc" ;; *) LD="${LD-ld} -64" ;; esac ;; esac fi rm -rf conftest* ;; *-*-cygwin* | *-*-mingw* | *-*-pw32*) if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. set dummy ${ac_tool_prefix}dlltool; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_DLLTOOL+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$DLLTOOL"; then ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi DLLTOOL=$ac_cv_prog_DLLTOOL if test -n "$DLLTOOL"; then echo "$as_me:$LINENO: result: $DLLTOOL" >&5 echo "${ECHO_T}$DLLTOOL" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_DLLTOOL"; then ac_ct_DLLTOOL=$DLLTOOL # Extract the first word of "dlltool", so it can be a program name with args. set dummy dlltool; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_DLLTOOL+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_DLLTOOL"; then ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_DLLTOOL="dlltool" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_DLLTOOL" && ac_cv_prog_ac_ct_DLLTOOL="false" fi fi ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL if test -n "$ac_ct_DLLTOOL"; then echo "$as_me:$LINENO: result: $ac_ct_DLLTOOL" >&5 echo "${ECHO_T}$ac_ct_DLLTOOL" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi DLLTOOL=$ac_ct_DLLTOOL else DLLTOOL="$ac_cv_prog_DLLTOOL" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args. set dummy ${ac_tool_prefix}as; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AS"; then ac_cv_prog_AS="$AS" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AS="${ac_tool_prefix}as" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AS=$ac_cv_prog_AS if test -n "$AS"; then echo "$as_me:$LINENO: result: $AS" >&5 echo "${ECHO_T}$AS" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AS"; then ac_ct_AS=$AS # Extract the first word of "as", so it can be a program name with args. set dummy as; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AS+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AS"; then ac_cv_prog_ac_ct_AS="$ac_ct_AS" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AS="as" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_AS" && ac_cv_prog_ac_ct_AS="false" fi fi ac_ct_AS=$ac_cv_prog_ac_ct_AS if test -n "$ac_ct_AS"; then echo "$as_me:$LINENO: result: $ac_ct_AS" >&5 echo "${ECHO_T}$ac_ct_AS" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AS=$ac_ct_AS else AS="$ac_cv_prog_AS" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. set dummy ${ac_tool_prefix}objdump; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_OBJDUMP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$OBJDUMP"; then ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi OBJDUMP=$ac_cv_prog_OBJDUMP if test -n "$OBJDUMP"; then echo "$as_me:$LINENO: result: $OBJDUMP" >&5 echo "${ECHO_T}$OBJDUMP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_OBJDUMP"; then ac_ct_OBJDUMP=$OBJDUMP # Extract the first word of "objdump", so it can be a program name with args. set dummy objdump; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_OBJDUMP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_OBJDUMP"; then ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_OBJDUMP="objdump" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_OBJDUMP" && ac_cv_prog_ac_ct_OBJDUMP="false" fi fi ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP if test -n "$ac_ct_OBJDUMP"; then echo "$as_me:$LINENO: result: $ac_ct_OBJDUMP" >&5 echo "${ECHO_T}$ac_ct_OBJDUMP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi OBJDUMP=$ac_ct_OBJDUMP else OBJDUMP="$ac_cv_prog_OBJDUMP" fi ;; esac need_locks="$enable_libtool_lock" for ac_header in dlfcn.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else # Is the header compilable? echo "$as_me:$LINENO: checking $ac_header usability" >&5 echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_includes_default #include <$ac_header> _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_header_compiler=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_compiler=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 echo "${ECHO_T}$ac_header_compiler" >&6 # Is the header present? echo "$as_me:$LINENO: checking $ac_header presence" >&5 echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <$ac_header> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_c_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_c_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then ac_header_preproc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_header_preproc=no fi rm -f conftest.err conftest.$ac_ext echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 echo "${ECHO_T}$ac_header_preproc" >&6 # So? What about this header? case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in yes:no: ) { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} ac_header_preproc=yes ;; no:yes:* ) { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX ## ---------------------------- ## ## Report this to radu@llnl.gov ## ## ---------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; esac echo "$as_me:$LINENO: checking for $ac_header" >&5 echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 if eval "test \"\${$as_ac_Header+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else eval "$as_ac_Header=\$ac_header_preproc" fi echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 fi if test `eval echo '${'$as_ac_Header'}'` = yes; then cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF fi done ac_ext=cc ac_cpp='$CXXCPP $CPPFLAGS' ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_cxx_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CXX+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CXX"; then ac_cv_prog_CXX="$CXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CXX=$ac_cv_prog_CXX if test -n "$CXX"; then echo "$as_me:$LINENO: result: $CXX" >&5 echo "${ECHO_T}$CXX" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CXX" && break done fi if test -z "$CXX"; then ac_ct_CXX=$CXX for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CXX"; then ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CXX="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CXX=$ac_cv_prog_ac_ct_CXX if test -n "$ac_ct_CXX"; then echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5 echo "${ECHO_T}$ac_ct_CXX" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CXX" && break done test -n "$ac_ct_CXX" || ac_ct_CXX="g++" CXX=$ac_ct_CXX fi # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C++ compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C++ compiler... $ECHO_C" >&6 if test "${ac_cv_cxx_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_cxx_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_cxx_compiler_gnu" >&6 GXX=`test $ac_compiler_gnu = yes && echo yes` ac_test_CXXFLAGS=${CXXFLAGS+set} ac_save_CXXFLAGS=$CXXFLAGS CXXFLAGS="-g" echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5 echo $ECHO_N "checking whether $CXX accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cxx_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cxx_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cxx_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5 echo "${ECHO_T}$ac_cv_prog_cxx_g" >&6 if test "$ac_test_CXXFLAGS" = set; then CXXFLAGS=$ac_save_CXXFLAGS elif test $ac_cv_prog_cxx_g = yes; then if test "$GXX" = yes; then CXXFLAGS="-g -O2" else CXXFLAGS="-g" fi else if test "$GXX" = yes; then CXXFLAGS="-O2" else CXXFLAGS= fi fi for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi ac_ext=cc ac_cpp='$CXXCPP $CPPFLAGS' ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_cxx_compiler_gnu if test -n "$CXX" && ( test "X$CXX" != "Xno" && ( (test "X$CXX" = "Xg++" && `g++ -v >/dev/null 2>&1` ) || (test "X$CXX" != "Xg++"))) ; then ac_ext=cc ac_cpp='$CXXCPP $CPPFLAGS' ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_cxx_compiler_gnu echo "$as_me:$LINENO: checking how to run the C++ preprocessor" >&5 echo $ECHO_N "checking how to run the C++ preprocessor... $ECHO_C" >&6 if test -z "$CXXCPP"; then if test "${ac_cv_prog_CXXCPP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # Double quotes because CXXCPP needs to be expanded for CXXCPP in "$CXX -E" "/lib/cpp" do ac_preproc_ok=false for ac_cxx_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_cxx_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_cxx_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_cxx_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_cxx_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then break fi done ac_cv_prog_CXXCPP=$CXXCPP fi CXXCPP=$ac_cv_prog_CXXCPP else ac_cv_prog_CXXCPP=$CXXCPP fi echo "$as_me:$LINENO: result: $CXXCPP" >&5 echo "${ECHO_T}$CXXCPP" >&6 ac_preproc_ok=false for ac_cxx_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_cxx_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_cxx_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Broken: fails on valid input. continue fi rm -f conftest.err conftest.$ac_ext # OK, works on sane cases. Now check whether non-existent headers # can be detected and how. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } >/dev/null; then if test -s conftest.err; then ac_cpp_err=$ac_cxx_preproc_warn_flag ac_cpp_err=$ac_cpp_err$ac_cxx_werror_flag else ac_cpp_err= fi else ac_cpp_err=yes fi if test -z "$ac_cpp_err"; then # Broken: success on invalid input. continue else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { echo "$as_me:$LINENO: error: C++ preprocessor \"$CXXCPP\" fails sanity check See \`config.log' for more details." >&5 echo "$as_me: error: C++ preprocessor \"$CXXCPP\" fails sanity check See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi ac_ext=cc ac_cpp='$CXXCPP $CPPFLAGS' ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_cxx_compiler_gnu fi # Autoconf 2.13's AC_OBJEXT and AC_EXEEXT macros only works for C compilers! # find the maximum length of command line arguments echo "$as_me:$LINENO: checking the maximum length of command line arguments" >&5 echo $ECHO_N "checking the maximum length of command line arguments... $ECHO_C" >&6 if test "${lt_cv_sys_max_cmd_len+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else i=0 teststring="ABCD" case $build_os in msdosdjgpp*) # On DJGPP, this test can blow up pretty badly due to problems in libc # (any single argument exceeding 2000 bytes causes a buffer overrun # during glob expansion). Even if it were fixed, the result of this # check would be larger than it should be. lt_cv_sys_max_cmd_len=12288; # 12K is about right ;; gnu*) # Under GNU Hurd, this test is not required because there is # no limit to the length of command line arguments. # Libtool will interpret -1 as no limit whatsoever lt_cv_sys_max_cmd_len=-1; ;; cygwin* | mingw*) # On Win9x/ME, this test blows up -- it succeeds, but takes # about 5 minutes as the teststring grows exponentially. # Worse, since 9x/ME are not pre-emptively multitasking, # you end up with a "frozen" computer, even though with patience # the test eventually succeeds (with a max line length of 256k). # Instead, let's just punt: use the minimum linelength reported by # all of the supported platforms: 8192 (on NT/2K/XP). lt_cv_sys_max_cmd_len=8192; ;; amigaos*) # On AmigaOS with pdksh, this test takes hours, literally. # So we just punt and use a minimum line length of 8192. lt_cv_sys_max_cmd_len=8192; ;; netbsd* | freebsd* | openbsd* | darwin* | dragonfly*) # This has been around since 386BSD, at least. Likely further. if test -x /sbin/sysctl; then lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` elif test -x /usr/sbin/sysctl; then lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` else lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs fi # And add a safety zone lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` ;; interix*) # We know the value 262144 and hardcode it with a safety zone (like BSD) lt_cv_sys_max_cmd_len=196608 ;; osf*) # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not # nice to cause kernel panics so lets avoid the loop below. # First set a reasonable default. lt_cv_sys_max_cmd_len=16384 # if test -x /sbin/sysconfig; then case `/sbin/sysconfig -q proc exec_disable_arg_limit` in *1*) lt_cv_sys_max_cmd_len=-1 ;; esac fi ;; sco3.2v5*) lt_cv_sys_max_cmd_len=102400 ;; sysv5* | sco5v6* | sysv4.2uw2*) kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` if test -n "$kargmax"; then lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` else lt_cv_sys_max_cmd_len=32768 fi ;; *) # If test is not a shell built-in, we'll probably end up computing a # maximum length that is only half of the actual maximum length, but # we can't tell. SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} while (test "X"`$SHELL $0 --fallback-echo "X$teststring" 2>/dev/null` \ = "XX$teststring") >/dev/null 2>&1 && new_result=`expr "X$teststring" : ".*" 2>&1` && lt_cv_sys_max_cmd_len=$new_result && test $i != 17 # 1/2 MB should be enough do i=`expr $i + 1` teststring=$teststring$teststring done teststring= # Add a significant safety factor because C++ compilers can tack on massive # amounts of additional arguments before passing them to the linker. # It appears as though 1/2 is a usable value. lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` ;; esac fi if test -n $lt_cv_sys_max_cmd_len ; then echo "$as_me:$LINENO: result: $lt_cv_sys_max_cmd_len" >&5 echo "${ECHO_T}$lt_cv_sys_max_cmd_len" >&6 else echo "$as_me:$LINENO: result: none" >&5 echo "${ECHO_T}none" >&6 fi # Check for command to grab the raw symbol name followed by C symbol from nm. echo "$as_me:$LINENO: checking command to parse $NM output from $compiler object" >&5 echo $ECHO_N "checking command to parse $NM output from $compiler object... $ECHO_C" >&6 if test "${lt_cv_sys_global_symbol_pipe+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # These are sane defaults that work on at least a few old systems. # [They come from Ultrix. What could be older than Ultrix?!! ;)] # Character class describing NM global symbol codes. symcode='[BCDEGRST]' # Regexp to match symbols that can be accessed directly from C. sympat='\([_A-Za-z][_A-Za-z0-9]*\)' # Transform an extracted symbol line into a proper C declaration lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern int \1;/p'" # Transform an extracted symbol line into symbol name and symbol address lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode \([^ ]*\) \([^ ]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'" # Define system-specific variables. case $host_os in aix*) symcode='[BCDT]' ;; cygwin* | mingw* | pw32*) symcode='[ABCDGISTW]' ;; hpux*) # Its linker distinguishes data from code symbols if test "$host_cpu" = ia64; then symcode='[ABCDEGRST]' fi lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'" lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'" ;; linux*) if test "$host_cpu" = ia64; then symcode='[ABCDGIRSTW]' lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'" lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'" fi ;; irix* | nonstopux*) symcode='[BCDEGRST]' ;; osf*) symcode='[BCDEGQRST]' ;; solaris*) symcode='[BDRT]' ;; sco3.2v5*) symcode='[DT]' ;; sysv4.2uw2*) symcode='[DT]' ;; sysv5* | sco5v6* | unixware* | OpenUNIX*) symcode='[ABDT]' ;; sysv4) symcode='[DFNSTU]' ;; esac # Handle CRLF in mingw tool chain opt_cr= case $build_os in mingw*) opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp ;; esac # If we're using GNU nm, then use its standard symbol codes. case `$NM -V 2>&1` in *GNU* | *'with BFD'*) symcode='[ABCDGIRSTW]' ;; esac # Try without a prefix undercore, then with it. for ac_symprfx in "" "_"; do # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. symxfrm="\\1 $ac_symprfx\\2 \\2" # Write the raw and C identifiers. lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" # Check to see that the pipe works correctly. pipe_works=no rm -f conftest* cat > conftest.$ac_ext <&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Now try to grab the symbols. nlist=conftest.nm if { (eval echo "$as_me:$LINENO: \"$NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist\"") >&5 (eval $NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s "$nlist"; then # Try sorting and uniquifying the output. if sort "$nlist" | uniq > "$nlist"T; then mv -f "$nlist"T "$nlist" else rm -f "$nlist"T fi # Make sure that we snagged all the symbols we need. if grep ' nm_test_var$' "$nlist" >/dev/null; then if grep ' nm_test_func$' "$nlist" >/dev/null; then cat < conftest.$ac_ext #ifdef __cplusplus extern "C" { #endif EOF # Now generate the symbol file. eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | grep -v main >> conftest.$ac_ext' cat <> conftest.$ac_ext #if defined (__STDC__) && __STDC__ # define lt_ptr_t void * #else # define lt_ptr_t char * # define const #endif /* The mapping between symbol names and symbols. */ const struct { const char *name; lt_ptr_t address; } lt_preloaded_symbols[] = { EOF $SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (lt_ptr_t) \&\2},/" < "$nlist" | grep -v main >> conftest.$ac_ext cat <<\EOF >> conftest.$ac_ext {0, (lt_ptr_t) 0} }; #ifdef __cplusplus } #endif EOF # Now try linking the two files. mv conftest.$ac_objext conftstm.$ac_objext lt_save_LIBS="$LIBS" lt_save_CFLAGS="$CFLAGS" LIBS="conftstm.$ac_objext" CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext}; then pipe_works=yes fi LIBS="$lt_save_LIBS" CFLAGS="$lt_save_CFLAGS" else echo "cannot find nm_test_func in $nlist" >&5 fi else echo "cannot find nm_test_var in $nlist" >&5 fi else echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 fi else echo "$progname: failed program was:" >&5 cat conftest.$ac_ext >&5 fi rm -f conftest* conftst* # Do not use the global_symbol_pipe unless it works. if test "$pipe_works" = yes; then break else lt_cv_sys_global_symbol_pipe= fi done fi if test -z "$lt_cv_sys_global_symbol_pipe"; then lt_cv_sys_global_symbol_to_cdecl= fi if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then echo "$as_me:$LINENO: result: failed" >&5 echo "${ECHO_T}failed" >&6 else echo "$as_me:$LINENO: result: ok" >&5 echo "${ECHO_T}ok" >&6 fi echo "$as_me:$LINENO: checking for objdir" >&5 echo $ECHO_N "checking for objdir... $ECHO_C" >&6 if test "${lt_cv_objdir+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else rm -f .libs 2>/dev/null mkdir .libs 2>/dev/null if test -d .libs; then lt_cv_objdir=.libs else # MS-DOS does not allow filenames that begin with a dot. lt_cv_objdir=_libs fi rmdir .libs 2>/dev/null fi echo "$as_me:$LINENO: result: $lt_cv_objdir" >&5 echo "${ECHO_T}$lt_cv_objdir" >&6 objdir=$lt_cv_objdir case $host_os in aix3*) # AIX sometimes has problems with the GCC collect2 program. For some # reason, if we set the COLLECT_NAMES environment variable, the problems # vanish in a puff of smoke. if test "X${COLLECT_NAMES+set}" != Xset; then COLLECT_NAMES= export COLLECT_NAMES fi ;; esac # Sed substitution that helps us do robust quoting. It backslashifies # metacharacters that are still active within double-quoted strings. Xsed='sed -e 1s/^X//' sed_quote_subst='s/\([\\"\\`$\\\\]\)/\\\1/g' # Same as above, but do not quote variable references. double_quote_subst='s/\([\\"\\`\\\\]\)/\\\1/g' # Sed substitution to delay expansion of an escaped shell variable in a # double_quote_subst'ed string. delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' # Sed substitution to avoid accidental globbing in evaled expressions no_glob_subst='s/\*/\\\*/g' # Constants: rm="rm -f" # Global variables: default_ofile=libtool can_build_shared=yes # All known linkers require a `.a' archive for static linking (except MSVC, # which needs '.lib'). libext=a ltmain="$ac_aux_dir/ltmain.sh" ofile="$default_ofile" with_gnu_ld="$lt_cv_prog_gnu_ld" if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_AR" && ac_cv_prog_ac_ct_AR="false" fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. set dummy ${ac_tool_prefix}strip; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_STRIP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$STRIP"; then ac_cv_prog_STRIP="$STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_STRIP="${ac_tool_prefix}strip" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi STRIP=$ac_cv_prog_STRIP if test -n "$STRIP"; then echo "$as_me:$LINENO: result: $STRIP" >&5 echo "${ECHO_T}$STRIP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_STRIP"; then ac_ct_STRIP=$STRIP # Extract the first word of "strip", so it can be a program name with args. set dummy strip; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_STRIP"; then ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_STRIP="strip" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_STRIP" && ac_cv_prog_ac_ct_STRIP=":" fi fi ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP if test -n "$ac_ct_STRIP"; then echo "$as_me:$LINENO: result: $ac_ct_STRIP" >&5 echo "${ECHO_T}$ac_ct_STRIP" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi STRIP=$ac_ct_STRIP else STRIP="$ac_cv_prog_STRIP" fi old_CC="$CC" old_CFLAGS="$CFLAGS" # Set sane defaults for various variables test -z "$AR" && AR=ar test -z "$AR_FLAGS" && AR_FLAGS=cru test -z "$AS" && AS=as test -z "$CC" && CC=cc test -z "$LTCC" && LTCC=$CC test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS test -z "$DLLTOOL" && DLLTOOL=dlltool test -z "$LD" && LD=ld test -z "$LN_S" && LN_S="ln -s" test -z "$MAGIC_CMD" && MAGIC_CMD=file test -z "$NM" && NM=nm test -z "$SED" && SED=sed test -z "$OBJDUMP" && OBJDUMP=objdump test -z "$RANLIB" && RANLIB=: test -z "$STRIP" && STRIP=: test -z "$ac_objext" && ac_objext=o # Determine commands to create old-style static archives. old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs' old_postinstall_cmds='chmod 644 $oldlib' old_postuninstall_cmds= if test -n "$RANLIB"; then case $host_os in openbsd*) old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$oldlib" ;; *) old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$oldlib" ;; esac old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib" fi for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` # Only perform the check for file, if the check method requires it case $deplibs_check_method in file_magic*) if test "$file_magic_cmd" = '$MAGIC_CMD'; then echo "$as_me:$LINENO: checking for ${ac_tool_prefix}file" >&5 echo $ECHO_N "checking for ${ac_tool_prefix}file... $ECHO_C" >&6 if test "${lt_cv_path_MAGIC_CMD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $MAGIC_CMD in [\\/*] | ?:[\\/]*) lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. ;; *) lt_save_MAGIC_CMD="$MAGIC_CMD" lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" for ac_dir in $ac_dummy; do IFS="$lt_save_ifs" test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/${ac_tool_prefix}file; then lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file" if test -n "$file_magic_test_file"; then case $deplibs_check_method in "file_magic "*) file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` MAGIC_CMD="$lt_cv_path_MAGIC_CMD" if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | $EGREP "$file_magic_regex" > /dev/null; then : else cat <&2 *** Warning: the command libtool uses to detect shared libraries, *** $file_magic_cmd, produces output that libtool cannot recognize. *** The result is that libtool may fail to recognize shared libraries *** as such. This will affect the creation of libtool libraries that *** depend on shared libraries, but programs linked with such libtool *** libraries will work regardless of this problem. Nevertheless, you *** may want to report the problem to your system manager and/or to *** bug-libtool@gnu.org EOF fi ;; esac fi break fi done IFS="$lt_save_ifs" MAGIC_CMD="$lt_save_MAGIC_CMD" ;; esac fi MAGIC_CMD="$lt_cv_path_MAGIC_CMD" if test -n "$MAGIC_CMD"; then echo "$as_me:$LINENO: result: $MAGIC_CMD" >&5 echo "${ECHO_T}$MAGIC_CMD" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi if test -z "$lt_cv_path_MAGIC_CMD"; then if test -n "$ac_tool_prefix"; then echo "$as_me:$LINENO: checking for file" >&5 echo $ECHO_N "checking for file... $ECHO_C" >&6 if test "${lt_cv_path_MAGIC_CMD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $MAGIC_CMD in [\\/*] | ?:[\\/]*) lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. ;; *) lt_save_MAGIC_CMD="$MAGIC_CMD" lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" for ac_dir in $ac_dummy; do IFS="$lt_save_ifs" test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/file; then lt_cv_path_MAGIC_CMD="$ac_dir/file" if test -n "$file_magic_test_file"; then case $deplibs_check_method in "file_magic "*) file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` MAGIC_CMD="$lt_cv_path_MAGIC_CMD" if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | $EGREP "$file_magic_regex" > /dev/null; then : else cat <&2 *** Warning: the command libtool uses to detect shared libraries, *** $file_magic_cmd, produces output that libtool cannot recognize. *** The result is that libtool may fail to recognize shared libraries *** as such. This will affect the creation of libtool libraries that *** depend on shared libraries, but programs linked with such libtool *** libraries will work regardless of this problem. Nevertheless, you *** may want to report the problem to your system manager and/or to *** bug-libtool@gnu.org EOF fi ;; esac fi break fi done IFS="$lt_save_ifs" MAGIC_CMD="$lt_save_MAGIC_CMD" ;; esac fi MAGIC_CMD="$lt_cv_path_MAGIC_CMD" if test -n "$MAGIC_CMD"; then echo "$as_me:$LINENO: result: $MAGIC_CMD" >&5 echo "${ECHO_T}$MAGIC_CMD" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi else MAGIC_CMD=: fi fi fi ;; esac enable_dlopen=no enable_win32_dll=yes # Check whether --enable-libtool-lock or --disable-libtool-lock was given. if test "${enable_libtool_lock+set}" = set; then enableval="$enable_libtool_lock" fi; test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes # Check whether --with-pic or --without-pic was given. if test "${with_pic+set}" = set; then withval="$with_pic" pic_mode="$withval" else pic_mode=default fi; test -z "$pic_mode" && pic_mode=default # Use C for the default configuration in the libtool script tagname= lt_save_CC="$CC" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Source file extension for C test sources. ac_ext=c # Object file extension for compiled C test sources. objext=o objext=$objext # Code to be used in simple compile tests lt_simple_compile_test_code="int some_variable = 0;\n" # Code to be used in simple link tests lt_simple_link_test_code='int main(){return(0);}\n' # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # save warnings/boilerplate of simple test code ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" >conftest.$ac_ext eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_compiler_boilerplate=`cat conftest.err` $rm conftest* ac_outfile=conftest.$ac_objext printf "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` $rm conftest* lt_prog_compiler_no_builtin_flag= if test "$GCC" = yes; then lt_prog_compiler_no_builtin_flag=' -fno-builtin' echo "$as_me:$LINENO: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 echo $ECHO_N "checking if $compiler supports -fno-rtti -fno-exceptions... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_rtti_exceptions+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_rtti_exceptions=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-fno-rtti -fno-exceptions" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:13780: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:13784: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_cv_prog_compiler_rtti_exceptions=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_rtti_exceptions" >&6 if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" else : fi fi lt_prog_compiler_wl= lt_prog_compiler_pic= lt_prog_compiler_static= echo "$as_me:$LINENO: checking for $compiler option to produce PIC" >&5 echo $ECHO_N "checking for $compiler option to produce PIC... $ECHO_C" >&6 if test "$GCC" = yes; then lt_prog_compiler_wl='-Wl,' lt_prog_compiler_static='-static' case $host_os in aix*) # All AIX code is PIC. if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static='-Bstatic' fi ;; amigaos*) # FIXME: we need at least 68020 code to build shared libraries, but # adding the `-m68020' flag to GCC prevents building anything better, # like `-m68040'. lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' ;; beos* | cygwin* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic='-DDLL_EXPORT' ;; darwin* | rhapsody*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files lt_prog_compiler_pic='-fno-common' ;; interix3*) # Interix 3.x gcc -fpic/-fPIC options generate broken code. # Instead, we relocate shared libraries at runtime. ;; msdosdjgpp*) # Just because we use GCC doesn't mean we suddenly get shared libraries # on systems that don't support them. lt_prog_compiler_can_build_shared=no enable_shared=no ;; sysv4*MP*) if test -d /usr/nec; then lt_prog_compiler_pic=-Kconform_pic fi ;; hpux*) # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic='-fPIC' ;; esac ;; *) lt_prog_compiler_pic='-fPIC' ;; esac else # PORTME Check for flag to pass linker flags through the system compiler. case $host_os in aix*) lt_prog_compiler_wl='-Wl,' if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static='-Bstatic' else lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' fi ;; darwin*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files case $cc_basename in xlc*) lt_prog_compiler_pic='-qnocommon' lt_prog_compiler_wl='-Wl,' ;; esac ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic='-DDLL_EXPORT' ;; hpux9* | hpux10* | hpux11*) lt_prog_compiler_wl='-Wl,' # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic='+Z' ;; esac # Is there a better lt_prog_compiler_static that works with the bundled CC? lt_prog_compiler_static='${wl}-a ${wl}archive' ;; irix5* | irix6* | nonstopux*) lt_prog_compiler_wl='-Wl,' # PIC (with -KPIC) is the default. lt_prog_compiler_static='-non_shared' ;; newsos6) lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-Bstatic' ;; linux*) case $cc_basename in icc* | ecc*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-static' ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-fpic' lt_prog_compiler_static='-Bstatic' ;; ccc*) lt_prog_compiler_wl='-Wl,' # All Alpha code is PIC. lt_prog_compiler_static='-non_shared' ;; esac ;; osf3* | osf4* | osf5*) lt_prog_compiler_wl='-Wl,' # All OSF/1 code is PIC. lt_prog_compiler_static='-non_shared' ;; solaris*) lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-Bstatic' case $cc_basename in f77* | f90* | f95*) lt_prog_compiler_wl='-Qoption ld ';; *) lt_prog_compiler_wl='-Wl,';; esac ;; sunos4*) lt_prog_compiler_wl='-Qoption ld ' lt_prog_compiler_pic='-PIC' lt_prog_compiler_static='-Bstatic' ;; sysv4 | sysv4.2uw2* | sysv4.3*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-Bstatic' ;; sysv4*MP*) if test -d /usr/nec ;then lt_prog_compiler_pic='-Kconform_pic' lt_prog_compiler_static='-Bstatic' fi ;; sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_pic='-KPIC' lt_prog_compiler_static='-Bstatic' ;; unicos*) lt_prog_compiler_wl='-Wl,' lt_prog_compiler_can_build_shared=no ;; uts4*) lt_prog_compiler_pic='-pic' lt_prog_compiler_static='-Bstatic' ;; *) lt_prog_compiler_can_build_shared=no ;; esac fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic" >&5 echo "${ECHO_T}$lt_prog_compiler_pic" >&6 # # Check to make sure the PIC flag actually works. # if test -n "$lt_prog_compiler_pic"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic works... $ECHO_C" >&6 if test "${lt_prog_compiler_pic_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_pic_works=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic -DPIC" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:14048: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:14052: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_pic_works=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_works" >&6 if test x"$lt_prog_compiler_pic_works" = xyes; then case $lt_prog_compiler_pic in "" | " "*) ;; *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; esac else lt_prog_compiler_pic= lt_prog_compiler_can_build_shared=no fi fi case $host_os in # For platforms which do not support PIC, -DPIC is meaningless: *djgpp*) lt_prog_compiler_pic= ;; *) lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" ;; esac # # Check to make sure the static flag actually works. # wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 if test "${lt_prog_compiler_static_works+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_static_works=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" printf "$lt_simple_link_test_code" > conftest.$ac_ext if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then # The linker can only warn and ignore the option if not recognized # So say no if there are warnings if test -s conftest.err; then # Append any errors to the config.log. cat conftest.err 1>&5 $echo "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_static_works=yes fi else lt_prog_compiler_static_works=yes fi fi $rm conftest* LDFLAGS="$save_LDFLAGS" fi echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works" >&5 echo "${ECHO_T}$lt_prog_compiler_static_works" >&6 if test x"$lt_prog_compiler_static_works" = xyes; then : else lt_prog_compiler_static= fi echo "$as_me:$LINENO: checking if $compiler supports -c -o file.$ac_objext" >&5 echo $ECHO_N "checking if $compiler supports -c -o file.$ac_objext... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_c_o+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_c_o=no $rm -r conftest 2>/dev/null mkdir conftest cd conftest mkdir out printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-o out/conftest2.$ac_objext" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:14152: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 echo "$as_me:14156: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' > out/conftest.exp $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then lt_cv_prog_compiler_c_o=yes fi fi chmod u+w . 2>&5 $rm conftest* # SGI C++ compiler will create directory out/ii_files/ for # template instantiation test -d out/ii_files && $rm out/ii_files/* && rmdir out/ii_files $rm out/* && rmdir out cd .. rmdir conftest $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_c_o" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_c_o" >&6 hard_links="nottested" if test "$lt_cv_prog_compiler_c_o" = no && test "$need_locks" != no; then # do not overwrite the value of need_locks provided by the user echo "$as_me:$LINENO: checking if we can lock with hard links" >&5 echo $ECHO_N "checking if we can lock with hard links... $ECHO_C" >&6 hard_links=yes $rm conftest* ln conftest.a conftest.b 2>/dev/null && hard_links=no touch conftest.a ln conftest.a conftest.b 2>&5 || hard_links=no ln conftest.a conftest.b 2>/dev/null && hard_links=no echo "$as_me:$LINENO: result: $hard_links" >&5 echo "${ECHO_T}$hard_links" >&6 if test "$hard_links" = no; then { echo "$as_me:$LINENO: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} need_locks=warn fi else need_locks=no fi echo "$as_me:$LINENO: checking whether the $compiler linker ($LD) supports shared libraries" >&5 echo $ECHO_N "checking whether the $compiler linker ($LD) supports shared libraries... $ECHO_C" >&6 runpath_var= allow_undefined_flag= enable_shared_with_static_runtimes=no archive_cmds= archive_expsym_cmds= old_archive_From_new_cmds= old_archive_from_expsyms_cmds= export_dynamic_flag_spec= whole_archive_flag_spec= thread_safe_flag_spec= hardcode_libdir_flag_spec= hardcode_libdir_flag_spec_ld= hardcode_libdir_separator= hardcode_direct=no hardcode_minus_L=no hardcode_shlibpath_var=unsupported link_all_deplibs=unknown hardcode_automatic=no module_cmds= module_expsym_cmds= always_export_symbols=no export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' # include_expsyms should be a list of space-separated symbols to be *always* # included in the symbol list include_expsyms= # exclude_expsyms can be an extended regexp of symbols to exclude # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. exclude_expsyms="_GLOBAL_OFFSET_TABLE_" # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. extract_expsyms_cmds= # Just being paranoid about ensuring that cc_basename is set. for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` case $host_os in cygwin* | mingw* | pw32*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. if test "$GCC" != yes; then with_gnu_ld=no fi ;; interix*) # we just hope/assume this is gcc and not c89 (= MSVC++) with_gnu_ld=yes ;; openbsd*) with_gnu_ld=no ;; esac ld_shlibs=yes if test "$with_gnu_ld" = yes; then # If archive_cmds runs LD, not CC, wlarc should be empty wlarc='${wl}' # Set some defaults for GNU ld with shared library support. These # are reset later if shared libraries are not supported. Putting them # here allows them to be overridden if necessary. runpath_var=LD_RUN_PATH hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir' export_dynamic_flag_spec='${wl}--export-dynamic' # ancient GNU ld didn't support --whole-archive et. al. if $LD --help 2>&1 | grep 'no-whole-archive' > /dev/null; then whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' else whole_archive_flag_spec= fi supports_anon_versioning=no case `$LD -v 2>/dev/null` in *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... *\ 2.11.*) ;; # other 2.11 versions *) supports_anon_versioning=yes ;; esac # See if GNU ld supports shared libraries. case $host_os in aix3* | aix4* | aix5*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs=no cat <&2 *** Warning: the GNU linker, at least up to release 2.9.1, is reported *** to be unable to reliably create shared libraries on AIX. *** Therefore, libtool is disabling shared libraries support. If you *** really care for shared libraries, you may want to modify your PATH *** so that a non-GNU linker is found, and then restart. EOF fi ;; amigaos*) archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes # Samuel A. Falvo II reports # that the semantics of dynamic libraries on AmigaOS, at least up # to version 4, is to share data among multiple programs linked # with the same dynamic library. Since this doesn't match the # behavior of shared libraries on other platforms, we can't use # them. ld_shlibs=no ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then allow_undefined_flag=unsupported # Joseph Beckenbach says some releases of gcc # support --undefined. This deserves some investigation. FIXME archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' else ld_shlibs=no fi ;; cygwin* | mingw* | pw32*) # _LT_AC_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec='-L$libdir' allow_undefined_flag=unsupported always_export_symbols=no enable_shared_with_static_runtimes=yes export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS] /s/.* \([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW] /s/.* //'\'' | sort | uniq > $export_symbols' if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' # If the export-symbols file already is a .def file (1st line # is EXPORTS), use it as is; otherwise, prepend... archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then cp $export_symbols $output_objdir/$soname.def; else echo EXPORTS > $output_objdir/$soname.def; cat $export_symbols >> $output_objdir/$soname.def; fi~ $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' else ld_shlibs=no fi ;; interix3*) hardcode_direct=no hardcode_shlibpath_var=no hardcode_libdir_flag_spec='${wl}-rpath,$libdir' export_dynamic_flag_spec='${wl}-E' # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. # Instead, shared libraries are loaded at an image base (0x10000000 by # default) and relocated if they conflict, which is a slow very memory # consuming and fragmenting process. To avoid this, we pick a random, # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link # time. Moving up from 0x10000000 also allows more sbrk(2) space. archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; linux*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then tmp_addflag= case $cc_basename,$host_cpu in pgcc*) # Portland Group C compiler whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag' ;; pgf77* | pgf90* | pgf95*) # Portland Group f77 and f90 compilers whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag -Mnomain' ;; ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 tmp_addflag=' -i_dynamic' ;; efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 tmp_addflag=' -i_dynamic -nofor_main' ;; ifc* | ifort*) # Intel Fortran compiler tmp_addflag=' -nofor_main' ;; esac archive_cmds='$CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' if test $supports_anon_versioning = yes; then archive_expsym_cmds='$echo "{ global:" > $output_objdir/$libname.ver~ cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ $echo "local: *; };" >> $output_objdir/$libname.ver~ $CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' fi else ld_shlibs=no fi ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' wlarc= else archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' fi ;; solaris*) if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then ld_shlibs=no cat <&2 *** Warning: The releases 2.8.* of the GNU linker cannot reliably *** create shared libraries on Solaris systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.9.1 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. EOF elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs=no fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) case `$LD -v 2>&1` in *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) ld_shlibs=no cat <<_LT_EOF 1>&2 *** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not *** reliably create shared libraries on SCO systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.16.91.0.3 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. _LT_EOF ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`' archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib' archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname,-retain-symbols-file,$export_symbols -o $lib' else ld_shlibs=no fi ;; esac ;; sunos4*) archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' wlarc= hardcode_direct=yes hardcode_shlibpath_var=no ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs=no fi ;; esac if test "$ld_shlibs" = no; then runpath_var= hardcode_libdir_flag_spec= export_dynamic_flag_spec= whole_archive_flag_spec= fi else # PORTME fill in a description of your system's linker (not GNU ld) case $host_os in aix3*) allow_undefined_flag=unsupported always_export_symbols=yes archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' # Note: this linker hardcodes the directories in LIBPATH if there # are no directories specified by -L. hardcode_minus_L=yes if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then # Neither direct hardcoding nor static linking is supported with a # broken collect2. hardcode_direct=unsupported fi ;; aix4* | aix5*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. aix_use_runtimelinking=no exp_sym_flag='-Bexport' no_entry_flag="" else # If we're using GNU nm, then we don't want the "-C" option. # -C means demangle to AIX nm, but means don't demangle with GNU nm if $NM -V 2>&1 | grep 'GNU' > /dev/null; then export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' else export_symbols_cmds='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' fi aix_use_runtimelinking=no # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. case $host_os in aix4.[23]|aix4.[23].*|aix5*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes break fi done ;; esac exp_sym_flag='-bexport' no_entry_flag='-bnoentry' fi # When large executables or shared objects are built, AIX ld can # have problems creating the table of contents. If linking a library # or program results in "error TOC overflow" add -mminimal-toc to # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. archive_cmds='' hardcode_direct=yes hardcode_libdir_separator=':' link_all_deplibs=yes if test "$GCC" = yes; then case $host_os in aix4.[012]|aix4.[012].*) # We only want to do this on AIX 4.2 and lower, the check # below for broken collect2 doesn't work under 4.3+ collect2name=`${CC} -print-prog-name=collect2` if test -f "$collect2name" && \ strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 hardcode_direct=yes else # We have old collect2 hardcode_direct=unsupported # It fails to find uninstalled libraries when the uninstalled # path is not listed in the libpath. Setting hardcode_minus_L # to unsupported forces relinking hardcode_minus_L=yes hardcode_libdir_flag_spec='-L$libdir' hardcode_libdir_separator= fi ;; esac shared_flag='-shared' if test "$aix_use_runtimelinking" = yes; then shared_flag="$shared_flag "'${wl}-G' fi else # not using gcc if test "$host_cpu" = ia64; then # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release # chokes on -Wl,-G. The following line is correct: shared_flag='-G' else if test "$aix_use_runtimelinking" = yes; then shared_flag='${wl}-G' else shared_flag='${wl}-bM:SRE' fi fi fi # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols=yes if test "$aix_use_runtimelinking" = yes; then # Warning - without using the other runtime loading flags (-brtl), # -berok will link without error, but may produce a broken library. allow_undefined_flag='-berok' # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" archive_expsym_cmds="\$CC"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" else if test "$host_cpu" = ia64; then hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' allow_undefined_flag="-z nodefs" archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" else # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" # Warning - without using the other run time loading flags, # -berok will link without error, but may produce a broken library. no_undefined_flag=' ${wl}-bernotok' allow_undefined_flag=' ${wl}-berok' # Exported symbols can be pulled into shared objects from archives whole_archive_flag_spec='$convenience' archive_cmds_need_lc=yes # This is similar to how AIX traditionally builds its shared libraries. archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' fi fi ;; amigaos*) archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes # see comment about different semantics on the GNU ld section ld_shlibs=no ;; bsdi[45]*) export_dynamic_flag_spec=-rdynamic ;; cygwin* | mingw* | pw32*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is # no search path for DLLs. hardcode_libdir_flag_spec=' ' allow_undefined_flag=unsupported # Tell ltmain to make .lib files, not .a files. libext=lib # Tell ltmain to make .dll files, not .so files. shrext_cmds=".dll" # FIXME: Setting linknames here is a bad hack. archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | $SED -e '\''s/ -lc$//'\''` -link -dll~linknames=' # The linker will automatically build a .lib file if we build a DLL. old_archive_From_new_cmds='true' # FIXME: Should let the user specify the lib program. old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs' fix_srcfile_path='`cygpath -w "$srcfile"`' enable_shared_with_static_runtimes=yes ;; darwin* | rhapsody*) case $host_os in rhapsody* | darwin1.[012]) allow_undefined_flag='${wl}-undefined ${wl}suppress' ;; *) # Darwin 1.3 on if test -z ${MACOSX_DEPLOYMENT_TARGET} ; then allow_undefined_flag='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' else case ${MACOSX_DEPLOYMENT_TARGET} in 10.[012]) allow_undefined_flag='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; 10.*) allow_undefined_flag='${wl}-undefined ${wl}dynamic_lookup' ;; esac fi ;; esac archive_cmds_need_lc=no hardcode_direct=no hardcode_automatic=yes hardcode_shlibpath_var=unsupported whole_archive_flag_spec='' link_all_deplibs=yes if test "$GCC" = yes ; then output_verbose_link_cmd='echo' archive_cmds='$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' module_cmds='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' else case $cc_basename in xlc*) output_verbose_link_cmd='echo' archive_cmds='$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`echo $rpath/$soname` $verstring' module_cmds='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ;; *) ld_shlibs=no ;; esac fi ;; dgux*) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec='-L$libdir' hardcode_shlibpath_var=no ;; freebsd1*) ld_shlibs=no ;; # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor # support. Future versions do this automatically, but an explicit c++rt0.o # does not break anything, and helps significantly (at the cost of a little # extra space). freebsd2.2*) archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes hardcode_shlibpath_var=no ;; # Unfortunately, older versions of FreeBSD 2 do not have this feature. freebsd2*) archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_direct=yes hardcode_minus_L=yes hardcode_shlibpath_var=no ;; # FreeBSD 3 and greater uses gcc -shared to do shared libraries. freebsd* | kfreebsd*-gnu | dragonfly*) archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes hardcode_shlibpath_var=no ;; hpux9*) if test "$GCC" = yes; then archive_cmds='$rm $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' else archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' fi hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: hardcode_direct=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes export_dynamic_flag_spec='${wl}-E' ;; hpux10*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: hardcode_direct=yes export_dynamic_flag_spec='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes fi ;; hpux11*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then case $host_cpu in hppa*64*) archive_cmds='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac else case $host_cpu in hppa*64*) archive_cmds='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: case $host_cpu in hppa*64*|ia64*) hardcode_libdir_flag_spec_ld='+b $libdir' hardcode_direct=no hardcode_shlibpath_var=no ;; *) hardcode_direct=yes export_dynamic_flag_spec='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes ;; esac fi ;; irix5* | irix6* | nonstopux*) if test "$GCC" = yes; then archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_ld='-rpath $libdir' fi hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: link_all_deplibs=yes ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out else archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF fi hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes hardcode_shlibpath_var=no ;; newsos6) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct=yes hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: hardcode_shlibpath_var=no ;; openbsd*) hardcode_direct=yes hardcode_shlibpath_var=no if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' hardcode_libdir_flag_spec='${wl}-rpath,$libdir' export_dynamic_flag_spec='${wl}-E' else case $host_os in openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec='-R$libdir' ;; *) archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; esac fi ;; os2*) hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes allow_undefined_flag=unsupported archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' old_archive_From_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' ;; osf3*) if test "$GCC" = yes; then allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else allow_undefined_flag=' -expect_unresolved \*' archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' fi hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: ;; osf4* | osf5*) # as osf3* with the addition of -msym flag if test "$GCC" = yes; then allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' else allow_undefined_flag=' -expect_unresolved \*' archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib~$rm $lib.exp' # Both c and cxx compiler support -rpath directly hardcode_libdir_flag_spec='-rpath $libdir' fi hardcode_libdir_separator=: ;; solaris*) no_undefined_flag=' -z text' if test "$GCC" = yes; then wlarc='${wl}' archive_cmds='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -shared ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$rm $lib.exp' else wlarc='' archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp' fi hardcode_libdir_flag_spec='-R$libdir' hardcode_shlibpath_var=no case $host_os in solaris2.[0-5] | solaris2.[0-5].*) ;; *) # The compiler driver will combine linker options so we # cannot just pass the convience library names through # without $wl, iff we do not link with $LD. # Luckily, gcc supports the same syntax we need for Sun Studio. # Supported since Solaris 2.6 (maybe 2.5.1?) case $wlarc in '') whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;; *) whole_archive_flag_spec='${wl}-z ${wl}allextract`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}-z ${wl}defaultextract' ;; esac ;; esac link_all_deplibs=yes ;; sunos4*) if test "x$host_vendor" = xsequent; then # Use $CC to link under sequent, because it throws in some extra .o # files that make .init and .fini sections work. archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' fi hardcode_libdir_flag_spec='-L$libdir' hardcode_direct=yes hardcode_minus_L=yes hardcode_shlibpath_var=no ;; sysv4) case $host_vendor in sni) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct=yes # is this really true??? ;; siemens) ## LD is ld it makes a PLAMLIB ## CC just makes a GrossModule. archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' reload_cmds='$CC -r -o $output$reload_objs' hardcode_direct=no ;; motorola) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct=no #Motorola manual says yes, but my tests say they lie ;; esac runpath_var='LD_RUN_PATH' hardcode_shlibpath_var=no ;; sysv4.3*) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var=no export_dynamic_flag_spec='-Bexport' ;; sysv4*MP*) if test -d /usr/nec; then archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var=no runpath_var=LD_RUN_PATH hardcode_runpath_var=yes ld_shlibs=yes fi ;; sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7*) no_undefined_flag='${wl}-z,text' archive_cmds_need_lc=no hardcode_shlibpath_var=no runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; sysv5* | sco3.2v5* | sco5v6*) # Note: We can NOT use -z defs as we might desire, because we do not # link with -lc, and that would cause any symbols used from libc to # always be unresolved, which means just about no library would # ever link correctly. If we're not using GNU ld we use -z text # though, which does catch some bad symbols but isn't as heavy-handed # as -z defs. no_undefined_flag='${wl}-z,text' allow_undefined_flag='${wl}-z,nodefs' archive_cmds_need_lc=no hardcode_shlibpath_var=no hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' hardcode_libdir_separator=':' link_all_deplibs=yes export_dynamic_flag_spec='${wl}-Bexport' runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds='$CC -shared ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds='$CC -G ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; uts4*) archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec='-L$libdir' hardcode_shlibpath_var=no ;; *) ld_shlibs=no ;; esac fi echo "$as_me:$LINENO: result: $ld_shlibs" >&5 echo "${ECHO_T}$ld_shlibs" >&6 test "$ld_shlibs" = no && can_build_shared=no # # Do we need to explicitly link libc? # case "x$archive_cmds_need_lc" in x|xyes) # Assume -lc should be added archive_cmds_need_lc=yes if test "$enable_shared" = yes && test "$GCC" = yes; then case $archive_cmds in *'~'*) # FIXME: we may have to deal with multi-command sequences. ;; '$CC '*) # Test whether the compiler implicitly links with -lc since on some # systems, -lgcc has to come before -lc. If gcc already passes -lc # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 $rm conftest* printf "$lt_simple_compile_test_code" > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then soname=conftest lib=conftest libobjs=conftest.$ac_objext deplibs= wl=$lt_prog_compiler_wl pic_flag=$lt_prog_compiler_pic compiler_flags=-v linker_flags=-v verstring= output_objdir=. libname=conftest lt_save_allow_undefined_flag=$allow_undefined_flag allow_undefined_flag= if { (eval echo "$as_me:$LINENO: \"$archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } then archive_cmds_need_lc=no else archive_cmds_need_lc=yes fi allow_undefined_flag=$lt_save_allow_undefined_flag else cat conftest.err 1>&5 fi $rm conftest* echo "$as_me:$LINENO: result: $archive_cmds_need_lc" >&5 echo "${ECHO_T}$archive_cmds_need_lc" >&6 ;; esac fi ;; esac echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 library_names_spec= libname_spec='lib$name' soname_spec= shrext_cmds=".so" postinstall_cmds= postuninstall_cmds= finish_cmds= finish_eval= shlibpath_var= shlibpath_overrides_runpath=unknown version_type=none dynamic_linker="$host_os ld.so" sys_lib_dlsearch_path_spec="/lib /usr/lib" if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';' >/dev/null ; then # if the path contains ";" then we assume it to be the separator # otherwise default to the standard path separator (i.e. ":") - it is # assumed that no part of a normal pathname contains ";" but that should # okay in the real world where ";" in dirpaths is itself problematic. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi else sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" fi need_lib_prefix=unknown hardcode_into_libs=no # when you set need_version to no, make sure it does not cause -set_version # flags to be left without arguments need_version=unknown case $host_os in aix3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' shlibpath_var=LIBPATH # AIX 3 has no versioning support, so we append a major version to the name. soname_spec='${libname}${release}${shared_ext}$major' ;; aix4* | aix5*) version_type=linux need_lib_prefix=no need_version=no hardcode_into_libs=yes if test "$host_cpu" = ia64; then # AIX 5 supports IA64 library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH else # With GCC up to 2.95.x, collect2 would create an import file # for dependence libraries. The import file would start with # the line `#! .'. This would cause the generated library to # depend on `.', always an invalid library. This was fixed in # development snapshots of GCC prior to 3.0. case $host_os in aix4 | aix4.[01] | aix4.[01].*) if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' echo ' yes ' echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then : else can_build_shared=no fi ;; esac # AIX (on Power*) has no versioning support, so currently we can not hardcode correct # soname into executable. Probably we can add versioning support to # collect2, so additional links can be useful in future. if test "$aix_use_runtimelinking" = yes; then # If using run time linking (on AIX 4.2 or later) use lib.so # instead of lib.a to let people know that these are not # typical AIX shared libraries. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' else # We preserve .a as extension for shared libraries through AIX4.2 # and later when we are not doing run time linking. library_names_spec='${libname}${release}.a $libname.a' soname_spec='${libname}${release}${shared_ext}$major' fi shlibpath_var=LIBPATH fi ;; amigaos*) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ;; beos*) library_names_spec='${libname}${shared_ext}' dynamic_linker="$host_os ld.so" shlibpath_var=LIBRARY_PATH ;; bsdi[45]*) version_type=linux need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" # the default ld.so.conf also contains /usr/contrib/lib and # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow # libtool to hard-code these into programs ;; cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no case $GCC,$host_os in yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i;echo \$dlname'\''`~ dldir=$destdir/`dirname \$dlpath`~ test -d \$dldir || mkdir -p \$dldir~ $install_prog $dir/$dlname \$dldir/$dlname~ chmod a+x \$dldir/$dlname' postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ dlpath=$dir/\$dldll~ $rm \$dlpath' shlibpath_overrides_runpath=yes case $host_os in cygwin*) # Cygwin DLLs use 'cyg' prefix rather than 'lib' soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';[c-zC-Z]:/' >/dev/null; then # It is most probably a Windows format PATH printed by # mingw gcc, but we are running on Cygwin. Gcc prints its search # path with ; separators, and with drive letters. We can handle the # drive letters (cygwin fileutils understands them), so leave them, # especially as we might pass files found there to a mingw objdump, # which wouldn't understand a cygwinified path. Ahh. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi ;; pw32*) # pw32 DLLs use 'pw' prefix rather than 'lib' library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' ;; esac ;; *) library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' ;; esac dynamic_linker='Win32 ld.exe' # FIXME: first we should search . and the directory the executable is in shlibpath_var=PATH ;; darwin* | rhapsody*) dynamic_linker="$host_os dyld" version_type=darwin need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${versuffix}$shared_ext ${libname}${release}${major}$shared_ext ${libname}$shared_ext' soname_spec='${libname}${release}${major}$shared_ext' shlibpath_overrides_runpath=yes shlibpath_var=DYLD_LIBRARY_PATH shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' # Apple's gcc prints 'gcc -print-search-dirs' doesn't operate the same. if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | tr "\n" "$PATH_SEPARATOR" | sed -e 's/libraries:/@libraries:/' | tr "@" "\n" | grep "^libraries:" | sed -e "s/^libraries://" -e "s,=/,/,g" -e "s,$PATH_SEPARATOR, ,g" -e "s,.*,& /lib /usr/lib /usr/local/lib,g"` else sys_lib_search_path_spec='/lib /usr/lib /usr/local/lib' fi sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' ;; dgux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; freebsd1*) dynamic_linker=no ;; kfreebsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; freebsd* | dragonfly*) # DragonFly does not have aout. When/if they implement a new # versioning mechanism, adjust this. if test -x /usr/bin/objformat; then objformat=`/usr/bin/objformat` else case $host_os in freebsd[123]*) objformat=aout ;; *) objformat=elf ;; esac fi version_type=freebsd-$objformat case $version_type in freebsd-elf*) library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' need_version=no need_lib_prefix=no ;; freebsd-*) library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' need_version=yes ;; esac shlibpath_var=LD_LIBRARY_PATH case $host_os in freebsd2*) shlibpath_overrides_runpath=yes ;; freebsd3.[01]* | freebsdelf3.[01]*) shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; freebsd*) # from 4.6 on shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; esac ;; gnu*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes ;; hpux9* | hpux10* | hpux11*) # Give a soname corresponding to the major version so that dld.sl refuses to # link against other versions. version_type=sunos need_lib_prefix=no need_version=no case $host_cpu in ia64*) shrext_cmds='.so' hardcode_into_libs=yes dynamic_linker="$host_os dld.so" shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' if test "X$HPUX_IA64_MODE" = X32; then sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" else sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" fi sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; hppa*64*) shrext_cmds='.sl' hardcode_into_libs=yes dynamic_linker="$host_os dld.sl" shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; *) shrext_cmds='.sl' dynamic_linker="$host_os dld.sl" shlibpath_var=SHLIB_PATH shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' ;; esac # HP-UX runs *really* slowly unless shared libraries are mode 555. postinstall_cmds='chmod 555 $lib' ;; interix3*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; irix5* | irix6* | nonstopux*) case $host_os in nonstopux*) version_type=nonstopux ;; *) if test "$lt_cv_prog_gnu_ld" = yes; then version_type=linux else version_type=irix fi ;; esac need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' case $host_os in irix5* | nonstopux*) libsuff= shlibsuff= ;; *) case $LD in # libtool.m4 will add one of these switches to LD *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= libmagic=32-bit;; *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 libmagic=N32;; *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 libmagic=64-bit;; *) libsuff= shlibsuff= libmagic=never-match;; esac ;; esac shlibpath_var=LD_LIBRARY${shlibsuff}_PATH shlibpath_overrides_runpath=no sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" hardcode_into_libs=yes ;; # No shared lib support for Linux oldld, aout, or coff. linux*oldld* | linux*aout* | linux*coff*) dynamic_linker=no ;; # This must be Linux ELF. linux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install # before this can be enabled. hardcode_into_libs=yes # find out which ABI we are using libsuff= case "$host_cpu" in x86_64*|s390x*|powerpc64*) echo '#line 15621 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.$ac_objext` in *64-bit*) libsuff=64 sys_lib_search_path_spec="/lib${libsuff} /usr/lib${libsuff} /usr/local/lib${libsuff}" ;; esac fi rm -rf conftest* ;; esac # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib${libsuff} /usr/lib${libsuff} $lt_ld_extra" fi # We used to test for /lib/ld.so.1 and disable shared libraries on # powerpc, because MkLinux only supported shared libraries with the # GNU dynamic linker. Since this was broken with cross compilers, # most powerpc-linux boxes support dynamic linking these days and # people can always --disable-shared, the test was removed, and we # assume the GNU/Linux dynamic linker is in use. dynamic_linker='GNU/Linux ld.so' ;; knetbsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; netbsd*) version_type=sunos need_lib_prefix=no need_version=no if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' dynamic_linker='NetBSD (a.out) ld.so' else library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='NetBSD ld.elf_so' fi shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; newsos6) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; nto-qnx*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; openbsd*) version_type=sunos sys_lib_dlsearch_path_spec="/usr/lib" need_lib_prefix=no # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. case $host_os in openbsd3.3 | openbsd3.3.*) need_version=yes ;; *) need_version=no ;; esac library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' shlibpath_var=LD_LIBRARY_PATH if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then case $host_os in openbsd2.[89] | openbsd2.[89].*) shlibpath_overrides_runpath=no ;; *) shlibpath_overrides_runpath=yes ;; esac else shlibpath_overrides_runpath=yes fi ;; os2*) libname_spec='$name' shrext_cmds=".dll" need_lib_prefix=no library_names_spec='$libname${shared_ext} $libname.a' dynamic_linker='OS/2 ld.exe' shlibpath_var=LIBPATH ;; osf3* | osf4* | osf5*) version_type=osf need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" ;; solaris*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes # ldd complains unless libraries are executable postinstall_cmds='chmod +x $lib' ;; sunos4*) version_type=sunos library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes if test "$with_gnu_ld" = yes; then need_lib_prefix=no fi need_version=yes ;; sysv4 | sysv4.3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH case $host_vendor in sni) shlibpath_overrides_runpath=no need_lib_prefix=no export_dynamic_flag_spec='${wl}-Blargedynsym' runpath_var=LD_RUN_PATH ;; siemens) need_lib_prefix=no ;; motorola) need_lib_prefix=no need_version=no shlibpath_overrides_runpath=no sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' ;; esac ;; sysv4*MP*) if test -d /usr/nec ;then version_type=linux library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' soname_spec='$libname${shared_ext}.$major' shlibpath_var=LD_LIBRARY_PATH fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) version_type=freebsd-elf need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes if test "$with_gnu_ld" = yes; then sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' shlibpath_overrides_runpath=no else sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' shlibpath_overrides_runpath=yes case $host_os in sco3.2v5*) sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" ;; esac fi sys_lib_dlsearch_path_spec='/usr/lib' ;; uts4*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; *) dynamic_linker=no ;; esac echo "$as_me:$LINENO: result: $dynamic_linker" >&5 echo "${ECHO_T}$dynamic_linker" >&6 test "$dynamic_linker" = no && can_build_shared=no variables_saved_for_relink="PATH $shlibpath_var $runpath_var" if test "$GCC" = yes; then variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi echo "$as_me:$LINENO: checking how to hardcode library paths into programs" >&5 echo $ECHO_N "checking how to hardcode library paths into programs... $ECHO_C" >&6 hardcode_action= if test -n "$hardcode_libdir_flag_spec" || \ test -n "$runpath_var" || \ test "X$hardcode_automatic" = "Xyes" ; then # We can hardcode non-existant directories. if test "$hardcode_direct" != no && # If the only mechanism to avoid hardcoding is shlibpath_var, we # have to relink, otherwise we might link with an installed library # when we should be linking with a yet-to-be-installed one ## test "$_LT_AC_TAGVAR(hardcode_shlibpath_var, )" != no && test "$hardcode_minus_L" != no; then # Linking always hardcodes the temporary library directory. hardcode_action=relink else # We can link without hardcoding, and we can hardcode nonexisting dirs. hardcode_action=immediate fi else # We cannot hardcode anything, or else we can only hardcode existing # directories. hardcode_action=unsupported fi echo "$as_me:$LINENO: result: $hardcode_action" >&5 echo "${ECHO_T}$hardcode_action" >&6 if test "$hardcode_action" = relink; then # Fast installation is not supported enable_fast_install=no elif test "$shlibpath_overrides_runpath" = yes || test "$enable_shared" = no; then # Fast installation is not necessary enable_fast_install=needless fi striplib= old_striplib= echo "$as_me:$LINENO: checking whether stripping libraries is possible" >&5 echo $ECHO_N "checking whether stripping libraries is possible... $ECHO_C" >&6 if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" test -z "$striplib" && striplib="$STRIP --strip-unneeded" echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else # FIXME - insert some real tests, host_os isn't really good enough case $host_os in darwin*) if test -n "$STRIP" ; then striplib="$STRIP -x" echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi ;; *) echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 ;; esac fi if test "x$enable_dlopen" != xyes; then enable_dlopen=unknown enable_dlopen_self=unknown enable_dlopen_self_static=unknown else lt_cv_dlopen=no lt_cv_dlopen_libs= case $host_os in beos*) lt_cv_dlopen="load_add_on" lt_cv_dlopen_libs= lt_cv_dlopen_self=yes ;; mingw* | pw32*) lt_cv_dlopen="LoadLibrary" lt_cv_dlopen_libs= ;; cygwin*) lt_cv_dlopen="dlopen" lt_cv_dlopen_libs= ;; darwin*) # if libdl is installed we need to link against it echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 if test $ac_cv_lib_dl_dlopen = yes; then lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" else lt_cv_dlopen="dyld" lt_cv_dlopen_libs= lt_cv_dlopen_self=yes fi ;; *) echo "$as_me:$LINENO: checking for shl_load" >&5 echo $ECHO_N "checking for shl_load... $ECHO_C" >&6 if test "${ac_cv_func_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define shl_load to an innocuous variant, in case declares shl_load. For example, HP-UX 11i declares gettimeofday. */ #define shl_load innocuous_shl_load /* System header to define __stub macros and hopefully few prototypes, which can conflict with char shl_load (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef shl_load /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_shl_load) || defined (__stub___shl_load) choke me #else char (*f) () = shl_load; #endif #ifdef __cplusplus } #endif int main () { return f != shl_load; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_shl_load" >&5 echo "${ECHO_T}$ac_cv_func_shl_load" >&6 if test $ac_cv_func_shl_load = yes; then lt_cv_dlopen="shl_load" else echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5 echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_shl_load+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char shl_load (); int main () { shl_load (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_shl_load=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_shl_load=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5 echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6 if test $ac_cv_lib_dld_shl_load = yes; then lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-dld" else echo "$as_me:$LINENO: checking for dlopen" >&5 echo $ECHO_N "checking for dlopen... $ECHO_C" >&6 if test "${ac_cv_func_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Define dlopen to an innocuous variant, in case declares dlopen. For example, HP-UX 11i declares gettimeofday. */ #define dlopen innocuous_dlopen /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dlopen (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef dlopen /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" { #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_dlopen) || defined (__stub___dlopen) choke me #else char (*f) () = dlopen; #endif #ifdef __cplusplus } #endif int main () { return f != dlopen; ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_func_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_func_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_func_dlopen" >&5 echo "${ECHO_T}$ac_cv_func_dlopen" >&6 if test $ac_cv_func_dlopen = yes; then lt_cv_dlopen="dlopen" else echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5 echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6 if test "${ac_cv_lib_dl_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dl_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dl_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6 if test $ac_cv_lib_dl_dlopen = yes; then lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" else echo "$as_me:$LINENO: checking for dlopen in -lsvld" >&5 echo $ECHO_N "checking for dlopen in -lsvld... $ECHO_C" >&6 if test "${ac_cv_lib_svld_dlopen+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-lsvld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dlopen (); int main () { dlopen (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_svld_dlopen=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_svld_dlopen=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_svld_dlopen" >&5 echo "${ECHO_T}$ac_cv_lib_svld_dlopen" >&6 if test $ac_cv_lib_svld_dlopen = yes; then lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld" else echo "$as_me:$LINENO: checking for dld_link in -ldld" >&5 echo $ECHO_N "checking for dld_link in -ldld... $ECHO_C" >&6 if test "${ac_cv_lib_dld_dld_link+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ /* Override any gcc2 internal prototype to avoid an error. */ #ifdef __cplusplus extern "C" #endif /* We use char because int might match the return type of a gcc2 builtin and then its argument prototype would still apply. */ char dld_link (); int main () { dld_link (); ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_lib_dld_dld_link=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_lib_dld_dld_link=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi echo "$as_me:$LINENO: result: $ac_cv_lib_dld_dld_link" >&5 echo "${ECHO_T}$ac_cv_lib_dld_dld_link" >&6 if test $ac_cv_lib_dld_dld_link = yes; then lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-dld" fi fi fi fi fi fi ;; esac if test "x$lt_cv_dlopen" != xno; then enable_dlopen=yes else enable_dlopen=no fi case $lt_cv_dlopen in dlopen) save_CPPFLAGS="$CPPFLAGS" test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" save_LDFLAGS="$LDFLAGS" wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" save_LIBS="$LIBS" LIBS="$lt_cv_dlopen_libs $LIBS" echo "$as_me:$LINENO: checking whether a program can dlopen itself" >&5 echo $ECHO_N "checking whether a program can dlopen itself... $ECHO_C" >&6 if test "${lt_cv_dlopen_self+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then : lt_cv_dlopen_self=cross else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext < #endif #include #ifdef RTLD_GLOBAL # define LT_DLGLOBAL RTLD_GLOBAL #else # ifdef DL_GLOBAL # define LT_DLGLOBAL DL_GLOBAL # else # define LT_DLGLOBAL 0 # endif #endif /* We may have to define LT_DLLAZY_OR_NOW in the command line if we find out it does not work in some platform. */ #ifndef LT_DLLAZY_OR_NOW # ifdef RTLD_LAZY # define LT_DLLAZY_OR_NOW RTLD_LAZY # else # ifdef DL_LAZY # define LT_DLLAZY_OR_NOW DL_LAZY # else # ifdef RTLD_NOW # define LT_DLLAZY_OR_NOW RTLD_NOW # else # ifdef DL_NOW # define LT_DLLAZY_OR_NOW DL_NOW # else # define LT_DLLAZY_OR_NOW 0 # endif # endif # endif # endif #endif #ifdef __cplusplus extern "C" void exit (int); #endif void fnord() { int i=42;} int main () { void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); int status = $lt_dlunknown; if (self) { if (dlsym (self,"fnord")) status = $lt_dlno_uscore; else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; /* dlclose (self); */ } else puts (dlerror ()); exit (status); } EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} 2>/dev/null; then (./conftest; exit; ) >&5 2>/dev/null lt_status=$? case x$lt_status in x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; esac else : # compilation failed lt_cv_dlopen_self=no fi fi rm -fr conftest* fi echo "$as_me:$LINENO: result: $lt_cv_dlopen_self" >&5 echo "${ECHO_T}$lt_cv_dlopen_self" >&6 if test "x$lt_cv_dlopen_self" = xyes; then wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" echo "$as_me:$LINENO: checking whether a statically linked program can dlopen itself" >&5 echo $ECHO_N "checking whether a statically linked program can dlopen itself... $ECHO_C" >&6 if test "${lt_cv_dlopen_self_static+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then : lt_cv_dlopen_self_static=cross else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext < #endif #include #ifdef RTLD_GLOBAL # define LT_DLGLOBAL RTLD_GLOBAL #else # ifdef DL_GLOBAL # define LT_DLGLOBAL DL_GLOBAL # else # define LT_DLGLOBAL 0 # endif #endif /* We may have to define LT_DLLAZY_OR_NOW in the command line if we find out it does not work in some platform. */ #ifndef LT_DLLAZY_OR_NOW # ifdef RTLD_LAZY # define LT_DLLAZY_OR_NOW RTLD_LAZY # else # ifdef DL_LAZY # define LT_DLLAZY_OR_NOW DL_LAZY # else # ifdef RTLD_NOW # define LT_DLLAZY_OR_NOW RTLD_NOW # else # ifdef DL_NOW # define LT_DLLAZY_OR_NOW DL_NOW # else # define LT_DLLAZY_OR_NOW 0 # endif # endif # endif # endif #endif #ifdef __cplusplus extern "C" void exit (int); #endif void fnord() { int i=42;} int main () { void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); int status = $lt_dlunknown; if (self) { if (dlsym (self,"fnord")) status = $lt_dlno_uscore; else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; /* dlclose (self); */ } else puts (dlerror ()); exit (status); } EOF if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && test -s conftest${ac_exeext} 2>/dev/null; then (./conftest; exit; ) >&5 2>/dev/null lt_status=$? case x$lt_status in x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; esac else : # compilation failed lt_cv_dlopen_self_static=no fi fi rm -fr conftest* fi echo "$as_me:$LINENO: result: $lt_cv_dlopen_self_static" >&5 echo "${ECHO_T}$lt_cv_dlopen_self_static" >&6 fi CPPFLAGS="$save_CPPFLAGS" LDFLAGS="$save_LDFLAGS" LIBS="$save_LIBS" ;; esac case $lt_cv_dlopen_self in yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; *) enable_dlopen_self=unknown ;; esac case $lt_cv_dlopen_self_static in yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; *) enable_dlopen_self_static=unknown ;; esac fi # Report which library types will actually be built echo "$as_me:$LINENO: checking if libtool supports shared libraries" >&5 echo $ECHO_N "checking if libtool supports shared libraries... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $can_build_shared" >&5 echo "${ECHO_T}$can_build_shared" >&6 echo "$as_me:$LINENO: checking whether to build shared libraries" >&5 echo $ECHO_N "checking whether to build shared libraries... $ECHO_C" >&6 test "$can_build_shared" = "no" && enable_shared=no # On AIX, shared libraries and static libraries use the same namespace, and # are all built from PIC. case $host_os in aix3*) test "$enable_shared" = yes && enable_static=no if test -n "$RANLIB"; then archive_cmds="$archive_cmds~\$RANLIB \$lib" postinstall_cmds='$RANLIB $lib' fi ;; aix4* | aix5*) if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then test "$enable_shared" = yes && enable_static=no fi ;; esac echo "$as_me:$LINENO: result: $enable_shared" >&5 echo "${ECHO_T}$enable_shared" >&6 echo "$as_me:$LINENO: checking whether to build static libraries" >&5 echo $ECHO_N "checking whether to build static libraries... $ECHO_C" >&6 # Make sure either enable_shared or enable_static is yes. test "$enable_shared" = yes || enable_static=yes echo "$as_me:$LINENO: result: $enable_static" >&5 echo "${ECHO_T}$enable_static" >&6 # The else clause should only fire when bootstrapping the # libtool distribution, otherwise you forgot to ship ltmain.sh # with your package, and you will get complaints that there are # no rules to generate ltmain.sh. if test -f "$ltmain"; then # See if we are running on zsh, and set the options which allow our commands through # without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Now quote all the things that may contain metacharacters while being # careful not to overquote the AC_SUBSTed values. We take copies of the # variables and quote the copies for generation of the libtool script. for var in echo old_CC old_CFLAGS AR AR_FLAGS EGREP RANLIB LN_S LTCC LTCFLAGS NM \ SED SHELL STRIP \ libname_spec library_names_spec soname_spec extract_expsyms_cmds \ old_striplib striplib file_magic_cmd finish_cmds finish_eval \ deplibs_check_method reload_flag reload_cmds need_locks \ lt_cv_sys_global_symbol_pipe lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \ old_postinstall_cmds old_postuninstall_cmds \ compiler \ CC \ LD \ lt_prog_compiler_wl \ lt_prog_compiler_pic \ lt_prog_compiler_static \ lt_prog_compiler_no_builtin_flag \ export_dynamic_flag_spec \ thread_safe_flag_spec \ whole_archive_flag_spec \ enable_shared_with_static_runtimes \ old_archive_cmds \ old_archive_from_new_cmds \ predep_objects \ postdep_objects \ predeps \ postdeps \ compiler_lib_search_path \ archive_cmds \ archive_expsym_cmds \ postinstall_cmds \ postuninstall_cmds \ old_archive_from_expsyms_cmds \ allow_undefined_flag \ no_undefined_flag \ export_symbols_cmds \ hardcode_libdir_flag_spec \ hardcode_libdir_flag_spec_ld \ hardcode_libdir_separator \ hardcode_automatic \ module_cmds \ module_expsym_cmds \ lt_cv_prog_compiler_c_o \ exclude_expsyms \ include_expsyms; do case $var in old_archive_cmds | \ old_archive_from_new_cmds | \ archive_cmds | \ archive_expsym_cmds | \ module_cmds | \ module_expsym_cmds | \ old_archive_from_expsyms_cmds | \ export_symbols_cmds | \ extract_expsyms_cmds | reload_cmds | finish_cmds | \ postinstall_cmds | postuninstall_cmds | \ old_postinstall_cmds | old_postuninstall_cmds | \ sys_lib_search_path_spec | sys_lib_dlsearch_path_spec) # Double-quote double-evaled strings. eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ;; *) eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ;; esac done case $lt_echo in *'\$0 --fallback-echo"') lt_echo=`$echo "X$lt_echo" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'` ;; esac cfgfile="${ofile}T" trap "$rm \"$cfgfile\"; exit 1" 1 2 15 $rm -f "$cfgfile" { echo "$as_me:$LINENO: creating $ofile" >&5 echo "$as_me: creating $ofile" >&6;} cat <<__EOF__ >> "$cfgfile" #! $SHELL # `$echo "$cfgfile" | sed 's%^.*/%%'` - Provide generalized library-building support services. # Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP) # NOTE: Changes made to this file will be lost: look at ltmain.sh. # # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 # Free Software Foundation, Inc. # # This file is part of GNU Libtool: # Originally by Gordon Matzigkeit , 1996 # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # A sed program that does not truncate output. SED=$lt_SED # Sed that helps us avoid accidentally triggering echo(1) options like -n. Xsed="$SED -e 1s/^X//" # The HP-UX ksh and POSIX shell print the target directory to stdout # if CDPATH is set. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # The names of the tagged configurations supported by this script. available_tags= # ### BEGIN LIBTOOL CONFIG # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # Shell to use when invoking shell scripts. SHELL=$lt_SHELL # Whether or not to build shared libraries. build_libtool_libs=$enable_shared # Whether or not to build static libraries. build_old_libs=$enable_static # Whether or not to add -lc for building shared libraries. build_libtool_need_lc=$archive_cmds_need_lc # Whether or not to disallow shared libs when runtime libs are static allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes # Whether or not to optimize for fast installation. fast_install=$enable_fast_install # The host system. host_alias=$host_alias host=$host host_os=$host_os # The build system. build_alias=$build_alias build=$build build_os=$build_os # An echo program that does not interpret backslashes. echo=$lt_echo # The archiver. AR=$lt_AR AR_FLAGS=$lt_AR_FLAGS # A C compiler. LTCC=$lt_LTCC # LTCC compiler flags. LTCFLAGS=$lt_LTCFLAGS # A language-specific compiler. CC=$lt_compiler # Is the compiler the GNU C compiler? with_gcc=$GCC gcc_dir=\`gcc -print-file-name=. | $SED 's,/\.$,,'\` gcc_ver=\`gcc -dumpversion\` # An ERE matcher. EGREP=$lt_EGREP # The linker used to build libraries. LD=$lt_LD # Whether we need hard or soft links. LN_S=$lt_LN_S # A BSD-compatible nm program. NM=$lt_NM # A symbol stripping program STRIP=$lt_STRIP # Used to examine libraries when file_magic_cmd begins "file" MAGIC_CMD=$MAGIC_CMD # Used on cygwin: DLL creation program. DLLTOOL="$DLLTOOL" # Used on cygwin: object dumper. OBJDUMP="$OBJDUMP" # Used on cygwin: assembler. AS="$AS" # The name of the directory that contains temporary libtool files. objdir=$objdir # How to create reloadable object files. reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds # How to pass a linker flag through the compiler. wl=$lt_lt_prog_compiler_wl # Object file suffix (normally "o"). objext="$ac_objext" # Old archive suffix (normally "a"). libext="$libext" # Shared library suffix (normally ".so"). shrext_cmds='$shrext_cmds' # Executable file suffix (normally ""). exeext="$exeext" # Additional compiler flags for building library objects. pic_flag=$lt_lt_prog_compiler_pic pic_mode=$pic_mode # What is the maximum length of a command? max_cmd_len=$lt_cv_sys_max_cmd_len # Does compiler simultaneously support -c and -o options? compiler_c_o=$lt_lt_cv_prog_compiler_c_o # Must we lock files when doing compilation? need_locks=$lt_need_locks # Do we need the lib prefix for modules? need_lib_prefix=$need_lib_prefix # Do we need a version for libraries? need_version=$need_version # Whether dlopen is supported. dlopen_support=$enable_dlopen # Whether dlopen of programs is supported. dlopen_self=$enable_dlopen_self # Whether dlopen of statically linked programs is supported. dlopen_self_static=$enable_dlopen_self_static # Compiler flag to prevent dynamic linking. link_static_flag=$lt_lt_prog_compiler_static # Compiler flag to turn off builtin functions. no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag # Compiler flag to allow reflexive dlopens. export_dynamic_flag_spec=$lt_export_dynamic_flag_spec # Compiler flag to generate shared objects directly from archives. whole_archive_flag_spec=$lt_whole_archive_flag_spec # Compiler flag to generate thread-safe objects. thread_safe_flag_spec=$lt_thread_safe_flag_spec # Library versioning type. version_type=$version_type # Format of library name prefix. libname_spec=$lt_libname_spec # List of archive names. First name is the real one, the rest are links. # The last name is the one that the linker finds with -lNAME. library_names_spec=$lt_library_names_spec # The coded name of the library, if different from the real name. soname_spec=$lt_soname_spec # Commands used to build and install an old-style archive. RANLIB=$lt_RANLIB old_archive_cmds=$lt_old_archive_cmds old_postinstall_cmds=$lt_old_postinstall_cmds old_postuninstall_cmds=$lt_old_postuninstall_cmds # Create an old-style archive from a shared archive. old_archive_from_new_cmds=$lt_old_archive_from_new_cmds # Create a temporary old-style archive to link instead of a shared archive. old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds # Commands used to build and install a shared archive. archive_cmds=$lt_archive_cmds archive_expsym_cmds=$lt_archive_expsym_cmds postinstall_cmds=$lt_postinstall_cmds postuninstall_cmds=$lt_postuninstall_cmds # Commands used to build a loadable module (assumed same as above if empty) module_cmds=$lt_module_cmds module_expsym_cmds=$lt_module_expsym_cmds # Commands to strip libraries. old_striplib=$lt_old_striplib striplib=$lt_striplib # Dependencies to place before the objects being linked to create a # shared library. predep_objects=\`echo $lt_predep_objects | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place after the objects being linked to create a # shared library. postdep_objects=\`echo $lt_postdep_objects | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place before the objects being linked to create a # shared library. predeps=$lt_predeps # Dependencies to place after the objects being linked to create a # shared library. postdeps=$lt_postdeps # The library search path used internally by the compiler when linking # a shared library. compiler_lib_search_path=\`echo $lt_compiler_lib_search_path | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method # Command to use when deplibs_check_method == file_magic. file_magic_cmd=$lt_file_magic_cmd # Flag that allows shared libraries with undefined symbols to be built. allow_undefined_flag=$lt_allow_undefined_flag # Flag that forces no undefined symbols. no_undefined_flag=$lt_no_undefined_flag # Commands used to finish a libtool library installation in a directory. finish_cmds=$lt_finish_cmds # Same as above, but a single script fragment to be evaled but not shown. finish_eval=$lt_finish_eval # Take the output of nm and produce a listing of raw symbols and C names. global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe # Transform the output of nm in a proper C declaration global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl # Transform the output of nm in a C name address pair global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address # This is the shared library runtime path variable. runpath_var=$runpath_var # This is the shared library path variable. shlibpath_var=$shlibpath_var # Is shlibpath searched before the hard-coded library search path? shlibpath_overrides_runpath=$shlibpath_overrides_runpath # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action # Whether we should hardcode library paths into libraries. hardcode_into_libs=$hardcode_into_libs # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec # If ld is used when linking, flag to hardcode \$libdir into # a binary during linking. This must work even if \$libdir does # not exist. hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld # Whether we need a single -rpath flag with a separated argument. hardcode_libdir_separator=$lt_hardcode_libdir_separator # Set to yes if using DIR/libNAME${shared_ext} during linking hardcodes DIR into the # resulting binary. hardcode_direct=$hardcode_direct # Set to yes if using the -LDIR flag during linking hardcodes DIR into the # resulting binary. hardcode_minus_L=$hardcode_minus_L # Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into # the resulting binary. hardcode_shlibpath_var=$hardcode_shlibpath_var # Set to yes if building a shared library automatically hardcodes DIR into the library # and all subsequent libraries and executables linked against it. hardcode_automatic=$hardcode_automatic # Variables whose values should be saved in libtool wrapper scripts and # restored at relink time. variables_saved_for_relink="$variables_saved_for_relink" # Whether libtool must link a program against all its dependency libraries. link_all_deplibs=$link_all_deplibs # Compile-time system search path for libraries sys_lib_search_path_spec=\`echo $lt_sys_lib_search_path_spec | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Run-time system search path for libraries sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec # Fix the shell variable \$srcfile for the compiler. fix_srcfile_path="$fix_srcfile_path" # Set to yes if exported symbols are required. always_export_symbols=$always_export_symbols # The commands to list exported symbols. export_symbols_cmds=$lt_export_symbols_cmds # The commands to extract the exported symbol list from a shared archive. extract_expsyms_cmds=$lt_extract_expsyms_cmds # Symbols that should not be listed in the preloaded symbols. exclude_expsyms=$lt_exclude_expsyms # Symbols that must always be exported. include_expsyms=$lt_include_expsyms # ### END LIBTOOL CONFIG __EOF__ case $host_os in aix3*) cat <<\EOF >> "$cfgfile" # AIX sometimes has problems with the GCC collect2 program. For some # reason, if we set the COLLECT_NAMES environment variable, the problems # vanish in a puff of smoke. if test "X${COLLECT_NAMES+set}" != Xset; then COLLECT_NAMES= export COLLECT_NAMES fi EOF ;; esac # We use sed instead of cat because bash on DJGPP gets confused if # if finds mixed CR/LF and LF-only lines. Since sed operates in # text mode, it properly converts lines to CR/LF. This bash problem # is reportedly fixed, but why not run on old versions too? sed '$q' "$ltmain" >> "$cfgfile" || (rm -f "$cfgfile"; exit 1) mv -f "$cfgfile" "$ofile" || \ (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") chmod +x "$ofile" else # If there is no Makefile yet, we rely on a make rule to execute # `config.status --recheck' to rerun these tests and create the # libtool script then. ltmain_in=`echo $ltmain | sed -e 's/\.sh$/.in/'` if test -f "$ltmain_in"; then test -f Makefile && make "$ltmain" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CC="$lt_save_CC" # Check whether --with-tags or --without-tags was given. if test "${with_tags+set}" = set; then withval="$with_tags" tagnames="$withval" fi; if test -f "$ltmain" && test -n "$tagnames"; then if test ! -f "${ofile}"; then { echo "$as_me:$LINENO: WARNING: output file \`$ofile' does not exist" >&5 echo "$as_me: WARNING: output file \`$ofile' does not exist" >&2;} fi if test -z "$LTCC"; then eval "`$SHELL ${ofile} --config | grep '^LTCC='`" if test -z "$LTCC"; then { echo "$as_me:$LINENO: WARNING: output file \`$ofile' does not look like a libtool script" >&5 echo "$as_me: WARNING: output file \`$ofile' does not look like a libtool script" >&2;} else { echo "$as_me:$LINENO: WARNING: using \`LTCC=$LTCC', extracted from \`$ofile'" >&5 echo "$as_me: WARNING: using \`LTCC=$LTCC', extracted from \`$ofile'" >&2;} fi fi if test -z "$LTCFLAGS"; then eval "`$SHELL ${ofile} --config | grep '^LTCFLAGS='`" fi # Extract list of available tagged configurations in $ofile. # Note that this assumes the entire list is on one line. available_tags=`grep "^available_tags=" "${ofile}" | $SED -e 's/available_tags=\(.*$\)/\1/' -e 's/\"//g'` lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," for tagname in $tagnames; do IFS="$lt_save_ifs" # Check whether tagname contains only valid characters case `$echo "X$tagname" | $Xsed -e 's:[-_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890,/]::g'` in "") ;; *) { { echo "$as_me:$LINENO: error: invalid tag name: $tagname" >&5 echo "$as_me: error: invalid tag name: $tagname" >&2;} { (exit 1); exit 1; }; } ;; esac if grep "^# ### BEGIN LIBTOOL TAG CONFIG: $tagname$" < "${ofile}" > /dev/null then { { echo "$as_me:$LINENO: error: tag name \"$tagname\" already exists" >&5 echo "$as_me: error: tag name \"$tagname\" already exists" >&2;} { (exit 1); exit 1; }; } fi # Update the list of available tags. if test -n "$tagname"; then echo appending configuration tag \"$tagname\" to $ofile case $tagname in CXX) if test -n "$CXX" && ( test "X$CXX" != "Xno" && ( (test "X$CXX" = "Xg++" && `g++ -v >/dev/null 2>&1` ) || (test "X$CXX" != "Xg++"))) ; then ac_ext=cc ac_cpp='$CXXCPP $CPPFLAGS' ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_cxx_compiler_gnu archive_cmds_need_lc_CXX=no allow_undefined_flag_CXX= always_export_symbols_CXX=no archive_expsym_cmds_CXX= export_dynamic_flag_spec_CXX= hardcode_direct_CXX=no hardcode_libdir_flag_spec_CXX= hardcode_libdir_flag_spec_ld_CXX= hardcode_libdir_separator_CXX= hardcode_minus_L_CXX=no hardcode_shlibpath_var_CXX=unsupported hardcode_automatic_CXX=no module_cmds_CXX= module_expsym_cmds_CXX= link_all_deplibs_CXX=unknown old_archive_cmds_CXX=$old_archive_cmds no_undefined_flag_CXX= whole_archive_flag_spec_CXX= enable_shared_with_static_runtimes_CXX=no # Dependencies to place before and after the object being linked: predep_objects_CXX= postdep_objects_CXX= predeps_CXX= postdeps_CXX= compiler_lib_search_path_CXX= # Source file extension for C++ test sources. ac_ext=cpp # Object file extension for compiled C++ test sources. objext=o objext_CXX=$objext # Code to be used in simple compile tests lt_simple_compile_test_code="int some_variable = 0;\n" # Code to be used in simple link tests lt_simple_link_test_code='int main(int, char *[]) { return(0); }\n' # ltmain only uses $CC for tagged configurations so make sure $CC is set. # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # save warnings/boilerplate of simple test code ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" >conftest.$ac_ext eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_compiler_boilerplate=`cat conftest.err` $rm conftest* ac_outfile=conftest.$ac_objext printf "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` $rm conftest* # Allow CC to be a program name with arguments. lt_save_CC=$CC lt_save_LD=$LD lt_save_GCC=$GCC GCC=$GXX lt_save_with_gnu_ld=$with_gnu_ld lt_save_path_LD=$lt_cv_path_LD if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx else $as_unset lt_cv_prog_gnu_ld fi if test -n "${lt_cv_path_LDCXX+set}"; then lt_cv_path_LD=$lt_cv_path_LDCXX else $as_unset lt_cv_path_LD fi test -z "${LDCXX+set}" || LD=$LDCXX CC=${CXX-"c++"} compiler=$CC compiler_CXX=$CC for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` # We don't want -fno-exception wen compiling C++ code, so set the # no_builtin_flag separately if test "$GXX" = yes; then lt_prog_compiler_no_builtin_flag_CXX=' -fno-builtin' else lt_prog_compiler_no_builtin_flag_CXX= fi if test "$GXX" = yes; then # Set up default GNU C++ configuration # Check whether --with-gnu-ld or --without-gnu-ld was given. if test "${with_gnu_ld+set}" = set; then withval="$with_gnu_ld" test "$withval" = no || with_gnu_ld=yes else with_gnu_ld=no fi; ac_prog=ld if test "$GCC" = yes; then # Check if gcc -print-prog-name=ld gives a path. echo "$as_me:$LINENO: checking for ld used by $CC" >&5 echo $ECHO_N "checking for ld used by $CC... $ECHO_C" >&6 case $host in *-*-mingw*) # gcc leaves a trailing carriage return which upsets mingw ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; *) ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; esac case $ac_prog in # Accept absolute paths. [\\/]* | ?:[\\/]*) re_direlt='/[^/][^/]*/\.\./' # Canonicalize the pathname of ld ac_prog=`echo $ac_prog| $SED 's%\\\\%/%g'` while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do ac_prog=`echo $ac_prog| $SED "s%$re_direlt%/%"` done test -z "$LD" && LD="$ac_prog" ;; "") # If it fails, then pretend we aren't using GCC. ac_prog=ld ;; *) # If it is relative, then search for the first ld in PATH. with_gnu_ld=unknown ;; esac elif test "$with_gnu_ld" = yes; then echo "$as_me:$LINENO: checking for GNU ld" >&5 echo $ECHO_N "checking for GNU ld... $ECHO_C" >&6 else echo "$as_me:$LINENO: checking for non-GNU ld" >&5 echo $ECHO_N "checking for non-GNU ld... $ECHO_C" >&6 fi if test "${lt_cv_path_LD+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -z "$LD"; then lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR for ac_dir in $PATH; do IFS="$lt_save_ifs" test -z "$ac_dir" && ac_dir=. if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then lt_cv_path_LD="$ac_dir/$ac_prog" # Check to see if the program is GNU ld. I'd rather use --version, # but apparently some variants of GNU ld only accept -v. # Break only if it was the GNU/non-GNU ld that we prefer. case `"$lt_cv_path_LD" -v 2>&1 &5 echo "${ECHO_T}$LD" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -z "$LD" && { { echo "$as_me:$LINENO: error: no acceptable ld found in \$PATH" >&5 echo "$as_me: error: no acceptable ld found in \$PATH" >&2;} { (exit 1); exit 1; }; } echo "$as_me:$LINENO: checking if the linker ($LD) is GNU ld" >&5 echo $ECHO_N "checking if the linker ($LD) is GNU ld... $ECHO_C" >&6 if test "${lt_cv_prog_gnu_ld+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # I'd rather use --version here, but apparently some GNU lds only accept -v. case `$LD -v 2>&1 &5 echo "${ECHO_T}$lt_cv_prog_gnu_ld" >&6 with_gnu_ld=$lt_cv_prog_gnu_ld # Check if GNU C++ uses GNU ld as the underlying linker, since the # archiving commands below assume that GNU ld is being used. if test "$with_gnu_ld" = yes; then archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' hardcode_libdir_flag_spec_CXX='${wl}--rpath ${wl}$libdir' export_dynamic_flag_spec_CXX='${wl}--export-dynamic' # If archive_cmds runs LD, not CC, wlarc should be empty # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to # investigate it a little bit more. (MM) wlarc='${wl}' # ancient GNU ld didn't support --whole-archive et. al. if eval "`$CC -print-prog-name=ld` --help 2>&1" | \ grep 'no-whole-archive' > /dev/null; then whole_archive_flag_spec_CXX="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' else whole_archive_flag_spec_CXX= fi else with_gnu_ld=no wlarc= # A generic and very simple default shared library creation # command for GNU C++ for the case where it uses the native # linker, instead of GNU ld. If possible, this setting should # overridden to take advantage of the native linker features on # the platform it is being used on. archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' fi # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "\-L"' else GXX=no with_gnu_ld=no wlarc= fi # PORTME: fill in a description of your system's C++ link characteristics echo "$as_me:$LINENO: checking whether the $compiler linker ($LD) supports shared libraries" >&5 echo $ECHO_N "checking whether the $compiler linker ($LD) supports shared libraries... $ECHO_C" >&6 ld_shlibs_CXX=yes case $host_os in aix3*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; aix4* | aix5*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. aix_use_runtimelinking=no exp_sym_flag='-Bexport' no_entry_flag="" else aix_use_runtimelinking=no # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. case $host_os in aix4.[23]|aix4.[23].*|aix5*) for ld_flag in $LDFLAGS; do case $ld_flag in *-brtl*) aix_use_runtimelinking=yes break ;; esac done ;; esac exp_sym_flag='-bexport' no_entry_flag='-bnoentry' fi # When large executables or shared objects are built, AIX ld can # have problems creating the table of contents. If linking a library # or program results in "error TOC overflow" add -mminimal-toc to # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. archive_cmds_CXX='' hardcode_direct_CXX=yes hardcode_libdir_separator_CXX=':' link_all_deplibs_CXX=yes if test "$GXX" = yes; then case $host_os in aix4.[012]|aix4.[012].*) # We only want to do this on AIX 4.2 and lower, the check # below for broken collect2 doesn't work under 4.3+ collect2name=`${CC} -print-prog-name=collect2` if test -f "$collect2name" && \ strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 hardcode_direct_CXX=yes else # We have old collect2 hardcode_direct_CXX=unsupported # It fails to find uninstalled libraries when the uninstalled # path is not listed in the libpath. Setting hardcode_minus_L # to unsupported forces relinking hardcode_minus_L_CXX=yes hardcode_libdir_flag_spec_CXX='-L$libdir' hardcode_libdir_separator_CXX= fi ;; esac shared_flag='-shared' if test "$aix_use_runtimelinking" = yes; then shared_flag="$shared_flag "'${wl}-G' fi else # not using gcc if test "$host_cpu" = ia64; then # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release # chokes on -Wl,-G. The following line is correct: shared_flag='-G' else if test "$aix_use_runtimelinking" = yes; then shared_flag='${wl}-G' else shared_flag='${wl}-bM:SRE' fi fi fi # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols_CXX=yes if test "$aix_use_runtimelinking" = yes; then # Warning - without using the other runtime loading flags (-brtl), # -berok will link without error, but may produce a broken library. allow_undefined_flag_CXX='-berok' # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_CXX='${wl}-blibpath:$libdir:'"$aix_libpath" archive_expsym_cmds_CXX="\$CC"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" else if test "$host_cpu" = ia64; then hardcode_libdir_flag_spec_CXX='${wl}-R $libdir:/usr/lib:/lib' allow_undefined_flag_CXX="-z nodefs" archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" else # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_cxx_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_CXX='${wl}-blibpath:$libdir:'"$aix_libpath" # Warning - without using the other run time loading flags, # -berok will link without error, but may produce a broken library. no_undefined_flag_CXX=' ${wl}-bernotok' allow_undefined_flag_CXX=' ${wl}-berok' # Exported symbols can be pulled into shared objects from archives whole_archive_flag_spec_CXX='$convenience' archive_cmds_need_lc_CXX=yes # This is similar to how AIX traditionally builds its shared libraries. archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' fi fi ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then allow_undefined_flag_CXX=unsupported # Joseph Beckenbach says some releases of gcc # support --undefined. This deserves some investigation. FIXME archive_cmds_CXX='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' else ld_shlibs_CXX=no fi ;; chorus*) case $cc_basename in *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac ;; cygwin* | mingw* | pw32*) # _LT_AC_TAGVAR(hardcode_libdir_flag_spec, CXX) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec_CXX='-L$libdir' allow_undefined_flag_CXX=unsupported always_export_symbols_CXX=no enable_shared_with_static_runtimes_CXX=yes if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' # If the export-symbols file already is a .def file (1st line # is EXPORTS), use it as is; otherwise, prepend... archive_expsym_cmds_CXX='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then cp $export_symbols $output_objdir/$soname.def; else echo EXPORTS > $output_objdir/$soname.def; cat $export_symbols >> $output_objdir/$soname.def; fi~ $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' else ld_shlibs_CXX=no fi ;; darwin* | rhapsody*) case $host_os in rhapsody* | darwin1.[012]) allow_undefined_flag_CXX='${wl}-undefined ${wl}suppress' ;; *) # Darwin 1.3 on if test -z ${MACOSX_DEPLOYMENT_TARGET} ; then allow_undefined_flag_CXX='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' else case ${MACOSX_DEPLOYMENT_TARGET} in 10.[012]) allow_undefined_flag_CXX='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; 10.*) allow_undefined_flag_CXX='${wl}-undefined ${wl}dynamic_lookup' ;; esac fi ;; esac archive_cmds_need_lc_CXX=no hardcode_direct_CXX=no hardcode_automatic_CXX=yes hardcode_shlibpath_var_CXX=unsupported whole_archive_flag_spec_CXX='' link_all_deplibs_CXX=yes if test "$GXX" = yes ; then lt_int_apple_cc_single_mod=no output_verbose_link_cmd='echo' if $CC -dumpspecs 2>&1 | $EGREP 'single_module' >/dev/null ; then lt_int_apple_cc_single_mod=yes fi if test "X$lt_int_apple_cc_single_mod" = Xyes ; then archive_cmds_CXX='$CC -dynamiclib -single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' else archive_cmds_CXX='$CC -r -keep_private_externs -nostdlib -o ${lib}-master.o $libobjs~$CC -dynamiclib $allow_undefined_flag -o $lib ${lib}-master.o $deplibs $compiler_flags -install_name $rpath/$soname $verstring' fi module_cmds_CXX='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds if test "X$lt_int_apple_cc_single_mod" = Xyes ; then archive_expsym_cmds_CXX='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib -single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' else archive_expsym_cmds_CXX='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -r -keep_private_externs -nostdlib -o ${lib}-master.o $libobjs~$CC -dynamiclib $allow_undefined_flag -o $lib ${lib}-master.o $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' fi module_expsym_cmds_CXX='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' else case $cc_basename in xlc*) output_verbose_link_cmd='echo' archive_cmds_CXX='$CC -qmkshrobj ${wl}-single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`echo $rpath/$soname` $verstring' module_cmds_CXX='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds_CXX='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj ${wl}-single_module $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds_CXX='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ;; *) ld_shlibs_CXX=no ;; esac fi ;; dgux*) case $cc_basename in ec++*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; ghcx*) # Green Hills C++ Compiler # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac ;; freebsd[12]*) # C++ shared libraries reported to be fairly broken before switch to ELF ld_shlibs_CXX=no ;; freebsd-elf*) archive_cmds_need_lc_CXX=no ;; freebsd* | kfreebsd*-gnu | dragonfly*) # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF # conventions ld_shlibs_CXX=yes ;; gnu*) ;; hpux9*) hardcode_libdir_flag_spec_CXX='${wl}+b ${wl}$libdir' hardcode_libdir_separator_CXX=: export_dynamic_flag_spec_CXX='${wl}-E' hardcode_direct_CXX=yes hardcode_minus_L_CXX=yes # Not in the search PATH, # but as the default # location of the library. case $cc_basename in CC*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; aCC*) archive_cmds_CXX='$rm $output_objdir/$soname~$CC -b ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | grep "[-]L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' ;; *) if test "$GXX" = yes; then archive_cmds_CXX='$rm $output_objdir/$soname~$CC -shared -nostdlib -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' else # FIXME: insert proper C++ library support ld_shlibs_CXX=no fi ;; esac ;; hpux10*|hpux11*) if test $with_gnu_ld = no; then hardcode_libdir_flag_spec_CXX='${wl}+b ${wl}$libdir' hardcode_libdir_separator_CXX=: case $host_cpu in hppa*64*|ia64*) hardcode_libdir_flag_spec_ld_CXX='+b $libdir' ;; *) export_dynamic_flag_spec_CXX='${wl}-E' ;; esac fi case $host_cpu in hppa*64*|ia64*) hardcode_direct_CXX=no hardcode_shlibpath_var_CXX=no ;; *) hardcode_direct_CXX=yes hardcode_minus_L_CXX=yes # Not in the search PATH, # but as the default # location of the library. ;; esac case $cc_basename in CC*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; aCC*) case $host_cpu in hppa*64*) archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; ia64*) archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; *) archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; esac # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | grep "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' ;; *) if test "$GXX" = yes; then if test $with_gnu_ld = no; then case $host_cpu in hppa*64*) archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; ia64*) archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; *) archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' ;; esac fi else # FIXME: insert proper C++ library support ld_shlibs_CXX=no fi ;; esac ;; interix3*) hardcode_direct_CXX=no hardcode_shlibpath_var_CXX=no hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir' export_dynamic_flag_spec_CXX='${wl}-E' # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. # Instead, shared libraries are loaded at an image base (0x10000000 by # default) and relocated if they conflict, which is a slow very memory # consuming and fragmenting process. To avoid this, we pick a random, # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link # time. Moving up from 0x10000000 also allows more sbrk(2) space. archive_cmds_CXX='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' archive_expsym_cmds_CXX='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; irix5* | irix6*) case $cc_basename in CC*) # SGI C++ archive_cmds_CXX='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' # Archives containing C++ object files must be created using # "CC -ar", where "CC" is the IRIX C++ compiler. This is # necessary to make sure instantiated templates are included # in the archive. old_archive_cmds_CXX='$CC -ar -WR,-u -o $oldlib $oldobjs' ;; *) if test "$GXX" = yes; then if test "$with_gnu_ld" = no; then archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` -o $lib' fi fi link_all_deplibs_CXX=yes ;; esac hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_CXX=: ;; linux*) case $cc_basename in KCC*) # Kuck and Associates, Inc. (KAI) C++ Compiler # KCC will only create a shared library if the output file # ends with ".so" (or ".sl" for HP-UX), so rename the library # to its proper name (with version) after linking. archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' archive_expsym_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib ${wl}-retain-symbols-file,$export_symbols; mv \$templib $lib' # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | grep "ld"`; rm -f libconftest$shared_ext; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' hardcode_libdir_flag_spec_CXX='${wl}--rpath,$libdir' export_dynamic_flag_spec_CXX='${wl}--export-dynamic' # Archives containing C++ object files must be created using # "CC -Bstatic", where "CC" is the KAI C++ compiler. old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' ;; icpc*) # Intel C++ with_gnu_ld=yes # version 8.0 and above of icpc choke on multiply defined symbols # if we add $predep_objects and $postdep_objects, however 7.1 and # earlier do not add the objects themselves. case `$CC -V 2>&1` in *"Version 7."*) archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' ;; *) # Version 8.0 or newer tmp_idyn= case $host_cpu in ia64*) tmp_idyn=' -i_dynamic';; esac archive_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' ;; esac archive_cmds_need_lc_CXX=no hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir' export_dynamic_flag_spec_CXX='${wl}--export-dynamic' whole_archive_flag_spec_CXX='${wl}--whole-archive$convenience ${wl}--no-whole-archive' ;; pgCC*) # Portland Group C++ compiler archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib' archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib' hardcode_libdir_flag_spec_CXX='${wl}--rpath ${wl}$libdir' export_dynamic_flag_spec_CXX='${wl}--export-dynamic' whole_archive_flag_spec_CXX='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' ;; cxx*) # Compaq C++ archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib ${wl}-retain-symbols-file $wl$export_symbols' runpath_var=LD_RUN_PATH hardcode_libdir_flag_spec_CXX='-rpath $libdir' hardcode_libdir_separator_CXX=: # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "ld"`; templist=`echo $templist | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' ;; esac ;; lynxos*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; m88k*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; mvs*) case $cc_basename in cxx*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds_CXX='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags' wlarc= hardcode_libdir_flag_spec_CXX='-R$libdir' hardcode_direct_CXX=yes hardcode_shlibpath_var_CXX=no fi # Workaround some broken pre-1.5 toolchains output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"' ;; openbsd2*) # C++ shared libraries are fairly broken ld_shlibs_CXX=no ;; openbsd*) hardcode_direct_CXX=yes hardcode_shlibpath_var_CXX=no archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir' if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file,$export_symbols -o $lib' export_dynamic_flag_spec_CXX='${wl}-E' whole_archive_flag_spec_CXX="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' fi output_verbose_link_cmd='echo' ;; osf3*) case $cc_basename in KCC*) # Kuck and Associates, Inc. (KAI) C++ Compiler # KCC will only create a shared library if the output file # ends with ".so" (or ".sl" for HP-UX), so rename the library # to its proper name (with version) after linking. archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir' hardcode_libdir_separator_CXX=: # Archives containing C++ object files must be created using # "CC -Bstatic", where "CC" is the KAI C++ compiler. old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' ;; RCC*) # Rational C++ 2.4.1 # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; cxx*) allow_undefined_flag_CXX=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_CXX='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $soname `test -n "$verstring" && echo ${wl}-set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_CXX=: # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "ld" | grep -v "ld:"`; templist=`echo $templist | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' ;; *) if test "$GXX" = yes && test "$with_gnu_ld" = no; then allow_undefined_flag_CXX=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_CXX='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_CXX=: # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "\-L"' else # FIXME: insert proper C++ library support ld_shlibs_CXX=no fi ;; esac ;; osf4* | osf5*) case $cc_basename in KCC*) # Kuck and Associates, Inc. (KAI) C++ Compiler # KCC will only create a shared library if the output file # ends with ".so" (or ".sl" for HP-UX), so rename the library # to its proper name (with version) after linking. archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir' hardcode_libdir_separator_CXX=: # Archives containing C++ object files must be created using # the KAI C++ compiler. old_archive_cmds_CXX='$CC -o $oldlib $oldobjs' ;; RCC*) # Rational C++ 2.4.1 # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; cxx*) allow_undefined_flag_CXX=' -expect_unresolved \*' archive_cmds_CXX='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' archive_expsym_cmds_CXX='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~ echo "-hidden">> $lib.exp~ $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname -Wl,-input -Wl,$lib.exp `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib~ $rm $lib.exp' hardcode_libdir_flag_spec_CXX='-rpath $libdir' hardcode_libdir_separator_CXX=: # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. # # There doesn't appear to be a way to prevent this compiler from # explicitly linking system object files so we need to strip them # from the output so that they don't get included in the library # dependencies. output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "ld" | grep -v "ld:"`; templist=`echo $templist | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; echo $list' ;; *) if test "$GXX" = yes && test "$with_gnu_ld" = no; then allow_undefined_flag_CXX=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_CXX='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_CXX=: # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep "\-L"' else # FIXME: insert proper C++ library support ld_shlibs_CXX=no fi ;; esac ;; psos*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; sunos4*) case $cc_basename in CC*) # Sun C++ 4.x # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; lcc*) # Lucid # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac ;; solaris*) case $cc_basename in CC*) # Sun C++ 4.2, 5.x and Centerline C++ archive_cmds_need_lc_CXX=yes no_undefined_flag_CXX=' -zdefs' archive_cmds_CXX='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' archive_expsym_cmds_CXX='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -G${allow_undefined_flag} ${wl}-M ${wl}$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$rm $lib.exp' hardcode_libdir_flag_spec_CXX='-R$libdir' hardcode_shlibpath_var_CXX=no case $host_os in solaris2.[0-5] | solaris2.[0-5].*) ;; *) # The C++ compiler is used as linker so we must use $wl # flag to pass the commands to the underlying system # linker. We must also pass each convience library through # to the system linker between allextract/defaultextract. # The C++ compiler will combine linker options so we # cannot just pass the convience library names through # without $wl. # Supported since Solaris 2.6 (maybe 2.5.1?) whole_archive_flag_spec_CXX='${wl}-z ${wl}allextract`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}-z ${wl}defaultextract' ;; esac link_all_deplibs_CXX=yes output_verbose_link_cmd='echo' # Archives containing C++ object files must be created using # "CC -xar", where "CC" is the Sun C++ compiler. This is # necessary to make sure instantiated templates are included # in the archive. old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs' ;; gcx*) # Green Hills C++ Compiler archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib' # The C++ compiler must be used to create the archive. old_archive_cmds_CXX='$CC $LDFLAGS -archive -o $oldlib $oldobjs' ;; *) # GNU C++ compiler with Solaris linker if test "$GXX" = yes && test "$with_gnu_ld" = no; then no_undefined_flag_CXX=' ${wl}-z ${wl}defs' if $CC --version | grep -v '^2\.7' > /dev/null; then archive_cmds_CXX='$CC -shared -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib' archive_expsym_cmds_CXX='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -shared -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$rm $lib.exp' # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. output_verbose_link_cmd="$CC -shared $CFLAGS -v conftest.$objext 2>&1 | grep \"\-L\"" else # g++ 2.7 appears to require `-G' NOT `-shared' on this # platform. archive_cmds_CXX='$CC -G -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib' archive_expsym_cmds_CXX='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -G -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$rm $lib.exp' # Commands to make compiler produce verbose output that lists # what "hidden" libraries, object files and flags are used when # linking a shared library. output_verbose_link_cmd="$CC -G $CFLAGS -v conftest.$objext 2>&1 | grep \"\-L\"" fi hardcode_libdir_flag_spec_CXX='${wl}-R $wl$libdir' fi ;; esac ;; sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) no_undefined_flag_CXX='${wl}-z,text' archive_cmds_need_lc_CXX=no hardcode_shlibpath_var_CXX=no runpath_var='LD_RUN_PATH' case $cc_basename in CC*) archive_cmds_CXX='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_CXX='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_CXX='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_CXX='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' ;; esac ;; sysv5* | sco3.2v5* | sco5v6*) # Note: We can NOT use -z defs as we might desire, because we do not # link with -lc, and that would cause any symbols used from libc to # always be unresolved, which means just about no library would # ever link correctly. If we're not using GNU ld we use -z text # though, which does catch some bad symbols but isn't as heavy-handed # as -z defs. # For security reasons, it is highly recommended that you always # use absolute paths for naming shared libraries, and exclude the # DT_RUNPATH tag from executables and libraries. But doing so # requires that you compile everything twice, which is a pain. # So that behaviour is only enabled if SCOABSPATH is set to a # non-empty value in the environment. Most likely only useful for # creating official distributions of packages. # This is a hack until libtool officially supports absolute path # names for shared libraries. no_undefined_flag_CXX='${wl}-z,text' allow_undefined_flag_CXX='${wl}-z,nodefs' archive_cmds_need_lc_CXX=no hardcode_shlibpath_var_CXX=no hardcode_libdir_flag_spec_CXX='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' hardcode_libdir_separator_CXX=':' link_all_deplibs_CXX=yes export_dynamic_flag_spec_CXX='${wl}-Bexport' runpath_var='LD_RUN_PATH' case $cc_basename in CC*) archive_cmds_CXX='$CC -G ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_CXX='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_CXX='$CC -shared ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_CXX='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; esac ;; tandem*) case $cc_basename in NCC*) # NonStop-UX NCC 3.20 # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac ;; vxworks*) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; *) # FIXME: insert proper C++ library support ld_shlibs_CXX=no ;; esac echo "$as_me:$LINENO: result: $ld_shlibs_CXX" >&5 echo "${ECHO_T}$ld_shlibs_CXX" >&6 test "$ld_shlibs_CXX" = no && can_build_shared=no GCC_CXX="$GXX" LD_CXX="$LD" cat > conftest.$ac_ext <&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Parse the compiler output and extract the necessary # objects, libraries and library flags. # Sentinel used to keep track of whether or not we are before # the conftest object file. pre_test_object_deps_done=no # The `*' in the case matches for architectures that use `case' in # $output_verbose_cmd can trigger glob expansion during the loop # eval without this substitution. output_verbose_link_cmd=`$echo "X$output_verbose_link_cmd" | $Xsed -e "$no_glob_subst"` for p in `eval $output_verbose_link_cmd`; do case $p in -L* | -R* | -l*) # Some compilers place space between "-{L,R}" and the path. # Remove the space. if test $p = "-L" \ || test $p = "-R"; then prev=$p continue else prev= fi if test "$pre_test_object_deps_done" = no; then case $p in -L* | -R*) # Internal compiler library paths should come after those # provided the user. The postdeps already come after the # user supplied libs so there is no need to process them. if test -z "$compiler_lib_search_path_CXX"; then compiler_lib_search_path_CXX="${prev}${p}" else compiler_lib_search_path_CXX="${compiler_lib_search_path_CXX} ${prev}${p}" fi ;; # The "-l" case would never come before the object being # linked, so don't bother handling this case. esac else if test -z "$postdeps_CXX"; then postdeps_CXX="${prev}${p}" else postdeps_CXX="${postdeps_CXX} ${prev}${p}" fi fi ;; *.$objext) # This assumes that the test object file only shows up # once in the compiler output. if test "$p" = "conftest.$objext"; then pre_test_object_deps_done=yes continue fi if test "$pre_test_object_deps_done" = no; then if test -z "$predep_objects_CXX"; then predep_objects_CXX="$p" else predep_objects_CXX="$predep_objects_CXX $p" fi else if test -z "$postdep_objects_CXX"; then postdep_objects_CXX="$p" else postdep_objects_CXX="$postdep_objects_CXX $p" fi fi ;; *) ;; # Ignore the rest. esac done # Clean up. rm -f a.out a.exe else echo "libtool.m4: error: problem compiling CXX test program" fi $rm -f confest.$objext # PORTME: override above test on systems where it is broken case $host_os in interix3*) # Interix 3.5 installs completely hosed .la files for C++, so rather than # hack all around it, let's just trust "g++" to DTRT. predep_objects_CXX= postdep_objects_CXX= postdeps_CXX= ;; solaris*) case $cc_basename in CC*) # Adding this requires a known-good setup of shared libraries for # Sun compiler versions before 5.6, else PIC objects from an old # archive will be linked into the output, leading to subtle bugs. postdeps_CXX='-lCstd -lCrun' ;; esac ;; esac case " $postdeps_CXX " in *" -lc "*) archive_cmds_need_lc_CXX=no ;; esac lt_prog_compiler_wl_CXX= lt_prog_compiler_pic_CXX= lt_prog_compiler_static_CXX= echo "$as_me:$LINENO: checking for $compiler option to produce PIC" >&5 echo $ECHO_N "checking for $compiler option to produce PIC... $ECHO_C" >&6 # C++ specific cases for pic, static, wl, etc. if test "$GXX" = yes; then lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_static_CXX='-static' case $host_os in aix*) # All AIX code is PIC. if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_CXX='-Bstatic' fi ;; amigaos*) # FIXME: we need at least 68020 code to build shared libraries, but # adding the `-m68020' flag to GCC prevents building anything better, # like `-m68040'. lt_prog_compiler_pic_CXX='-m68020 -resident32 -malways-restore-a4' ;; beos* | cygwin* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; mingw* | os2* | pw32*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_CXX='-DDLL_EXPORT' ;; darwin* | rhapsody*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files lt_prog_compiler_pic_CXX='-fno-common' ;; *djgpp*) # DJGPP does not support shared libraries at all lt_prog_compiler_pic_CXX= ;; interix3*) # Interix 3.x gcc -fpic/-fPIC options generate broken code. # Instead, we relocate shared libraries at runtime. ;; sysv4*MP*) if test -d /usr/nec; then lt_prog_compiler_pic_CXX=-Kconform_pic fi ;; hpux*) # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) ;; *) lt_prog_compiler_pic_CXX='-fPIC' ;; esac ;; *) lt_prog_compiler_pic_CXX='-fPIC' ;; esac else case $host_os in aix4* | aix5*) # All AIX code is PIC. if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_CXX='-Bstatic' else lt_prog_compiler_static_CXX='-bnso -bI:/lib/syscalls.exp' fi ;; chorus*) case $cc_basename in cxch68*) # Green Hills C++ Compiler # _LT_AC_TAGVAR(lt_prog_compiler_static, CXX)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a" ;; esac ;; darwin*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files case $cc_basename in xlc*) lt_prog_compiler_pic_CXX='-qnocommon' lt_prog_compiler_wl_CXX='-Wl,' ;; esac ;; dgux*) case $cc_basename in ec++*) lt_prog_compiler_pic_CXX='-KPIC' ;; ghcx*) # Green Hills C++ Compiler lt_prog_compiler_pic_CXX='-pic' ;; *) ;; esac ;; freebsd* | kfreebsd*-gnu | dragonfly*) # FreeBSD uses GNU C++ ;; hpux9* | hpux10* | hpux11*) case $cc_basename in CC*) lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_static_CXX='${wl}-a ${wl}archive' if test "$host_cpu" != ia64; then lt_prog_compiler_pic_CXX='+Z' fi ;; aCC*) lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_static_CXX='${wl}-a ${wl}archive' case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic_CXX='+Z' ;; esac ;; *) ;; esac ;; interix*) # This is c89, which is MS Visual C++ (no shared libs) # Anyone wants to do a port? ;; irix5* | irix6* | nonstopux*) case $cc_basename in CC*) lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_static_CXX='-non_shared' # CC pic flag -KPIC is the default. ;; *) ;; esac ;; linux*) case $cc_basename in KCC*) # KAI C++ Compiler lt_prog_compiler_wl_CXX='--backend -Wl,' lt_prog_compiler_pic_CXX='-fPIC' ;; icpc* | ecpc*) # Intel C++ lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_pic_CXX='-KPIC' lt_prog_compiler_static_CXX='-static' ;; pgCC*) # Portland Group C++ compiler. lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_pic_CXX='-fpic' lt_prog_compiler_static_CXX='-Bstatic' ;; cxx*) # Compaq C++ # Make sure the PIC flag is empty. It appears that all Alpha # Linux and Compaq Tru64 Unix objects are PIC. lt_prog_compiler_pic_CXX= lt_prog_compiler_static_CXX='-non_shared' ;; *) ;; esac ;; lynxos*) ;; m88k*) ;; mvs*) case $cc_basename in cxx*) lt_prog_compiler_pic_CXX='-W c,exportall' ;; *) ;; esac ;; netbsd*) ;; osf3* | osf4* | osf5*) case $cc_basename in KCC*) lt_prog_compiler_wl_CXX='--backend -Wl,' ;; RCC*) # Rational C++ 2.4.1 lt_prog_compiler_pic_CXX='-pic' ;; cxx*) # Digital/Compaq C++ lt_prog_compiler_wl_CXX='-Wl,' # Make sure the PIC flag is empty. It appears that all Alpha # Linux and Compaq Tru64 Unix objects are PIC. lt_prog_compiler_pic_CXX= lt_prog_compiler_static_CXX='-non_shared' ;; *) ;; esac ;; psos*) ;; solaris*) case $cc_basename in CC*) # Sun C++ 4.2, 5.x and Centerline C++ lt_prog_compiler_pic_CXX='-KPIC' lt_prog_compiler_static_CXX='-Bstatic' lt_prog_compiler_wl_CXX='-Qoption ld ' ;; gcx*) # Green Hills C++ Compiler lt_prog_compiler_pic_CXX='-PIC' ;; *) ;; esac ;; sunos4*) case $cc_basename in CC*) # Sun C++ 4.x lt_prog_compiler_pic_CXX='-pic' lt_prog_compiler_static_CXX='-Bstatic' ;; lcc*) # Lucid lt_prog_compiler_pic_CXX='-pic' ;; *) ;; esac ;; tandem*) case $cc_basename in NCC*) # NonStop-UX NCC 3.20 lt_prog_compiler_pic_CXX='-KPIC' ;; *) ;; esac ;; sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) case $cc_basename in CC*) lt_prog_compiler_wl_CXX='-Wl,' lt_prog_compiler_pic_CXX='-KPIC' lt_prog_compiler_static_CXX='-Bstatic' ;; esac ;; vxworks*) ;; *) lt_prog_compiler_can_build_shared_CXX=no ;; esac fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_CXX" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_CXX" >&6 # # Check to make sure the PIC flag actually works. # if test -n "$lt_prog_compiler_pic_CXX"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works... $ECHO_C" >&6 if test "${lt_prog_compiler_pic_works_CXX+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_pic_works_CXX=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic_CXX -DPIC" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:18962: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:18966: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_pic_works_CXX=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works_CXX" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_works_CXX" >&6 if test x"$lt_prog_compiler_pic_works_CXX" = xyes; then case $lt_prog_compiler_pic_CXX in "" | " "*) ;; *) lt_prog_compiler_pic_CXX=" $lt_prog_compiler_pic_CXX" ;; esac else lt_prog_compiler_pic_CXX= lt_prog_compiler_can_build_shared_CXX=no fi fi case $host_os in # For platforms which do not support PIC, -DPIC is meaningless: *djgpp*) lt_prog_compiler_pic_CXX= ;; *) lt_prog_compiler_pic_CXX="$lt_prog_compiler_pic_CXX -DPIC" ;; esac # # Check to make sure the static flag actually works. # wl=$lt_prog_compiler_wl_CXX eval lt_tmp_static_flag=\"$lt_prog_compiler_static_CXX\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 if test "${lt_prog_compiler_static_works_CXX+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_static_works_CXX=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" printf "$lt_simple_link_test_code" > conftest.$ac_ext if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then # The linker can only warn and ignore the option if not recognized # So say no if there are warnings if test -s conftest.err; then # Append any errors to the config.log. cat conftest.err 1>&5 $echo "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_static_works_CXX=yes fi else lt_prog_compiler_static_works_CXX=yes fi fi $rm conftest* LDFLAGS="$save_LDFLAGS" fi echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works_CXX" >&5 echo "${ECHO_T}$lt_prog_compiler_static_works_CXX" >&6 if test x"$lt_prog_compiler_static_works_CXX" = xyes; then : else lt_prog_compiler_static_CXX= fi echo "$as_me:$LINENO: checking if $compiler supports -c -o file.$ac_objext" >&5 echo $ECHO_N "checking if $compiler supports -c -o file.$ac_objext... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_c_o_CXX+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_c_o_CXX=no $rm -r conftest 2>/dev/null mkdir conftest cd conftest mkdir out printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-o out/conftest2.$ac_objext" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:19066: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 echo "$as_me:19070: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' > out/conftest.exp $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then lt_cv_prog_compiler_c_o_CXX=yes fi fi chmod u+w . 2>&5 $rm conftest* # SGI C++ compiler will create directory out/ii_files/ for # template instantiation test -d out/ii_files && $rm out/ii_files/* && rmdir out/ii_files $rm out/* && rmdir out cd .. rmdir conftest $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_c_o_CXX" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_c_o_CXX" >&6 hard_links="nottested" if test "$lt_cv_prog_compiler_c_o_CXX" = no && test "$need_locks" != no; then # do not overwrite the value of need_locks provided by the user echo "$as_me:$LINENO: checking if we can lock with hard links" >&5 echo $ECHO_N "checking if we can lock with hard links... $ECHO_C" >&6 hard_links=yes $rm conftest* ln conftest.a conftest.b 2>/dev/null && hard_links=no touch conftest.a ln conftest.a conftest.b 2>&5 || hard_links=no ln conftest.a conftest.b 2>/dev/null && hard_links=no echo "$as_me:$LINENO: result: $hard_links" >&5 echo "${ECHO_T}$hard_links" >&6 if test "$hard_links" = no; then { echo "$as_me:$LINENO: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} need_locks=warn fi else need_locks=no fi echo "$as_me:$LINENO: checking whether the $compiler linker ($LD) supports shared libraries" >&5 echo $ECHO_N "checking whether the $compiler linker ($LD) supports shared libraries... $ECHO_C" >&6 export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' case $host_os in aix4* | aix5*) # If we're using GNU nm, then we don't want the "-C" option. # -C means demangle to AIX nm, but means don't demangle with GNU nm if $NM -V 2>&1 | grep 'GNU' > /dev/null; then export_symbols_cmds_CXX='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' else export_symbols_cmds_CXX='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' fi ;; pw32*) export_symbols_cmds_CXX="$ltdll_cmds" ;; cygwin* | mingw*) export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS] /s/.* \([^ ]*\)/\1 DATA/;/^.* __nm__/s/^.* __nm__\([^ ]*\) [^ ]*/\1 DATA/;/^I /d;/^[AITW] /s/.* //'\'' | sort | uniq > $export_symbols' ;; *) export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' ;; esac echo "$as_me:$LINENO: result: $ld_shlibs_CXX" >&5 echo "${ECHO_T}$ld_shlibs_CXX" >&6 test "$ld_shlibs_CXX" = no && can_build_shared=no # # Do we need to explicitly link libc? # case "x$archive_cmds_need_lc_CXX" in x|xyes) # Assume -lc should be added archive_cmds_need_lc_CXX=yes if test "$enable_shared" = yes && test "$GCC" = yes; then case $archive_cmds_CXX in *'~'*) # FIXME: we may have to deal with multi-command sequences. ;; '$CC '*) # Test whether the compiler implicitly links with -lc since on some # systems, -lgcc has to come before -lc. If gcc already passes -lc # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 $rm conftest* printf "$lt_simple_compile_test_code" > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then soname=conftest lib=conftest libobjs=conftest.$ac_objext deplibs= wl=$lt_prog_compiler_wl_CXX pic_flag=$lt_prog_compiler_pic_CXX compiler_flags=-v linker_flags=-v verstring= output_objdir=. libname=conftest lt_save_allow_undefined_flag=$allow_undefined_flag_CXX allow_undefined_flag_CXX= if { (eval echo "$as_me:$LINENO: \"$archive_cmds_CXX 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds_CXX 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } then archive_cmds_need_lc_CXX=no else archive_cmds_need_lc_CXX=yes fi allow_undefined_flag_CXX=$lt_save_allow_undefined_flag else cat conftest.err 1>&5 fi $rm conftest* echo "$as_me:$LINENO: result: $archive_cmds_need_lc_CXX" >&5 echo "${ECHO_T}$archive_cmds_need_lc_CXX" >&6 ;; esac fi ;; esac echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 library_names_spec= libname_spec='lib$name' soname_spec= shrext_cmds=".so" postinstall_cmds= postuninstall_cmds= finish_cmds= finish_eval= shlibpath_var= shlibpath_overrides_runpath=unknown version_type=none dynamic_linker="$host_os ld.so" sys_lib_dlsearch_path_spec="/lib /usr/lib" if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';' >/dev/null ; then # if the path contains ";" then we assume it to be the separator # otherwise default to the standard path separator (i.e. ":") - it is # assumed that no part of a normal pathname contains ";" but that should # okay in the real world where ";" in dirpaths is itself problematic. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi else sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" fi need_lib_prefix=unknown hardcode_into_libs=no # when you set need_version to no, make sure it does not cause -set_version # flags to be left without arguments need_version=unknown case $host_os in aix3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' shlibpath_var=LIBPATH # AIX 3 has no versioning support, so we append a major version to the name. soname_spec='${libname}${release}${shared_ext}$major' ;; aix4* | aix5*) version_type=linux need_lib_prefix=no need_version=no hardcode_into_libs=yes if test "$host_cpu" = ia64; then # AIX 5 supports IA64 library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH else # With GCC up to 2.95.x, collect2 would create an import file # for dependence libraries. The import file would start with # the line `#! .'. This would cause the generated library to # depend on `.', always an invalid library. This was fixed in # development snapshots of GCC prior to 3.0. case $host_os in aix4 | aix4.[01] | aix4.[01].*) if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' echo ' yes ' echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then : else can_build_shared=no fi ;; esac # AIX (on Power*) has no versioning support, so currently we can not hardcode correct # soname into executable. Probably we can add versioning support to # collect2, so additional links can be useful in future. if test "$aix_use_runtimelinking" = yes; then # If using run time linking (on AIX 4.2 or later) use lib.so # instead of lib.a to let people know that these are not # typical AIX shared libraries. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' else # We preserve .a as extension for shared libraries through AIX4.2 # and later when we are not doing run time linking. library_names_spec='${libname}${release}.a $libname.a' soname_spec='${libname}${release}${shared_ext}$major' fi shlibpath_var=LIBPATH fi ;; amigaos*) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ;; beos*) library_names_spec='${libname}${shared_ext}' dynamic_linker="$host_os ld.so" shlibpath_var=LIBRARY_PATH ;; bsdi[45]*) version_type=linux need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" # the default ld.so.conf also contains /usr/contrib/lib and # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow # libtool to hard-code these into programs ;; cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no case $GCC,$host_os in yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i;echo \$dlname'\''`~ dldir=$destdir/`dirname \$dlpath`~ test -d \$dldir || mkdir -p \$dldir~ $install_prog $dir/$dlname \$dldir/$dlname~ chmod a+x \$dldir/$dlname' postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ dlpath=$dir/\$dldll~ $rm \$dlpath' shlibpath_overrides_runpath=yes case $host_os in cygwin*) # Cygwin DLLs use 'cyg' prefix rather than 'lib' soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';[c-zC-Z]:/' >/dev/null; then # It is most probably a Windows format PATH printed by # mingw gcc, but we are running on Cygwin. Gcc prints its search # path with ; separators, and with drive letters. We can handle the # drive letters (cygwin fileutils understands them), so leave them, # especially as we might pass files found there to a mingw objdump, # which wouldn't understand a cygwinified path. Ahh. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi ;; pw32*) # pw32 DLLs use 'pw' prefix rather than 'lib' library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' ;; esac ;; *) library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' ;; esac dynamic_linker='Win32 ld.exe' # FIXME: first we should search . and the directory the executable is in shlibpath_var=PATH ;; darwin* | rhapsody*) dynamic_linker="$host_os dyld" version_type=darwin need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${versuffix}$shared_ext ${libname}${release}${major}$shared_ext ${libname}$shared_ext' soname_spec='${libname}${release}${major}$shared_ext' shlibpath_overrides_runpath=yes shlibpath_var=DYLD_LIBRARY_PATH shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' # Apple's gcc prints 'gcc -print-search-dirs' doesn't operate the same. if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | tr "\n" "$PATH_SEPARATOR" | sed -e 's/libraries:/@libraries:/' | tr "@" "\n" | grep "^libraries:" | sed -e "s/^libraries://" -e "s,=/,/,g" -e "s,$PATH_SEPARATOR, ,g" -e "s,.*,& /lib /usr/lib /usr/local/lib,g"` else sys_lib_search_path_spec='/lib /usr/lib /usr/local/lib' fi sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' ;; dgux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; freebsd1*) dynamic_linker=no ;; kfreebsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; freebsd* | dragonfly*) # DragonFly does not have aout. When/if they implement a new # versioning mechanism, adjust this. if test -x /usr/bin/objformat; then objformat=`/usr/bin/objformat` else case $host_os in freebsd[123]*) objformat=aout ;; *) objformat=elf ;; esac fi version_type=freebsd-$objformat case $version_type in freebsd-elf*) library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' need_version=no need_lib_prefix=no ;; freebsd-*) library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' need_version=yes ;; esac shlibpath_var=LD_LIBRARY_PATH case $host_os in freebsd2*) shlibpath_overrides_runpath=yes ;; freebsd3.[01]* | freebsdelf3.[01]*) shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; freebsd*) # from 4.6 on shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; esac ;; gnu*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes ;; hpux9* | hpux10* | hpux11*) # Give a soname corresponding to the major version so that dld.sl refuses to # link against other versions. version_type=sunos need_lib_prefix=no need_version=no case $host_cpu in ia64*) shrext_cmds='.so' hardcode_into_libs=yes dynamic_linker="$host_os dld.so" shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' if test "X$HPUX_IA64_MODE" = X32; then sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" else sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" fi sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; hppa*64*) shrext_cmds='.sl' hardcode_into_libs=yes dynamic_linker="$host_os dld.sl" shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; *) shrext_cmds='.sl' dynamic_linker="$host_os dld.sl" shlibpath_var=SHLIB_PATH shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' ;; esac # HP-UX runs *really* slowly unless shared libraries are mode 555. postinstall_cmds='chmod 555 $lib' ;; interix3*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; irix5* | irix6* | nonstopux*) case $host_os in nonstopux*) version_type=nonstopux ;; *) if test "$lt_cv_prog_gnu_ld" = yes; then version_type=linux else version_type=irix fi ;; esac need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' case $host_os in irix5* | nonstopux*) libsuff= shlibsuff= ;; *) case $LD in # libtool.m4 will add one of these switches to LD *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= libmagic=32-bit;; *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 libmagic=N32;; *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 libmagic=64-bit;; *) libsuff= shlibsuff= libmagic=never-match;; esac ;; esac shlibpath_var=LD_LIBRARY${shlibsuff}_PATH shlibpath_overrides_runpath=no sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" hardcode_into_libs=yes ;; # No shared lib support for Linux oldld, aout, or coff. linux*oldld* | linux*aout* | linux*coff*) dynamic_linker=no ;; # This must be Linux ELF. linux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install # before this can be enabled. hardcode_into_libs=yes # find out which ABI we are using libsuff= case "$host_cpu" in x86_64*|s390x*|powerpc64*) echo '#line 19602 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.$ac_objext` in *64-bit*) libsuff=64 sys_lib_search_path_spec="/lib${libsuff} /usr/lib${libsuff} /usr/local/lib${libsuff}" ;; esac fi rm -rf conftest* ;; esac # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib${libsuff} /usr/lib${libsuff} $lt_ld_extra" fi # We used to test for /lib/ld.so.1 and disable shared libraries on # powerpc, because MkLinux only supported shared libraries with the # GNU dynamic linker. Since this was broken with cross compilers, # most powerpc-linux boxes support dynamic linking these days and # people can always --disable-shared, the test was removed, and we # assume the GNU/Linux dynamic linker is in use. dynamic_linker='GNU/Linux ld.so' ;; knetbsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; netbsd*) version_type=sunos need_lib_prefix=no need_version=no if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' dynamic_linker='NetBSD (a.out) ld.so' else library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='NetBSD ld.elf_so' fi shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; newsos6) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; nto-qnx*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; openbsd*) version_type=sunos sys_lib_dlsearch_path_spec="/usr/lib" need_lib_prefix=no # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. case $host_os in openbsd3.3 | openbsd3.3.*) need_version=yes ;; *) need_version=no ;; esac library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' shlibpath_var=LD_LIBRARY_PATH if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then case $host_os in openbsd2.[89] | openbsd2.[89].*) shlibpath_overrides_runpath=no ;; *) shlibpath_overrides_runpath=yes ;; esac else shlibpath_overrides_runpath=yes fi ;; os2*) libname_spec='$name' shrext_cmds=".dll" need_lib_prefix=no library_names_spec='$libname${shared_ext} $libname.a' dynamic_linker='OS/2 ld.exe' shlibpath_var=LIBPATH ;; osf3* | osf4* | osf5*) version_type=osf need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" ;; solaris*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes # ldd complains unless libraries are executable postinstall_cmds='chmod +x $lib' ;; sunos4*) version_type=sunos library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes if test "$with_gnu_ld" = yes; then need_lib_prefix=no fi need_version=yes ;; sysv4 | sysv4.3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH case $host_vendor in sni) shlibpath_overrides_runpath=no need_lib_prefix=no export_dynamic_flag_spec='${wl}-Blargedynsym' runpath_var=LD_RUN_PATH ;; siemens) need_lib_prefix=no ;; motorola) need_lib_prefix=no need_version=no shlibpath_overrides_runpath=no sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' ;; esac ;; sysv4*MP*) if test -d /usr/nec ;then version_type=linux library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' soname_spec='$libname${shared_ext}.$major' shlibpath_var=LD_LIBRARY_PATH fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) version_type=freebsd-elf need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes if test "$with_gnu_ld" = yes; then sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' shlibpath_overrides_runpath=no else sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' shlibpath_overrides_runpath=yes case $host_os in sco3.2v5*) sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" ;; esac fi sys_lib_dlsearch_path_spec='/usr/lib' ;; uts4*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; *) dynamic_linker=no ;; esac echo "$as_me:$LINENO: result: $dynamic_linker" >&5 echo "${ECHO_T}$dynamic_linker" >&6 test "$dynamic_linker" = no && can_build_shared=no variables_saved_for_relink="PATH $shlibpath_var $runpath_var" if test "$GCC" = yes; then variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi echo "$as_me:$LINENO: checking how to hardcode library paths into programs" >&5 echo $ECHO_N "checking how to hardcode library paths into programs... $ECHO_C" >&6 hardcode_action_CXX= if test -n "$hardcode_libdir_flag_spec_CXX" || \ test -n "$runpath_var_CXX" || \ test "X$hardcode_automatic_CXX" = "Xyes" ; then # We can hardcode non-existant directories. if test "$hardcode_direct_CXX" != no && # If the only mechanism to avoid hardcoding is shlibpath_var, we # have to relink, otherwise we might link with an installed library # when we should be linking with a yet-to-be-installed one ## test "$_LT_AC_TAGVAR(hardcode_shlibpath_var, CXX)" != no && test "$hardcode_minus_L_CXX" != no; then # Linking always hardcodes the temporary library directory. hardcode_action_CXX=relink else # We can link without hardcoding, and we can hardcode nonexisting dirs. hardcode_action_CXX=immediate fi else # We cannot hardcode anything, or else we can only hardcode existing # directories. hardcode_action_CXX=unsupported fi echo "$as_me:$LINENO: result: $hardcode_action_CXX" >&5 echo "${ECHO_T}$hardcode_action_CXX" >&6 if test "$hardcode_action_CXX" = relink; then # Fast installation is not supported enable_fast_install=no elif test "$shlibpath_overrides_runpath" = yes || test "$enable_shared" = no; then # Fast installation is not necessary enable_fast_install=needless fi # The else clause should only fire when bootstrapping the # libtool distribution, otherwise you forgot to ship ltmain.sh # with your package, and you will get complaints that there are # no rules to generate ltmain.sh. if test -f "$ltmain"; then # See if we are running on zsh, and set the options which allow our commands through # without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Now quote all the things that may contain metacharacters while being # careful not to overquote the AC_SUBSTed values. We take copies of the # variables and quote the copies for generation of the libtool script. for var in echo old_CC old_CFLAGS AR AR_FLAGS EGREP RANLIB LN_S LTCC LTCFLAGS NM \ SED SHELL STRIP \ libname_spec library_names_spec soname_spec extract_expsyms_cmds \ old_striplib striplib file_magic_cmd finish_cmds finish_eval \ deplibs_check_method reload_flag reload_cmds need_locks \ lt_cv_sys_global_symbol_pipe lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \ old_postinstall_cmds old_postuninstall_cmds \ compiler_CXX \ CC_CXX \ LD_CXX \ lt_prog_compiler_wl_CXX \ lt_prog_compiler_pic_CXX \ lt_prog_compiler_static_CXX \ lt_prog_compiler_no_builtin_flag_CXX \ export_dynamic_flag_spec_CXX \ thread_safe_flag_spec_CXX \ whole_archive_flag_spec_CXX \ enable_shared_with_static_runtimes_CXX \ old_archive_cmds_CXX \ old_archive_from_new_cmds_CXX \ predep_objects_CXX \ postdep_objects_CXX \ predeps_CXX \ postdeps_CXX \ compiler_lib_search_path_CXX \ archive_cmds_CXX \ archive_expsym_cmds_CXX \ postinstall_cmds_CXX \ postuninstall_cmds_CXX \ old_archive_from_expsyms_cmds_CXX \ allow_undefined_flag_CXX \ no_undefined_flag_CXX \ export_symbols_cmds_CXX \ hardcode_libdir_flag_spec_CXX \ hardcode_libdir_flag_spec_ld_CXX \ hardcode_libdir_separator_CXX \ hardcode_automatic_CXX \ module_cmds_CXX \ module_expsym_cmds_CXX \ lt_cv_prog_compiler_c_o_CXX \ exclude_expsyms_CXX \ include_expsyms_CXX; do case $var in old_archive_cmds_CXX | \ old_archive_from_new_cmds_CXX | \ archive_cmds_CXX | \ archive_expsym_cmds_CXX | \ module_cmds_CXX | \ module_expsym_cmds_CXX | \ old_archive_from_expsyms_cmds_CXX | \ export_symbols_cmds_CXX | \ extract_expsyms_cmds | reload_cmds | finish_cmds | \ postinstall_cmds | postuninstall_cmds | \ old_postinstall_cmds | old_postuninstall_cmds | \ sys_lib_search_path_spec | sys_lib_dlsearch_path_spec) # Double-quote double-evaled strings. eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ;; *) eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ;; esac done case $lt_echo in *'\$0 --fallback-echo"') lt_echo=`$echo "X$lt_echo" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'` ;; esac cfgfile="$ofile" cat <<__EOF__ >> "$cfgfile" # ### BEGIN LIBTOOL TAG CONFIG: $tagname # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # Shell to use when invoking shell scripts. SHELL=$lt_SHELL # Whether or not to build shared libraries. build_libtool_libs=$enable_shared # Whether or not to build static libraries. build_old_libs=$enable_static # Whether or not to add -lc for building shared libraries. build_libtool_need_lc=$archive_cmds_need_lc_CXX # Whether or not to disallow shared libs when runtime libs are static allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_CXX # Whether or not to optimize for fast installation. fast_install=$enable_fast_install # The host system. host_alias=$host_alias host=$host host_os=$host_os # The build system. build_alias=$build_alias build=$build build_os=$build_os # An echo program that does not interpret backslashes. echo=$lt_echo # The archiver. AR=$lt_AR AR_FLAGS=$lt_AR_FLAGS # A C compiler. LTCC=$lt_LTCC # LTCC compiler flags. LTCFLAGS=$lt_LTCFLAGS # A language-specific compiler. CC=$lt_compiler_CXX # Is the compiler the GNU C compiler? with_gcc=$GCC_CXX gcc_dir=\`gcc -print-file-name=. | $SED 's,/\.$,,'\` gcc_ver=\`gcc -dumpversion\` # An ERE matcher. EGREP=$lt_EGREP # The linker used to build libraries. LD=$lt_LD_CXX # Whether we need hard or soft links. LN_S=$lt_LN_S # A BSD-compatible nm program. NM=$lt_NM # A symbol stripping program STRIP=$lt_STRIP # Used to examine libraries when file_magic_cmd begins "file" MAGIC_CMD=$MAGIC_CMD # Used on cygwin: DLL creation program. DLLTOOL="$DLLTOOL" # Used on cygwin: object dumper. OBJDUMP="$OBJDUMP" # Used on cygwin: assembler. AS="$AS" # The name of the directory that contains temporary libtool files. objdir=$objdir # How to create reloadable object files. reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds # How to pass a linker flag through the compiler. wl=$lt_lt_prog_compiler_wl_CXX # Object file suffix (normally "o"). objext="$ac_objext" # Old archive suffix (normally "a"). libext="$libext" # Shared library suffix (normally ".so"). shrext_cmds='$shrext_cmds' # Executable file suffix (normally ""). exeext="$exeext" # Additional compiler flags for building library objects. pic_flag=$lt_lt_prog_compiler_pic_CXX pic_mode=$pic_mode # What is the maximum length of a command? max_cmd_len=$lt_cv_sys_max_cmd_len # Does compiler simultaneously support -c and -o options? compiler_c_o=$lt_lt_cv_prog_compiler_c_o_CXX # Must we lock files when doing compilation? need_locks=$lt_need_locks # Do we need the lib prefix for modules? need_lib_prefix=$need_lib_prefix # Do we need a version for libraries? need_version=$need_version # Whether dlopen is supported. dlopen_support=$enable_dlopen # Whether dlopen of programs is supported. dlopen_self=$enable_dlopen_self # Whether dlopen of statically linked programs is supported. dlopen_self_static=$enable_dlopen_self_static # Compiler flag to prevent dynamic linking. link_static_flag=$lt_lt_prog_compiler_static_CXX # Compiler flag to turn off builtin functions. no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_CXX # Compiler flag to allow reflexive dlopens. export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_CXX # Compiler flag to generate shared objects directly from archives. whole_archive_flag_spec=$lt_whole_archive_flag_spec_CXX # Compiler flag to generate thread-safe objects. thread_safe_flag_spec=$lt_thread_safe_flag_spec_CXX # Library versioning type. version_type=$version_type # Format of library name prefix. libname_spec=$lt_libname_spec # List of archive names. First name is the real one, the rest are links. # The last name is the one that the linker finds with -lNAME. library_names_spec=$lt_library_names_spec # The coded name of the library, if different from the real name. soname_spec=$lt_soname_spec # Commands used to build and install an old-style archive. RANLIB=$lt_RANLIB old_archive_cmds=$lt_old_archive_cmds_CXX old_postinstall_cmds=$lt_old_postinstall_cmds old_postuninstall_cmds=$lt_old_postuninstall_cmds # Create an old-style archive from a shared archive. old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_CXX # Create a temporary old-style archive to link instead of a shared archive. old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_CXX # Commands used to build and install a shared archive. archive_cmds=$lt_archive_cmds_CXX archive_expsym_cmds=$lt_archive_expsym_cmds_CXX postinstall_cmds=$lt_postinstall_cmds postuninstall_cmds=$lt_postuninstall_cmds # Commands used to build a loadable module (assumed same as above if empty) module_cmds=$lt_module_cmds_CXX module_expsym_cmds=$lt_module_expsym_cmds_CXX # Commands to strip libraries. old_striplib=$lt_old_striplib striplib=$lt_striplib # Dependencies to place before the objects being linked to create a # shared library. predep_objects=\`echo $lt_predep_objects_CXX | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place after the objects being linked to create a # shared library. postdep_objects=\`echo $lt_postdep_objects_CXX | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place before the objects being linked to create a # shared library. predeps=$lt_predeps_CXX # Dependencies to place after the objects being linked to create a # shared library. postdeps=$lt_postdeps_CXX # The library search path used internally by the compiler when linking # a shared library. compiler_lib_search_path=\`echo $lt_compiler_lib_search_path_CXX | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method # Command to use when deplibs_check_method == file_magic. file_magic_cmd=$lt_file_magic_cmd # Flag that allows shared libraries with undefined symbols to be built. allow_undefined_flag=$lt_allow_undefined_flag_CXX # Flag that forces no undefined symbols. no_undefined_flag=$lt_no_undefined_flag_CXX # Commands used to finish a libtool library installation in a directory. finish_cmds=$lt_finish_cmds # Same as above, but a single script fragment to be evaled but not shown. finish_eval=$lt_finish_eval # Take the output of nm and produce a listing of raw symbols and C names. global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe # Transform the output of nm in a proper C declaration global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl # Transform the output of nm in a C name address pair global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address # This is the shared library runtime path variable. runpath_var=$runpath_var # This is the shared library path variable. shlibpath_var=$shlibpath_var # Is shlibpath searched before the hard-coded library search path? shlibpath_overrides_runpath=$shlibpath_overrides_runpath # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action_CXX # Whether we should hardcode library paths into libraries. hardcode_into_libs=$hardcode_into_libs # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_CXX # If ld is used when linking, flag to hardcode \$libdir into # a binary during linking. This must work even if \$libdir does # not exist. hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_CXX # Whether we need a single -rpath flag with a separated argument. hardcode_libdir_separator=$lt_hardcode_libdir_separator_CXX # Set to yes if using DIR/libNAME${shared_ext} during linking hardcodes DIR into the # resulting binary. hardcode_direct=$hardcode_direct_CXX # Set to yes if using the -LDIR flag during linking hardcodes DIR into the # resulting binary. hardcode_minus_L=$hardcode_minus_L_CXX # Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into # the resulting binary. hardcode_shlibpath_var=$hardcode_shlibpath_var_CXX # Set to yes if building a shared library automatically hardcodes DIR into the library # and all subsequent libraries and executables linked against it. hardcode_automatic=$hardcode_automatic_CXX # Variables whose values should be saved in libtool wrapper scripts and # restored at relink time. variables_saved_for_relink="$variables_saved_for_relink" # Whether libtool must link a program against all its dependency libraries. link_all_deplibs=$link_all_deplibs_CXX # Compile-time system search path for libraries sys_lib_search_path_spec=\`echo $lt_sys_lib_search_path_spec | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Run-time system search path for libraries sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec # Fix the shell variable \$srcfile for the compiler. fix_srcfile_path="$fix_srcfile_path_CXX" # Set to yes if exported symbols are required. always_export_symbols=$always_export_symbols_CXX # The commands to list exported symbols. export_symbols_cmds=$lt_export_symbols_cmds_CXX # The commands to extract the exported symbol list from a shared archive. extract_expsyms_cmds=$lt_extract_expsyms_cmds # Symbols that should not be listed in the preloaded symbols. exclude_expsyms=$lt_exclude_expsyms_CXX # Symbols that must always be exported. include_expsyms=$lt_include_expsyms_CXX # ### END LIBTOOL TAG CONFIG: $tagname __EOF__ else # If there is no Makefile yet, we rely on a make rule to execute # `config.status --recheck' to rerun these tests and create the # libtool script then. ltmain_in=`echo $ltmain | sed -e 's/\.sh$/.in/'` if test -f "$ltmain_in"; then test -f Makefile && make "$ltmain" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CC=$lt_save_CC LDCXX=$LD LD=$lt_save_LD GCC=$lt_save_GCC with_gnu_ldcxx=$with_gnu_ld with_gnu_ld=$lt_save_with_gnu_ld lt_cv_path_LDCXX=$lt_cv_path_LD lt_cv_path_LD=$lt_save_path_LD lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld else tagname="" fi ;; F77) if test -n "$F77" && test "X$F77" != "Xno"; then ac_ext=f ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5' ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_f77_compiler_gnu archive_cmds_need_lc_F77=no allow_undefined_flag_F77= always_export_symbols_F77=no archive_expsym_cmds_F77= export_dynamic_flag_spec_F77= hardcode_direct_F77=no hardcode_libdir_flag_spec_F77= hardcode_libdir_flag_spec_ld_F77= hardcode_libdir_separator_F77= hardcode_minus_L_F77=no hardcode_automatic_F77=no module_cmds_F77= module_expsym_cmds_F77= link_all_deplibs_F77=unknown old_archive_cmds_F77=$old_archive_cmds no_undefined_flag_F77= whole_archive_flag_spec_F77= enable_shared_with_static_runtimes_F77=no # Source file extension for f77 test sources. ac_ext=f # Object file extension for compiled f77 test sources. objext=o objext_F77=$objext # Code to be used in simple compile tests lt_simple_compile_test_code=" subroutine t\n return\n end\n" # Code to be used in simple link tests lt_simple_link_test_code=" program t\n end\n" # ltmain only uses $CC for tagged configurations so make sure $CC is set. # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # save warnings/boilerplate of simple test code ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" >conftest.$ac_ext eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_compiler_boilerplate=`cat conftest.err` $rm conftest* ac_outfile=conftest.$ac_objext printf "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` $rm conftest* # Allow CC to be a program name with arguments. lt_save_CC="$CC" CC=${F77-"f77"} compiler=$CC compiler_F77=$CC for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` echo "$as_me:$LINENO: checking if libtool supports shared libraries" >&5 echo $ECHO_N "checking if libtool supports shared libraries... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $can_build_shared" >&5 echo "${ECHO_T}$can_build_shared" >&6 echo "$as_me:$LINENO: checking whether to build shared libraries" >&5 echo $ECHO_N "checking whether to build shared libraries... $ECHO_C" >&6 test "$can_build_shared" = "no" && enable_shared=no # On AIX, shared libraries and static libraries use the same namespace, and # are all built from PIC. case $host_os in aix3*) test "$enable_shared" = yes && enable_static=no if test -n "$RANLIB"; then archive_cmds="$archive_cmds~\$RANLIB \$lib" postinstall_cmds='$RANLIB $lib' fi ;; aix4* | aix5*) if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then test "$enable_shared" = yes && enable_static=no fi ;; esac echo "$as_me:$LINENO: result: $enable_shared" >&5 echo "${ECHO_T}$enable_shared" >&6 echo "$as_me:$LINENO: checking whether to build static libraries" >&5 echo $ECHO_N "checking whether to build static libraries... $ECHO_C" >&6 # Make sure either enable_shared or enable_static is yes. test "$enable_shared" = yes || enable_static=yes echo "$as_me:$LINENO: result: $enable_static" >&5 echo "${ECHO_T}$enable_static" >&6 GCC_F77="$G77" LD_F77="$LD" lt_prog_compiler_wl_F77= lt_prog_compiler_pic_F77= lt_prog_compiler_static_F77= echo "$as_me:$LINENO: checking for $compiler option to produce PIC" >&5 echo $ECHO_N "checking for $compiler option to produce PIC... $ECHO_C" >&6 if test "$GCC" = yes; then lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_static_F77='-static' case $host_os in aix*) # All AIX code is PIC. if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_F77='-Bstatic' fi ;; amigaos*) # FIXME: we need at least 68020 code to build shared libraries, but # adding the `-m68020' flag to GCC prevents building anything better, # like `-m68040'. lt_prog_compiler_pic_F77='-m68020 -resident32 -malways-restore-a4' ;; beos* | cygwin* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_F77='-DDLL_EXPORT' ;; darwin* | rhapsody*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files lt_prog_compiler_pic_F77='-fno-common' ;; interix3*) # Interix 3.x gcc -fpic/-fPIC options generate broken code. # Instead, we relocate shared libraries at runtime. ;; msdosdjgpp*) # Just because we use GCC doesn't mean we suddenly get shared libraries # on systems that don't support them. lt_prog_compiler_can_build_shared_F77=no enable_shared=no ;; sysv4*MP*) if test -d /usr/nec; then lt_prog_compiler_pic_F77=-Kconform_pic fi ;; hpux*) # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic_F77='-fPIC' ;; esac ;; *) lt_prog_compiler_pic_F77='-fPIC' ;; esac else # PORTME Check for flag to pass linker flags through the system compiler. case $host_os in aix*) lt_prog_compiler_wl_F77='-Wl,' if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_F77='-Bstatic' else lt_prog_compiler_static_F77='-bnso -bI:/lib/syscalls.exp' fi ;; darwin*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files case $cc_basename in xlc*) lt_prog_compiler_pic_F77='-qnocommon' lt_prog_compiler_wl_F77='-Wl,' ;; esac ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_F77='-DDLL_EXPORT' ;; hpux9* | hpux10* | hpux11*) lt_prog_compiler_wl_F77='-Wl,' # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic_F77='+Z' ;; esac # Is there a better lt_prog_compiler_static that works with the bundled CC? lt_prog_compiler_static_F77='${wl}-a ${wl}archive' ;; irix5* | irix6* | nonstopux*) lt_prog_compiler_wl_F77='-Wl,' # PIC (with -KPIC) is the default. lt_prog_compiler_static_F77='-non_shared' ;; newsos6) lt_prog_compiler_pic_F77='-KPIC' lt_prog_compiler_static_F77='-Bstatic' ;; linux*) case $cc_basename in icc* | ecc*) lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_pic_F77='-KPIC' lt_prog_compiler_static_F77='-static' ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_pic_F77='-fpic' lt_prog_compiler_static_F77='-Bstatic' ;; ccc*) lt_prog_compiler_wl_F77='-Wl,' # All Alpha code is PIC. lt_prog_compiler_static_F77='-non_shared' ;; esac ;; osf3* | osf4* | osf5*) lt_prog_compiler_wl_F77='-Wl,' # All OSF/1 code is PIC. lt_prog_compiler_static_F77='-non_shared' ;; solaris*) lt_prog_compiler_pic_F77='-KPIC' lt_prog_compiler_static_F77='-Bstatic' case $cc_basename in f77* | f90* | f95*) lt_prog_compiler_wl_F77='-Qoption ld ';; *) lt_prog_compiler_wl_F77='-Wl,';; esac ;; sunos4*) lt_prog_compiler_wl_F77='-Qoption ld ' lt_prog_compiler_pic_F77='-PIC' lt_prog_compiler_static_F77='-Bstatic' ;; sysv4 | sysv4.2uw2* | sysv4.3*) lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_pic_F77='-KPIC' lt_prog_compiler_static_F77='-Bstatic' ;; sysv4*MP*) if test -d /usr/nec ;then lt_prog_compiler_pic_F77='-Kconform_pic' lt_prog_compiler_static_F77='-Bstatic' fi ;; sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_pic_F77='-KPIC' lt_prog_compiler_static_F77='-Bstatic' ;; unicos*) lt_prog_compiler_wl_F77='-Wl,' lt_prog_compiler_can_build_shared_F77=no ;; uts4*) lt_prog_compiler_pic_F77='-pic' lt_prog_compiler_static_F77='-Bstatic' ;; *) lt_prog_compiler_can_build_shared_F77=no ;; esac fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_F77" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_F77" >&6 # # Check to make sure the PIC flag actually works. # if test -n "$lt_prog_compiler_pic_F77"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works... $ECHO_C" >&6 if test "${lt_prog_compiler_pic_works_F77+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_pic_works_F77=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic_F77" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:20661: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:20665: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_pic_works_F77=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works_F77" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_works_F77" >&6 if test x"$lt_prog_compiler_pic_works_F77" = xyes; then case $lt_prog_compiler_pic_F77 in "" | " "*) ;; *) lt_prog_compiler_pic_F77=" $lt_prog_compiler_pic_F77" ;; esac else lt_prog_compiler_pic_F77= lt_prog_compiler_can_build_shared_F77=no fi fi case $host_os in # For platforms which do not support PIC, -DPIC is meaningless: *djgpp*) lt_prog_compiler_pic_F77= ;; *) lt_prog_compiler_pic_F77="$lt_prog_compiler_pic_F77" ;; esac # # Check to make sure the static flag actually works. # wl=$lt_prog_compiler_wl_F77 eval lt_tmp_static_flag=\"$lt_prog_compiler_static_F77\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 if test "${lt_prog_compiler_static_works_F77+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_static_works_F77=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" printf "$lt_simple_link_test_code" > conftest.$ac_ext if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then # The linker can only warn and ignore the option if not recognized # So say no if there are warnings if test -s conftest.err; then # Append any errors to the config.log. cat conftest.err 1>&5 $echo "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_static_works_F77=yes fi else lt_prog_compiler_static_works_F77=yes fi fi $rm conftest* LDFLAGS="$save_LDFLAGS" fi echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works_F77" >&5 echo "${ECHO_T}$lt_prog_compiler_static_works_F77" >&6 if test x"$lt_prog_compiler_static_works_F77" = xyes; then : else lt_prog_compiler_static_F77= fi echo "$as_me:$LINENO: checking if $compiler supports -c -o file.$ac_objext" >&5 echo $ECHO_N "checking if $compiler supports -c -o file.$ac_objext... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_c_o_F77+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_c_o_F77=no $rm -r conftest 2>/dev/null mkdir conftest cd conftest mkdir out printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-o out/conftest2.$ac_objext" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:20765: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 echo "$as_me:20769: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' > out/conftest.exp $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then lt_cv_prog_compiler_c_o_F77=yes fi fi chmod u+w . 2>&5 $rm conftest* # SGI C++ compiler will create directory out/ii_files/ for # template instantiation test -d out/ii_files && $rm out/ii_files/* && rmdir out/ii_files $rm out/* && rmdir out cd .. rmdir conftest $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_c_o_F77" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_c_o_F77" >&6 hard_links="nottested" if test "$lt_cv_prog_compiler_c_o_F77" = no && test "$need_locks" != no; then # do not overwrite the value of need_locks provided by the user echo "$as_me:$LINENO: checking if we can lock with hard links" >&5 echo $ECHO_N "checking if we can lock with hard links... $ECHO_C" >&6 hard_links=yes $rm conftest* ln conftest.a conftest.b 2>/dev/null && hard_links=no touch conftest.a ln conftest.a conftest.b 2>&5 || hard_links=no ln conftest.a conftest.b 2>/dev/null && hard_links=no echo "$as_me:$LINENO: result: $hard_links" >&5 echo "${ECHO_T}$hard_links" >&6 if test "$hard_links" = no; then { echo "$as_me:$LINENO: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} need_locks=warn fi else need_locks=no fi echo "$as_me:$LINENO: checking whether the $compiler linker ($LD) supports shared libraries" >&5 echo $ECHO_N "checking whether the $compiler linker ($LD) supports shared libraries... $ECHO_C" >&6 runpath_var= allow_undefined_flag_F77= enable_shared_with_static_runtimes_F77=no archive_cmds_F77= archive_expsym_cmds_F77= old_archive_From_new_cmds_F77= old_archive_from_expsyms_cmds_F77= export_dynamic_flag_spec_F77= whole_archive_flag_spec_F77= thread_safe_flag_spec_F77= hardcode_libdir_flag_spec_F77= hardcode_libdir_flag_spec_ld_F77= hardcode_libdir_separator_F77= hardcode_direct_F77=no hardcode_minus_L_F77=no hardcode_shlibpath_var_F77=unsupported link_all_deplibs_F77=unknown hardcode_automatic_F77=no module_cmds_F77= module_expsym_cmds_F77= always_export_symbols_F77=no export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' # include_expsyms should be a list of space-separated symbols to be *always* # included in the symbol list include_expsyms_F77= # exclude_expsyms can be an extended regexp of symbols to exclude # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. exclude_expsyms_F77="_GLOBAL_OFFSET_TABLE_" # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. extract_expsyms_cmds= # Just being paranoid about ensuring that cc_basename is set. for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` case $host_os in cygwin* | mingw* | pw32*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. if test "$GCC" != yes; then with_gnu_ld=no fi ;; interix*) # we just hope/assume this is gcc and not c89 (= MSVC++) with_gnu_ld=yes ;; openbsd*) with_gnu_ld=no ;; esac ld_shlibs_F77=yes if test "$with_gnu_ld" = yes; then # If archive_cmds runs LD, not CC, wlarc should be empty wlarc='${wl}' # Set some defaults for GNU ld with shared library support. These # are reset later if shared libraries are not supported. Putting them # here allows them to be overridden if necessary. runpath_var=LD_RUN_PATH hardcode_libdir_flag_spec_F77='${wl}--rpath ${wl}$libdir' export_dynamic_flag_spec_F77='${wl}--export-dynamic' # ancient GNU ld didn't support --whole-archive et. al. if $LD --help 2>&1 | grep 'no-whole-archive' > /dev/null; then whole_archive_flag_spec_F77="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' else whole_archive_flag_spec_F77= fi supports_anon_versioning=no case `$LD -v 2>/dev/null` in *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... *\ 2.11.*) ;; # other 2.11 versions *) supports_anon_versioning=yes ;; esac # See if GNU ld supports shared libraries. case $host_os in aix3* | aix4* | aix5*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs_F77=no cat <&2 *** Warning: the GNU linker, at least up to release 2.9.1, is reported *** to be unable to reliably create shared libraries on AIX. *** Therefore, libtool is disabling shared libraries support. If you *** really care for shared libraries, you may want to modify your PATH *** so that a non-GNU linker is found, and then restart. EOF fi ;; amigaos*) archive_cmds_F77='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_minus_L_F77=yes # Samuel A. Falvo II reports # that the semantics of dynamic libraries on AmigaOS, at least up # to version 4, is to share data among multiple programs linked # with the same dynamic library. Since this doesn't match the # behavior of shared libraries on other platforms, we can't use # them. ld_shlibs_F77=no ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then allow_undefined_flag_F77=unsupported # Joseph Beckenbach says some releases of gcc # support --undefined. This deserves some investigation. FIXME archive_cmds_F77='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' else ld_shlibs_F77=no fi ;; cygwin* | mingw* | pw32*) # _LT_AC_TAGVAR(hardcode_libdir_flag_spec, F77) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec_F77='-L$libdir' allow_undefined_flag_F77=unsupported always_export_symbols_F77=no enable_shared_with_static_runtimes_F77=yes export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS] /s/.* \([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW] /s/.* //'\'' | sort | uniq > $export_symbols' if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' # If the export-symbols file already is a .def file (1st line # is EXPORTS), use it as is; otherwise, prepend... archive_expsym_cmds_F77='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then cp $export_symbols $output_objdir/$soname.def; else echo EXPORTS > $output_objdir/$soname.def; cat $export_symbols >> $output_objdir/$soname.def; fi~ $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' else ld_shlibs_F77=no fi ;; interix3*) hardcode_direct_F77=no hardcode_shlibpath_var_F77=no hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir' export_dynamic_flag_spec_F77='${wl}-E' # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. # Instead, shared libraries are loaded at an image base (0x10000000 by # default) and relocated if they conflict, which is a slow very memory # consuming and fragmenting process. To avoid this, we pick a random, # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link # time. Moving up from 0x10000000 also allows more sbrk(2) space. archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' archive_expsym_cmds_F77='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; linux*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then tmp_addflag= case $cc_basename,$host_cpu in pgcc*) # Portland Group C compiler whole_archive_flag_spec_F77='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag' ;; pgf77* | pgf90* | pgf95*) # Portland Group f77 and f90 compilers whole_archive_flag_spec_F77='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag -Mnomain' ;; ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 tmp_addflag=' -i_dynamic' ;; efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 tmp_addflag=' -i_dynamic -nofor_main' ;; ifc* | ifort*) # Intel Fortran compiler tmp_addflag=' -nofor_main' ;; esac archive_cmds_F77='$CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' if test $supports_anon_versioning = yes; then archive_expsym_cmds_F77='$echo "{ global:" > $output_objdir/$libname.ver~ cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ $echo "local: *; };" >> $output_objdir/$libname.ver~ $CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' fi else ld_shlibs_F77=no fi ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds_F77='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' wlarc= else archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' fi ;; solaris*) if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then ld_shlibs_F77=no cat <&2 *** Warning: The releases 2.8.* of the GNU linker cannot reliably *** create shared libraries on Solaris systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.9.1 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. EOF elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs_F77=no fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) case `$LD -v 2>&1` in *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) ld_shlibs_F77=no cat <<_LT_EOF 1>&2 *** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not *** reliably create shared libraries on SCO systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.16.91.0.3 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. _LT_EOF ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then hardcode_libdir_flag_spec_F77='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`' archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib' archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname,-retain-symbols-file,$export_symbols -o $lib' else ld_shlibs_F77=no fi ;; esac ;; sunos4*) archive_cmds_F77='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' wlarc= hardcode_direct_F77=yes hardcode_shlibpath_var_F77=no ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs_F77=no fi ;; esac if test "$ld_shlibs_F77" = no; then runpath_var= hardcode_libdir_flag_spec_F77= export_dynamic_flag_spec_F77= whole_archive_flag_spec_F77= fi else # PORTME fill in a description of your system's linker (not GNU ld) case $host_os in aix3*) allow_undefined_flag_F77=unsupported always_export_symbols_F77=yes archive_expsym_cmds_F77='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' # Note: this linker hardcodes the directories in LIBPATH if there # are no directories specified by -L. hardcode_minus_L_F77=yes if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then # Neither direct hardcoding nor static linking is supported with a # broken collect2. hardcode_direct_F77=unsupported fi ;; aix4* | aix5*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. aix_use_runtimelinking=no exp_sym_flag='-Bexport' no_entry_flag="" else # If we're using GNU nm, then we don't want the "-C" option. # -C means demangle to AIX nm, but means don't demangle with GNU nm if $NM -V 2>&1 | grep 'GNU' > /dev/null; then export_symbols_cmds_F77='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' else export_symbols_cmds_F77='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' fi aix_use_runtimelinking=no # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. case $host_os in aix4.[23]|aix4.[23].*|aix5*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes break fi done ;; esac exp_sym_flag='-bexport' no_entry_flag='-bnoentry' fi # When large executables or shared objects are built, AIX ld can # have problems creating the table of contents. If linking a library # or program results in "error TOC overflow" add -mminimal-toc to # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. archive_cmds_F77='' hardcode_direct_F77=yes hardcode_libdir_separator_F77=':' link_all_deplibs_F77=yes if test "$GCC" = yes; then case $host_os in aix4.[012]|aix4.[012].*) # We only want to do this on AIX 4.2 and lower, the check # below for broken collect2 doesn't work under 4.3+ collect2name=`${CC} -print-prog-name=collect2` if test -f "$collect2name" && \ strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 hardcode_direct_F77=yes else # We have old collect2 hardcode_direct_F77=unsupported # It fails to find uninstalled libraries when the uninstalled # path is not listed in the libpath. Setting hardcode_minus_L # to unsupported forces relinking hardcode_minus_L_F77=yes hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_libdir_separator_F77= fi ;; esac shared_flag='-shared' if test "$aix_use_runtimelinking" = yes; then shared_flag="$shared_flag "'${wl}-G' fi else # not using gcc if test "$host_cpu" = ia64; then # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release # chokes on -Wl,-G. The following line is correct: shared_flag='-G' else if test "$aix_use_runtimelinking" = yes; then shared_flag='${wl}-G' else shared_flag='${wl}-bM:SRE' fi fi fi # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols_F77=yes if test "$aix_use_runtimelinking" = yes; then # Warning - without using the other runtime loading flags (-brtl), # -berok will link without error, but may produce a broken library. allow_undefined_flag_F77='-berok' # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_F77='${wl}-blibpath:$libdir:'"$aix_libpath" archive_expsym_cmds_F77="\$CC"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" else if test "$host_cpu" = ia64; then hardcode_libdir_flag_spec_F77='${wl}-R $libdir:/usr/lib:/lib' allow_undefined_flag_F77="-z nodefs" archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" else # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_f77_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_F77='${wl}-blibpath:$libdir:'"$aix_libpath" # Warning - without using the other run time loading flags, # -berok will link without error, but may produce a broken library. no_undefined_flag_F77=' ${wl}-bernotok' allow_undefined_flag_F77=' ${wl}-berok' # Exported symbols can be pulled into shared objects from archives whole_archive_flag_spec_F77='$convenience' archive_cmds_need_lc_F77=yes # This is similar to how AIX traditionally builds its shared libraries. archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' fi fi ;; amigaos*) archive_cmds_F77='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_minus_L_F77=yes # see comment about different semantics on the GNU ld section ld_shlibs_F77=no ;; bsdi[45]*) export_dynamic_flag_spec_F77=-rdynamic ;; cygwin* | mingw* | pw32*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is # no search path for DLLs. hardcode_libdir_flag_spec_F77=' ' allow_undefined_flag_F77=unsupported # Tell ltmain to make .lib files, not .a files. libext=lib # Tell ltmain to make .dll files, not .so files. shrext_cmds=".dll" # FIXME: Setting linknames here is a bad hack. archive_cmds_F77='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | $SED -e '\''s/ -lc$//'\''` -link -dll~linknames=' # The linker will automatically build a .lib file if we build a DLL. old_archive_From_new_cmds_F77='true' # FIXME: Should let the user specify the lib program. old_archive_cmds_F77='lib /OUT:$oldlib$oldobjs$old_deplibs' fix_srcfile_path_F77='`cygpath -w "$srcfile"`' enable_shared_with_static_runtimes_F77=yes ;; darwin* | rhapsody*) case $host_os in rhapsody* | darwin1.[012]) allow_undefined_flag_F77='${wl}-undefined ${wl}suppress' ;; *) # Darwin 1.3 on if test -z ${MACOSX_DEPLOYMENT_TARGET} ; then allow_undefined_flag_F77='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' else case ${MACOSX_DEPLOYMENT_TARGET} in 10.[012]) allow_undefined_flag_F77='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; 10.*) allow_undefined_flag_F77='${wl}-undefined ${wl}dynamic_lookup' ;; esac fi ;; esac archive_cmds_need_lc_F77=no hardcode_direct_F77=no hardcode_automatic_F77=yes hardcode_shlibpath_var_F77=unsupported whole_archive_flag_spec_F77='' link_all_deplibs_F77=yes if test "$GCC" = yes ; then output_verbose_link_cmd='echo' archive_cmds_F77='$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' module_cmds_F77='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds_F77='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds_F77='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' else case $cc_basename in xlc*) output_verbose_link_cmd='echo' archive_cmds_F77='$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`echo $rpath/$soname` $verstring' module_cmds_F77='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds_F77='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds_F77='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ;; *) ld_shlibs_F77=no ;; esac fi ;; dgux*) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_shlibpath_var_F77=no ;; freebsd1*) ld_shlibs_F77=no ;; # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor # support. Future versions do this automatically, but an explicit c++rt0.o # does not break anything, and helps significantly (at the cost of a little # extra space). freebsd2.2*) archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' hardcode_libdir_flag_spec_F77='-R$libdir' hardcode_direct_F77=yes hardcode_shlibpath_var_F77=no ;; # Unfortunately, older versions of FreeBSD 2 do not have this feature. freebsd2*) archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_F77=yes hardcode_minus_L_F77=yes hardcode_shlibpath_var_F77=no ;; # FreeBSD 3 and greater uses gcc -shared to do shared libraries. freebsd* | kfreebsd*-gnu | dragonfly*) archive_cmds_F77='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec_F77='-R$libdir' hardcode_direct_F77=yes hardcode_shlibpath_var_F77=no ;; hpux9*) if test "$GCC" = yes; then archive_cmds_F77='$rm $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' else archive_cmds_F77='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' fi hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir' hardcode_libdir_separator_F77=: hardcode_direct_F77=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_F77=yes export_dynamic_flag_spec_F77='${wl}-E' ;; hpux10*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then archive_cmds_F77='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_F77='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir' hardcode_libdir_separator_F77=: hardcode_direct_F77=yes export_dynamic_flag_spec_F77='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_F77=yes fi ;; hpux11*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then case $host_cpu in hppa*64*) archive_cmds_F77='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds_F77='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_F77='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac else case $host_cpu in hppa*64*) archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir' hardcode_libdir_separator_F77=: case $host_cpu in hppa*64*|ia64*) hardcode_libdir_flag_spec_ld_F77='+b $libdir' hardcode_direct_F77=no hardcode_shlibpath_var_F77=no ;; *) hardcode_direct_F77=yes export_dynamic_flag_spec_F77='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_F77=yes ;; esac fi ;; irix5* | irix6* | nonstopux*) if test "$GCC" = yes; then archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else archive_cmds_F77='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_ld_F77='-rpath $libdir' fi hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_F77=: link_all_deplibs_F77=yes ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out else archive_cmds_F77='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF fi hardcode_libdir_flag_spec_F77='-R$libdir' hardcode_direct_F77=yes hardcode_shlibpath_var_F77=no ;; newsos6) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_F77=yes hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_F77=: hardcode_shlibpath_var_F77=no ;; openbsd*) hardcode_direct_F77=yes hardcode_shlibpath_var_F77=no if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir' export_dynamic_flag_spec_F77='${wl}-E' else case $host_os in openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_F77='-R$libdir' ;; *) archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir' ;; esac fi ;; os2*) hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_minus_L_F77=yes allow_undefined_flag_F77=unsupported archive_cmds_F77='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' old_archive_From_new_cmds_F77='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' ;; osf3*) if test "$GCC" = yes; then allow_undefined_flag_F77=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_F77='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else allow_undefined_flag_F77=' -expect_unresolved \*' archive_cmds_F77='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' fi hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_F77=: ;; osf4* | osf5*) # as osf3* with the addition of -msym flag if test "$GCC" = yes; then allow_undefined_flag_F77=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_F77='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir' else allow_undefined_flag_F77=' -expect_unresolved \*' archive_cmds_F77='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' archive_expsym_cmds_F77='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib~$rm $lib.exp' # Both c and cxx compiler support -rpath directly hardcode_libdir_flag_spec_F77='-rpath $libdir' fi hardcode_libdir_separator_F77=: ;; solaris*) no_undefined_flag_F77=' -z text' if test "$GCC" = yes; then wlarc='${wl}' archive_cmds_F77='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -shared ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$rm $lib.exp' else wlarc='' archive_cmds_F77='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' archive_expsym_cmds_F77='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp' fi hardcode_libdir_flag_spec_F77='-R$libdir' hardcode_shlibpath_var_F77=no case $host_os in solaris2.[0-5] | solaris2.[0-5].*) ;; *) # The compiler driver will combine linker options so we # cannot just pass the convience library names through # without $wl, iff we do not link with $LD. # Luckily, gcc supports the same syntax we need for Sun Studio. # Supported since Solaris 2.6 (maybe 2.5.1?) case $wlarc in '') whole_archive_flag_spec_F77='-z allextract$convenience -z defaultextract' ;; *) whole_archive_flag_spec_F77='${wl}-z ${wl}allextract`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}-z ${wl}defaultextract' ;; esac ;; esac link_all_deplibs_F77=yes ;; sunos4*) if test "x$host_vendor" = xsequent; then # Use $CC to link under sequent, because it throws in some extra .o # files that make .init and .fini sections work. archive_cmds_F77='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_F77='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' fi hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_direct_F77=yes hardcode_minus_L_F77=yes hardcode_shlibpath_var_F77=no ;; sysv4) case $host_vendor in sni) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_F77=yes # is this really true??? ;; siemens) ## LD is ld it makes a PLAMLIB ## CC just makes a GrossModule. archive_cmds_F77='$LD -G -o $lib $libobjs $deplibs $linker_flags' reload_cmds_F77='$CC -r -o $output$reload_objs' hardcode_direct_F77=no ;; motorola) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_F77=no #Motorola manual says yes, but my tests say they lie ;; esac runpath_var='LD_RUN_PATH' hardcode_shlibpath_var_F77=no ;; sysv4.3*) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var_F77=no export_dynamic_flag_spec_F77='-Bexport' ;; sysv4*MP*) if test -d /usr/nec; then archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var_F77=no runpath_var=LD_RUN_PATH hardcode_runpath_var=yes ld_shlibs_F77=yes fi ;; sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7*) no_undefined_flag_F77='${wl}-z,text' archive_cmds_need_lc_F77=no hardcode_shlibpath_var_F77=no runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds_F77='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_F77='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; sysv5* | sco3.2v5* | sco5v6*) # Note: We can NOT use -z defs as we might desire, because we do not # link with -lc, and that would cause any symbols used from libc to # always be unresolved, which means just about no library would # ever link correctly. If we're not using GNU ld we use -z text # though, which does catch some bad symbols but isn't as heavy-handed # as -z defs. no_undefined_flag_F77='${wl}-z,text' allow_undefined_flag_F77='${wl}-z,nodefs' archive_cmds_need_lc_F77=no hardcode_shlibpath_var_F77=no hardcode_libdir_flag_spec_F77='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' hardcode_libdir_separator_F77=':' link_all_deplibs_F77=yes export_dynamic_flag_spec_F77='${wl}-Bexport' runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds_F77='$CC -shared ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_F77='$CC -G ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_F77='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; uts4*) archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_F77='-L$libdir' hardcode_shlibpath_var_F77=no ;; *) ld_shlibs_F77=no ;; esac fi echo "$as_me:$LINENO: result: $ld_shlibs_F77" >&5 echo "${ECHO_T}$ld_shlibs_F77" >&6 test "$ld_shlibs_F77" = no && can_build_shared=no # # Do we need to explicitly link libc? # case "x$archive_cmds_need_lc_F77" in x|xyes) # Assume -lc should be added archive_cmds_need_lc_F77=yes if test "$enable_shared" = yes && test "$GCC" = yes; then case $archive_cmds_F77 in *'~'*) # FIXME: we may have to deal with multi-command sequences. ;; '$CC '*) # Test whether the compiler implicitly links with -lc since on some # systems, -lgcc has to come before -lc. If gcc already passes -lc # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 $rm conftest* printf "$lt_simple_compile_test_code" > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then soname=conftest lib=conftest libobjs=conftest.$ac_objext deplibs= wl=$lt_prog_compiler_wl_F77 pic_flag=$lt_prog_compiler_pic_F77 compiler_flags=-v linker_flags=-v verstring= output_objdir=. libname=conftest lt_save_allow_undefined_flag=$allow_undefined_flag_F77 allow_undefined_flag_F77= if { (eval echo "$as_me:$LINENO: \"$archive_cmds_F77 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds_F77 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } then archive_cmds_need_lc_F77=no else archive_cmds_need_lc_F77=yes fi allow_undefined_flag_F77=$lt_save_allow_undefined_flag else cat conftest.err 1>&5 fi $rm conftest* echo "$as_me:$LINENO: result: $archive_cmds_need_lc_F77" >&5 echo "${ECHO_T}$archive_cmds_need_lc_F77" >&6 ;; esac fi ;; esac echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 library_names_spec= libname_spec='lib$name' soname_spec= shrext_cmds=".so" postinstall_cmds= postuninstall_cmds= finish_cmds= finish_eval= shlibpath_var= shlibpath_overrides_runpath=unknown version_type=none dynamic_linker="$host_os ld.so" sys_lib_dlsearch_path_spec="/lib /usr/lib" if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';' >/dev/null ; then # if the path contains ";" then we assume it to be the separator # otherwise default to the standard path separator (i.e. ":") - it is # assumed that no part of a normal pathname contains ";" but that should # okay in the real world where ";" in dirpaths is itself problematic. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi else sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" fi need_lib_prefix=unknown hardcode_into_libs=no # when you set need_version to no, make sure it does not cause -set_version # flags to be left without arguments need_version=unknown case $host_os in aix3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' shlibpath_var=LIBPATH # AIX 3 has no versioning support, so we append a major version to the name. soname_spec='${libname}${release}${shared_ext}$major' ;; aix4* | aix5*) version_type=linux need_lib_prefix=no need_version=no hardcode_into_libs=yes if test "$host_cpu" = ia64; then # AIX 5 supports IA64 library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH else # With GCC up to 2.95.x, collect2 would create an import file # for dependence libraries. The import file would start with # the line `#! .'. This would cause the generated library to # depend on `.', always an invalid library. This was fixed in # development snapshots of GCC prior to 3.0. case $host_os in aix4 | aix4.[01] | aix4.[01].*) if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' echo ' yes ' echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then : else can_build_shared=no fi ;; esac # AIX (on Power*) has no versioning support, so currently we can not hardcode correct # soname into executable. Probably we can add versioning support to # collect2, so additional links can be useful in future. if test "$aix_use_runtimelinking" = yes; then # If using run time linking (on AIX 4.2 or later) use lib.so # instead of lib.a to let people know that these are not # typical AIX shared libraries. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' else # We preserve .a as extension for shared libraries through AIX4.2 # and later when we are not doing run time linking. library_names_spec='${libname}${release}.a $libname.a' soname_spec='${libname}${release}${shared_ext}$major' fi shlibpath_var=LIBPATH fi ;; amigaos*) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ;; beos*) library_names_spec='${libname}${shared_ext}' dynamic_linker="$host_os ld.so" shlibpath_var=LIBRARY_PATH ;; bsdi[45]*) version_type=linux need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" # the default ld.so.conf also contains /usr/contrib/lib and # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow # libtool to hard-code these into programs ;; cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no case $GCC,$host_os in yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i;echo \$dlname'\''`~ dldir=$destdir/`dirname \$dlpath`~ test -d \$dldir || mkdir -p \$dldir~ $install_prog $dir/$dlname \$dldir/$dlname~ chmod a+x \$dldir/$dlname' postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ dlpath=$dir/\$dldll~ $rm \$dlpath' shlibpath_overrides_runpath=yes case $host_os in cygwin*) # Cygwin DLLs use 'cyg' prefix rather than 'lib' soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';[c-zC-Z]:/' >/dev/null; then # It is most probably a Windows format PATH printed by # mingw gcc, but we are running on Cygwin. Gcc prints its search # path with ; separators, and with drive letters. We can handle the # drive letters (cygwin fileutils understands them), so leave them, # especially as we might pass files found there to a mingw objdump, # which wouldn't understand a cygwinified path. Ahh. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi ;; pw32*) # pw32 DLLs use 'pw' prefix rather than 'lib' library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' ;; esac ;; *) library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' ;; esac dynamic_linker='Win32 ld.exe' # FIXME: first we should search . and the directory the executable is in shlibpath_var=PATH ;; darwin* | rhapsody*) dynamic_linker="$host_os dyld" version_type=darwin need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${versuffix}$shared_ext ${libname}${release}${major}$shared_ext ${libname}$shared_ext' soname_spec='${libname}${release}${major}$shared_ext' shlibpath_overrides_runpath=yes shlibpath_var=DYLD_LIBRARY_PATH shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' # Apple's gcc prints 'gcc -print-search-dirs' doesn't operate the same. if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | tr "\n" "$PATH_SEPARATOR" | sed -e 's/libraries:/@libraries:/' | tr "@" "\n" | grep "^libraries:" | sed -e "s/^libraries://" -e "s,=/,/,g" -e "s,$PATH_SEPARATOR, ,g" -e "s,.*,& /lib /usr/lib /usr/local/lib,g"` else sys_lib_search_path_spec='/lib /usr/lib /usr/local/lib' fi sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' ;; dgux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; freebsd1*) dynamic_linker=no ;; kfreebsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; freebsd* | dragonfly*) # DragonFly does not have aout. When/if they implement a new # versioning mechanism, adjust this. if test -x /usr/bin/objformat; then objformat=`/usr/bin/objformat` else case $host_os in freebsd[123]*) objformat=aout ;; *) objformat=elf ;; esac fi version_type=freebsd-$objformat case $version_type in freebsd-elf*) library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' need_version=no need_lib_prefix=no ;; freebsd-*) library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' need_version=yes ;; esac shlibpath_var=LD_LIBRARY_PATH case $host_os in freebsd2*) shlibpath_overrides_runpath=yes ;; freebsd3.[01]* | freebsdelf3.[01]*) shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; freebsd*) # from 4.6 on shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; esac ;; gnu*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes ;; hpux9* | hpux10* | hpux11*) # Give a soname corresponding to the major version so that dld.sl refuses to # link against other versions. version_type=sunos need_lib_prefix=no need_version=no case $host_cpu in ia64*) shrext_cmds='.so' hardcode_into_libs=yes dynamic_linker="$host_os dld.so" shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' if test "X$HPUX_IA64_MODE" = X32; then sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" else sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" fi sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; hppa*64*) shrext_cmds='.sl' hardcode_into_libs=yes dynamic_linker="$host_os dld.sl" shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; *) shrext_cmds='.sl' dynamic_linker="$host_os dld.sl" shlibpath_var=SHLIB_PATH shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' ;; esac # HP-UX runs *really* slowly unless shared libraries are mode 555. postinstall_cmds='chmod 555 $lib' ;; interix3*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; irix5* | irix6* | nonstopux*) case $host_os in nonstopux*) version_type=nonstopux ;; *) if test "$lt_cv_prog_gnu_ld" = yes; then version_type=linux else version_type=irix fi ;; esac need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' case $host_os in irix5* | nonstopux*) libsuff= shlibsuff= ;; *) case $LD in # libtool.m4 will add one of these switches to LD *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= libmagic=32-bit;; *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 libmagic=N32;; *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 libmagic=64-bit;; *) libsuff= shlibsuff= libmagic=never-match;; esac ;; esac shlibpath_var=LD_LIBRARY${shlibsuff}_PATH shlibpath_overrides_runpath=no sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" hardcode_into_libs=yes ;; # No shared lib support for Linux oldld, aout, or coff. linux*oldld* | linux*aout* | linux*coff*) dynamic_linker=no ;; # This must be Linux ELF. linux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install # before this can be enabled. hardcode_into_libs=yes # find out which ABI we are using libsuff= case "$host_cpu" in x86_64*|s390x*|powerpc64*) echo '#line 22214 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.$ac_objext` in *64-bit*) libsuff=64 sys_lib_search_path_spec="/lib${libsuff} /usr/lib${libsuff} /usr/local/lib${libsuff}" ;; esac fi rm -rf conftest* ;; esac # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib${libsuff} /usr/lib${libsuff} $lt_ld_extra" fi # We used to test for /lib/ld.so.1 and disable shared libraries on # powerpc, because MkLinux only supported shared libraries with the # GNU dynamic linker. Since this was broken with cross compilers, # most powerpc-linux boxes support dynamic linking these days and # people can always --disable-shared, the test was removed, and we # assume the GNU/Linux dynamic linker is in use. dynamic_linker='GNU/Linux ld.so' ;; knetbsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; netbsd*) version_type=sunos need_lib_prefix=no need_version=no if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' dynamic_linker='NetBSD (a.out) ld.so' else library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='NetBSD ld.elf_so' fi shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; newsos6) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; nto-qnx*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; openbsd*) version_type=sunos sys_lib_dlsearch_path_spec="/usr/lib" need_lib_prefix=no # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. case $host_os in openbsd3.3 | openbsd3.3.*) need_version=yes ;; *) need_version=no ;; esac library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' shlibpath_var=LD_LIBRARY_PATH if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then case $host_os in openbsd2.[89] | openbsd2.[89].*) shlibpath_overrides_runpath=no ;; *) shlibpath_overrides_runpath=yes ;; esac else shlibpath_overrides_runpath=yes fi ;; os2*) libname_spec='$name' shrext_cmds=".dll" need_lib_prefix=no library_names_spec='$libname${shared_ext} $libname.a' dynamic_linker='OS/2 ld.exe' shlibpath_var=LIBPATH ;; osf3* | osf4* | osf5*) version_type=osf need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" ;; solaris*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes # ldd complains unless libraries are executable postinstall_cmds='chmod +x $lib' ;; sunos4*) version_type=sunos library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes if test "$with_gnu_ld" = yes; then need_lib_prefix=no fi need_version=yes ;; sysv4 | sysv4.3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH case $host_vendor in sni) shlibpath_overrides_runpath=no need_lib_prefix=no export_dynamic_flag_spec='${wl}-Blargedynsym' runpath_var=LD_RUN_PATH ;; siemens) need_lib_prefix=no ;; motorola) need_lib_prefix=no need_version=no shlibpath_overrides_runpath=no sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' ;; esac ;; sysv4*MP*) if test -d /usr/nec ;then version_type=linux library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' soname_spec='$libname${shared_ext}.$major' shlibpath_var=LD_LIBRARY_PATH fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) version_type=freebsd-elf need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes if test "$with_gnu_ld" = yes; then sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' shlibpath_overrides_runpath=no else sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' shlibpath_overrides_runpath=yes case $host_os in sco3.2v5*) sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" ;; esac fi sys_lib_dlsearch_path_spec='/usr/lib' ;; uts4*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; *) dynamic_linker=no ;; esac echo "$as_me:$LINENO: result: $dynamic_linker" >&5 echo "${ECHO_T}$dynamic_linker" >&6 test "$dynamic_linker" = no && can_build_shared=no variables_saved_for_relink="PATH $shlibpath_var $runpath_var" if test "$GCC" = yes; then variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi echo "$as_me:$LINENO: checking how to hardcode library paths into programs" >&5 echo $ECHO_N "checking how to hardcode library paths into programs... $ECHO_C" >&6 hardcode_action_F77= if test -n "$hardcode_libdir_flag_spec_F77" || \ test -n "$runpath_var_F77" || \ test "X$hardcode_automatic_F77" = "Xyes" ; then # We can hardcode non-existant directories. if test "$hardcode_direct_F77" != no && # If the only mechanism to avoid hardcoding is shlibpath_var, we # have to relink, otherwise we might link with an installed library # when we should be linking with a yet-to-be-installed one ## test "$_LT_AC_TAGVAR(hardcode_shlibpath_var, F77)" != no && test "$hardcode_minus_L_F77" != no; then # Linking always hardcodes the temporary library directory. hardcode_action_F77=relink else # We can link without hardcoding, and we can hardcode nonexisting dirs. hardcode_action_F77=immediate fi else # We cannot hardcode anything, or else we can only hardcode existing # directories. hardcode_action_F77=unsupported fi echo "$as_me:$LINENO: result: $hardcode_action_F77" >&5 echo "${ECHO_T}$hardcode_action_F77" >&6 if test "$hardcode_action_F77" = relink; then # Fast installation is not supported enable_fast_install=no elif test "$shlibpath_overrides_runpath" = yes || test "$enable_shared" = no; then # Fast installation is not necessary enable_fast_install=needless fi # The else clause should only fire when bootstrapping the # libtool distribution, otherwise you forgot to ship ltmain.sh # with your package, and you will get complaints that there are # no rules to generate ltmain.sh. if test -f "$ltmain"; then # See if we are running on zsh, and set the options which allow our commands through # without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Now quote all the things that may contain metacharacters while being # careful not to overquote the AC_SUBSTed values. We take copies of the # variables and quote the copies for generation of the libtool script. for var in echo old_CC old_CFLAGS AR AR_FLAGS EGREP RANLIB LN_S LTCC LTCFLAGS NM \ SED SHELL STRIP \ libname_spec library_names_spec soname_spec extract_expsyms_cmds \ old_striplib striplib file_magic_cmd finish_cmds finish_eval \ deplibs_check_method reload_flag reload_cmds need_locks \ lt_cv_sys_global_symbol_pipe lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \ old_postinstall_cmds old_postuninstall_cmds \ compiler_F77 \ CC_F77 \ LD_F77 \ lt_prog_compiler_wl_F77 \ lt_prog_compiler_pic_F77 \ lt_prog_compiler_static_F77 \ lt_prog_compiler_no_builtin_flag_F77 \ export_dynamic_flag_spec_F77 \ thread_safe_flag_spec_F77 \ whole_archive_flag_spec_F77 \ enable_shared_with_static_runtimes_F77 \ old_archive_cmds_F77 \ old_archive_from_new_cmds_F77 \ predep_objects_F77 \ postdep_objects_F77 \ predeps_F77 \ postdeps_F77 \ compiler_lib_search_path_F77 \ archive_cmds_F77 \ archive_expsym_cmds_F77 \ postinstall_cmds_F77 \ postuninstall_cmds_F77 \ old_archive_from_expsyms_cmds_F77 \ allow_undefined_flag_F77 \ no_undefined_flag_F77 \ export_symbols_cmds_F77 \ hardcode_libdir_flag_spec_F77 \ hardcode_libdir_flag_spec_ld_F77 \ hardcode_libdir_separator_F77 \ hardcode_automatic_F77 \ module_cmds_F77 \ module_expsym_cmds_F77 \ lt_cv_prog_compiler_c_o_F77 \ exclude_expsyms_F77 \ include_expsyms_F77; do case $var in old_archive_cmds_F77 | \ old_archive_from_new_cmds_F77 | \ archive_cmds_F77 | \ archive_expsym_cmds_F77 | \ module_cmds_F77 | \ module_expsym_cmds_F77 | \ old_archive_from_expsyms_cmds_F77 | \ export_symbols_cmds_F77 | \ extract_expsyms_cmds | reload_cmds | finish_cmds | \ postinstall_cmds | postuninstall_cmds | \ old_postinstall_cmds | old_postuninstall_cmds | \ sys_lib_search_path_spec | sys_lib_dlsearch_path_spec) # Double-quote double-evaled strings. eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ;; *) eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ;; esac done case $lt_echo in *'\$0 --fallback-echo"') lt_echo=`$echo "X$lt_echo" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'` ;; esac cfgfile="$ofile" cat <<__EOF__ >> "$cfgfile" # ### BEGIN LIBTOOL TAG CONFIG: $tagname # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # Shell to use when invoking shell scripts. SHELL=$lt_SHELL # Whether or not to build shared libraries. build_libtool_libs=$enable_shared # Whether or not to build static libraries. build_old_libs=$enable_static # Whether or not to add -lc for building shared libraries. build_libtool_need_lc=$archive_cmds_need_lc_F77 # Whether or not to disallow shared libs when runtime libs are static allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_F77 # Whether or not to optimize for fast installation. fast_install=$enable_fast_install # The host system. host_alias=$host_alias host=$host host_os=$host_os # The build system. build_alias=$build_alias build=$build build_os=$build_os # An echo program that does not interpret backslashes. echo=$lt_echo # The archiver. AR=$lt_AR AR_FLAGS=$lt_AR_FLAGS # A C compiler. LTCC=$lt_LTCC # LTCC compiler flags. LTCFLAGS=$lt_LTCFLAGS # A language-specific compiler. CC=$lt_compiler_F77 # Is the compiler the GNU C compiler? with_gcc=$GCC_F77 gcc_dir=\`gcc -print-file-name=. | $SED 's,/\.$,,'\` gcc_ver=\`gcc -dumpversion\` # An ERE matcher. EGREP=$lt_EGREP # The linker used to build libraries. LD=$lt_LD_F77 # Whether we need hard or soft links. LN_S=$lt_LN_S # A BSD-compatible nm program. NM=$lt_NM # A symbol stripping program STRIP=$lt_STRIP # Used to examine libraries when file_magic_cmd begins "file" MAGIC_CMD=$MAGIC_CMD # Used on cygwin: DLL creation program. DLLTOOL="$DLLTOOL" # Used on cygwin: object dumper. OBJDUMP="$OBJDUMP" # Used on cygwin: assembler. AS="$AS" # The name of the directory that contains temporary libtool files. objdir=$objdir # How to create reloadable object files. reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds # How to pass a linker flag through the compiler. wl=$lt_lt_prog_compiler_wl_F77 # Object file suffix (normally "o"). objext="$ac_objext" # Old archive suffix (normally "a"). libext="$libext" # Shared library suffix (normally ".so"). shrext_cmds='$shrext_cmds' # Executable file suffix (normally ""). exeext="$exeext" # Additional compiler flags for building library objects. pic_flag=$lt_lt_prog_compiler_pic_F77 pic_mode=$pic_mode # What is the maximum length of a command? max_cmd_len=$lt_cv_sys_max_cmd_len # Does compiler simultaneously support -c and -o options? compiler_c_o=$lt_lt_cv_prog_compiler_c_o_F77 # Must we lock files when doing compilation? need_locks=$lt_need_locks # Do we need the lib prefix for modules? need_lib_prefix=$need_lib_prefix # Do we need a version for libraries? need_version=$need_version # Whether dlopen is supported. dlopen_support=$enable_dlopen # Whether dlopen of programs is supported. dlopen_self=$enable_dlopen_self # Whether dlopen of statically linked programs is supported. dlopen_self_static=$enable_dlopen_self_static # Compiler flag to prevent dynamic linking. link_static_flag=$lt_lt_prog_compiler_static_F77 # Compiler flag to turn off builtin functions. no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_F77 # Compiler flag to allow reflexive dlopens. export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_F77 # Compiler flag to generate shared objects directly from archives. whole_archive_flag_spec=$lt_whole_archive_flag_spec_F77 # Compiler flag to generate thread-safe objects. thread_safe_flag_spec=$lt_thread_safe_flag_spec_F77 # Library versioning type. version_type=$version_type # Format of library name prefix. libname_spec=$lt_libname_spec # List of archive names. First name is the real one, the rest are links. # The last name is the one that the linker finds with -lNAME. library_names_spec=$lt_library_names_spec # The coded name of the library, if different from the real name. soname_spec=$lt_soname_spec # Commands used to build and install an old-style archive. RANLIB=$lt_RANLIB old_archive_cmds=$lt_old_archive_cmds_F77 old_postinstall_cmds=$lt_old_postinstall_cmds old_postuninstall_cmds=$lt_old_postuninstall_cmds # Create an old-style archive from a shared archive. old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_F77 # Create a temporary old-style archive to link instead of a shared archive. old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_F77 # Commands used to build and install a shared archive. archive_cmds=$lt_archive_cmds_F77 archive_expsym_cmds=$lt_archive_expsym_cmds_F77 postinstall_cmds=$lt_postinstall_cmds postuninstall_cmds=$lt_postuninstall_cmds # Commands used to build a loadable module (assumed same as above if empty) module_cmds=$lt_module_cmds_F77 module_expsym_cmds=$lt_module_expsym_cmds_F77 # Commands to strip libraries. old_striplib=$lt_old_striplib striplib=$lt_striplib # Dependencies to place before the objects being linked to create a # shared library. predep_objects=\`echo $lt_predep_objects_F77 | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place after the objects being linked to create a # shared library. postdep_objects=\`echo $lt_postdep_objects_F77 | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place before the objects being linked to create a # shared library. predeps=$lt_predeps_F77 # Dependencies to place after the objects being linked to create a # shared library. postdeps=$lt_postdeps_F77 # The library search path used internally by the compiler when linking # a shared library. compiler_lib_search_path=\`echo $lt_compiler_lib_search_path_F77 | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method # Command to use when deplibs_check_method == file_magic. file_magic_cmd=$lt_file_magic_cmd # Flag that allows shared libraries with undefined symbols to be built. allow_undefined_flag=$lt_allow_undefined_flag_F77 # Flag that forces no undefined symbols. no_undefined_flag=$lt_no_undefined_flag_F77 # Commands used to finish a libtool library installation in a directory. finish_cmds=$lt_finish_cmds # Same as above, but a single script fragment to be evaled but not shown. finish_eval=$lt_finish_eval # Take the output of nm and produce a listing of raw symbols and C names. global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe # Transform the output of nm in a proper C declaration global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl # Transform the output of nm in a C name address pair global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address # This is the shared library runtime path variable. runpath_var=$runpath_var # This is the shared library path variable. shlibpath_var=$shlibpath_var # Is shlibpath searched before the hard-coded library search path? shlibpath_overrides_runpath=$shlibpath_overrides_runpath # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action_F77 # Whether we should hardcode library paths into libraries. hardcode_into_libs=$hardcode_into_libs # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_F77 # If ld is used when linking, flag to hardcode \$libdir into # a binary during linking. This must work even if \$libdir does # not exist. hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_F77 # Whether we need a single -rpath flag with a separated argument. hardcode_libdir_separator=$lt_hardcode_libdir_separator_F77 # Set to yes if using DIR/libNAME${shared_ext} during linking hardcodes DIR into the # resulting binary. hardcode_direct=$hardcode_direct_F77 # Set to yes if using the -LDIR flag during linking hardcodes DIR into the # resulting binary. hardcode_minus_L=$hardcode_minus_L_F77 # Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into # the resulting binary. hardcode_shlibpath_var=$hardcode_shlibpath_var_F77 # Set to yes if building a shared library automatically hardcodes DIR into the library # and all subsequent libraries and executables linked against it. hardcode_automatic=$hardcode_automatic_F77 # Variables whose values should be saved in libtool wrapper scripts and # restored at relink time. variables_saved_for_relink="$variables_saved_for_relink" # Whether libtool must link a program against all its dependency libraries. link_all_deplibs=$link_all_deplibs_F77 # Compile-time system search path for libraries sys_lib_search_path_spec=\`echo $lt_sys_lib_search_path_spec | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Run-time system search path for libraries sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec # Fix the shell variable \$srcfile for the compiler. fix_srcfile_path="$fix_srcfile_path_F77" # Set to yes if exported symbols are required. always_export_symbols=$always_export_symbols_F77 # The commands to list exported symbols. export_symbols_cmds=$lt_export_symbols_cmds_F77 # The commands to extract the exported symbol list from a shared archive. extract_expsyms_cmds=$lt_extract_expsyms_cmds # Symbols that should not be listed in the preloaded symbols. exclude_expsyms=$lt_exclude_expsyms_F77 # Symbols that must always be exported. include_expsyms=$lt_include_expsyms_F77 # ### END LIBTOOL TAG CONFIG: $tagname __EOF__ else # If there is no Makefile yet, we rely on a make rule to execute # `config.status --recheck' to rerun these tests and create the # libtool script then. ltmain_in=`echo $ltmain | sed -e 's/\.sh$/.in/'` if test -f "$ltmain_in"; then test -f Makefile && make "$ltmain" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CC="$lt_save_CC" else tagname="" fi ;; GCJ) if test -n "$GCJ" && test "X$GCJ" != "Xno"; then # Source file extension for Java test sources. ac_ext=java # Object file extension for compiled Java test sources. objext=o objext_GCJ=$objext # Code to be used in simple compile tests lt_simple_compile_test_code="class foo {}\n" # Code to be used in simple link tests lt_simple_link_test_code='public class conftest { public static void main(String[] argv) {}; }\n' # ltmain only uses $CC for tagged configurations so make sure $CC is set. # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # save warnings/boilerplate of simple test code ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" >conftest.$ac_ext eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_compiler_boilerplate=`cat conftest.err` $rm conftest* ac_outfile=conftest.$ac_objext printf "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` $rm conftest* # Allow CC to be a program name with arguments. lt_save_CC="$CC" CC=${GCJ-"gcj"} compiler=$CC compiler_GCJ=$CC for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` # GCJ did not exist at the time GCC didn't implicitly link libc in. archive_cmds_need_lc_GCJ=no old_archive_cmds_GCJ=$old_archive_cmds lt_prog_compiler_no_builtin_flag_GCJ= if test "$GCC" = yes; then lt_prog_compiler_no_builtin_flag_GCJ=' -fno-builtin' echo "$as_me:$LINENO: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 echo $ECHO_N "checking if $compiler supports -fno-rtti -fno-exceptions... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_rtti_exceptions+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_rtti_exceptions=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-fno-rtti -fno-exceptions" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:22993: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:22997: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_cv_prog_compiler_rtti_exceptions=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_rtti_exceptions" >&6 if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then lt_prog_compiler_no_builtin_flag_GCJ="$lt_prog_compiler_no_builtin_flag_GCJ -fno-rtti -fno-exceptions" else : fi fi lt_prog_compiler_wl_GCJ= lt_prog_compiler_pic_GCJ= lt_prog_compiler_static_GCJ= echo "$as_me:$LINENO: checking for $compiler option to produce PIC" >&5 echo $ECHO_N "checking for $compiler option to produce PIC... $ECHO_C" >&6 if test "$GCC" = yes; then lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_static_GCJ='-static' case $host_os in aix*) # All AIX code is PIC. if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_GCJ='-Bstatic' fi ;; amigaos*) # FIXME: we need at least 68020 code to build shared libraries, but # adding the `-m68020' flag to GCC prevents building anything better, # like `-m68040'. lt_prog_compiler_pic_GCJ='-m68020 -resident32 -malways-restore-a4' ;; beos* | cygwin* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) # PIC is the default for these OSes. ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_GCJ='-DDLL_EXPORT' ;; darwin* | rhapsody*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files lt_prog_compiler_pic_GCJ='-fno-common' ;; interix3*) # Interix 3.x gcc -fpic/-fPIC options generate broken code. # Instead, we relocate shared libraries at runtime. ;; msdosdjgpp*) # Just because we use GCC doesn't mean we suddenly get shared libraries # on systems that don't support them. lt_prog_compiler_can_build_shared_GCJ=no enable_shared=no ;; sysv4*MP*) if test -d /usr/nec; then lt_prog_compiler_pic_GCJ=-Kconform_pic fi ;; hpux*) # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic_GCJ='-fPIC' ;; esac ;; *) lt_prog_compiler_pic_GCJ='-fPIC' ;; esac else # PORTME Check for flag to pass linker flags through the system compiler. case $host_os in aix*) lt_prog_compiler_wl_GCJ='-Wl,' if test "$host_cpu" = ia64; then # AIX 5 now supports IA64 processor lt_prog_compiler_static_GCJ='-Bstatic' else lt_prog_compiler_static_GCJ='-bnso -bI:/lib/syscalls.exp' fi ;; darwin*) # PIC is the default on this platform # Common symbols not allowed in MH_DYLIB files case $cc_basename in xlc*) lt_prog_compiler_pic_GCJ='-qnocommon' lt_prog_compiler_wl_GCJ='-Wl,' ;; esac ;; mingw* | pw32* | os2*) # This hack is so that the source file can tell whether it is being # built for inclusion in a dll (and should export symbols for example). lt_prog_compiler_pic_GCJ='-DDLL_EXPORT' ;; hpux9* | hpux10* | hpux11*) lt_prog_compiler_wl_GCJ='-Wl,' # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but # not for PA HP-UX. case $host_cpu in hppa*64*|ia64*) # +Z the default ;; *) lt_prog_compiler_pic_GCJ='+Z' ;; esac # Is there a better lt_prog_compiler_static that works with the bundled CC? lt_prog_compiler_static_GCJ='${wl}-a ${wl}archive' ;; irix5* | irix6* | nonstopux*) lt_prog_compiler_wl_GCJ='-Wl,' # PIC (with -KPIC) is the default. lt_prog_compiler_static_GCJ='-non_shared' ;; newsos6) lt_prog_compiler_pic_GCJ='-KPIC' lt_prog_compiler_static_GCJ='-Bstatic' ;; linux*) case $cc_basename in icc* | ecc*) lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_pic_GCJ='-KPIC' lt_prog_compiler_static_GCJ='-static' ;; pgcc* | pgf77* | pgf90* | pgf95*) # Portland Group compilers (*not* the Pentium gcc compiler, # which looks to be a dead project) lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_pic_GCJ='-fpic' lt_prog_compiler_static_GCJ='-Bstatic' ;; ccc*) lt_prog_compiler_wl_GCJ='-Wl,' # All Alpha code is PIC. lt_prog_compiler_static_GCJ='-non_shared' ;; esac ;; osf3* | osf4* | osf5*) lt_prog_compiler_wl_GCJ='-Wl,' # All OSF/1 code is PIC. lt_prog_compiler_static_GCJ='-non_shared' ;; solaris*) lt_prog_compiler_pic_GCJ='-KPIC' lt_prog_compiler_static_GCJ='-Bstatic' case $cc_basename in f77* | f90* | f95*) lt_prog_compiler_wl_GCJ='-Qoption ld ';; *) lt_prog_compiler_wl_GCJ='-Wl,';; esac ;; sunos4*) lt_prog_compiler_wl_GCJ='-Qoption ld ' lt_prog_compiler_pic_GCJ='-PIC' lt_prog_compiler_static_GCJ='-Bstatic' ;; sysv4 | sysv4.2uw2* | sysv4.3*) lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_pic_GCJ='-KPIC' lt_prog_compiler_static_GCJ='-Bstatic' ;; sysv4*MP*) if test -d /usr/nec ;then lt_prog_compiler_pic_GCJ='-Kconform_pic' lt_prog_compiler_static_GCJ='-Bstatic' fi ;; sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_pic_GCJ='-KPIC' lt_prog_compiler_static_GCJ='-Bstatic' ;; unicos*) lt_prog_compiler_wl_GCJ='-Wl,' lt_prog_compiler_can_build_shared_GCJ=no ;; uts4*) lt_prog_compiler_pic_GCJ='-pic' lt_prog_compiler_static_GCJ='-Bstatic' ;; *) lt_prog_compiler_can_build_shared_GCJ=no ;; esac fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_GCJ" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_GCJ" >&6 # # Check to make sure the PIC flag actually works. # if test -n "$lt_prog_compiler_pic_GCJ"; then echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_prog_compiler_pic_GCJ works" >&5 echo $ECHO_N "checking if $compiler PIC flag $lt_prog_compiler_pic_GCJ works... $ECHO_C" >&6 if test "${lt_prog_compiler_pic_works_GCJ+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_pic_works_GCJ=no ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="$lt_prog_compiler_pic_GCJ" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. # The option is referenced via a variable to avoid confusing sed. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:23261: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 echo "$as_me:23265: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' >conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_pic_works_GCJ=yes fi fi $rm conftest* fi echo "$as_me:$LINENO: result: $lt_prog_compiler_pic_works_GCJ" >&5 echo "${ECHO_T}$lt_prog_compiler_pic_works_GCJ" >&6 if test x"$lt_prog_compiler_pic_works_GCJ" = xyes; then case $lt_prog_compiler_pic_GCJ in "" | " "*) ;; *) lt_prog_compiler_pic_GCJ=" $lt_prog_compiler_pic_GCJ" ;; esac else lt_prog_compiler_pic_GCJ= lt_prog_compiler_can_build_shared_GCJ=no fi fi case $host_os in # For platforms which do not support PIC, -DPIC is meaningless: *djgpp*) lt_prog_compiler_pic_GCJ= ;; *) lt_prog_compiler_pic_GCJ="$lt_prog_compiler_pic_GCJ" ;; esac # # Check to make sure the static flag actually works. # wl=$lt_prog_compiler_wl_GCJ eval lt_tmp_static_flag=\"$lt_prog_compiler_static_GCJ\" echo "$as_me:$LINENO: checking if $compiler static flag $lt_tmp_static_flag works" >&5 echo $ECHO_N "checking if $compiler static flag $lt_tmp_static_flag works... $ECHO_C" >&6 if test "${lt_prog_compiler_static_works_GCJ+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_prog_compiler_static_works_GCJ=no save_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $lt_tmp_static_flag" printf "$lt_simple_link_test_code" > conftest.$ac_ext if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then # The linker can only warn and ignore the option if not recognized # So say no if there are warnings if test -s conftest.err; then # Append any errors to the config.log. cat conftest.err 1>&5 $echo "X$_lt_linker_boilerplate" | $Xsed -e '/^$/d' > conftest.exp $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 if diff conftest.exp conftest.er2 >/dev/null; then lt_prog_compiler_static_works_GCJ=yes fi else lt_prog_compiler_static_works_GCJ=yes fi fi $rm conftest* LDFLAGS="$save_LDFLAGS" fi echo "$as_me:$LINENO: result: $lt_prog_compiler_static_works_GCJ" >&5 echo "${ECHO_T}$lt_prog_compiler_static_works_GCJ" >&6 if test x"$lt_prog_compiler_static_works_GCJ" = xyes; then : else lt_prog_compiler_static_GCJ= fi echo "$as_me:$LINENO: checking if $compiler supports -c -o file.$ac_objext" >&5 echo $ECHO_N "checking if $compiler supports -c -o file.$ac_objext... $ECHO_C" >&6 if test "${lt_cv_prog_compiler_c_o_GCJ+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else lt_cv_prog_compiler_c_o_GCJ=no $rm -r conftest 2>/dev/null mkdir conftest cd conftest mkdir out printf "$lt_simple_compile_test_code" > conftest.$ac_ext lt_compiler_flag="-o out/conftest2.$ac_objext" # Insert the option either (1) after the last *FLAGS variable, or # (2) before a word containing "conftest.", or (3) at the end. # Note that $ac_compile itself does not contain backslashes and begins # with a dollar sign (not a hyphen), so the echo should work correctly. lt_compile=`echo "$ac_compile" | $SED \ -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` (eval echo "\"\$as_me:23365: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 echo "$as_me:23369: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings $echo "X$_lt_compiler_boilerplate" | $Xsed -e '/^$/d' > out/conftest.exp $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then lt_cv_prog_compiler_c_o_GCJ=yes fi fi chmod u+w . 2>&5 $rm conftest* # SGI C++ compiler will create directory out/ii_files/ for # template instantiation test -d out/ii_files && $rm out/ii_files/* && rmdir out/ii_files $rm out/* && rmdir out cd .. rmdir conftest $rm conftest* fi echo "$as_me:$LINENO: result: $lt_cv_prog_compiler_c_o_GCJ" >&5 echo "${ECHO_T}$lt_cv_prog_compiler_c_o_GCJ" >&6 hard_links="nottested" if test "$lt_cv_prog_compiler_c_o_GCJ" = no && test "$need_locks" != no; then # do not overwrite the value of need_locks provided by the user echo "$as_me:$LINENO: checking if we can lock with hard links" >&5 echo $ECHO_N "checking if we can lock with hard links... $ECHO_C" >&6 hard_links=yes $rm conftest* ln conftest.a conftest.b 2>/dev/null && hard_links=no touch conftest.a ln conftest.a conftest.b 2>&5 || hard_links=no ln conftest.a conftest.b 2>/dev/null && hard_links=no echo "$as_me:$LINENO: result: $hard_links" >&5 echo "${ECHO_T}$hard_links" >&6 if test "$hard_links" = no; then { echo "$as_me:$LINENO: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} need_locks=warn fi else need_locks=no fi echo "$as_me:$LINENO: checking whether the $compiler linker ($LD) supports shared libraries" >&5 echo $ECHO_N "checking whether the $compiler linker ($LD) supports shared libraries... $ECHO_C" >&6 runpath_var= allow_undefined_flag_GCJ= enable_shared_with_static_runtimes_GCJ=no archive_cmds_GCJ= archive_expsym_cmds_GCJ= old_archive_From_new_cmds_GCJ= old_archive_from_expsyms_cmds_GCJ= export_dynamic_flag_spec_GCJ= whole_archive_flag_spec_GCJ= thread_safe_flag_spec_GCJ= hardcode_libdir_flag_spec_GCJ= hardcode_libdir_flag_spec_ld_GCJ= hardcode_libdir_separator_GCJ= hardcode_direct_GCJ=no hardcode_minus_L_GCJ=no hardcode_shlibpath_var_GCJ=unsupported link_all_deplibs_GCJ=unknown hardcode_automatic_GCJ=no module_cmds_GCJ= module_expsym_cmds_GCJ= always_export_symbols_GCJ=no export_symbols_cmds_GCJ='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' # include_expsyms should be a list of space-separated symbols to be *always* # included in the symbol list include_expsyms_GCJ= # exclude_expsyms can be an extended regexp of symbols to exclude # it will be wrapped by ` (' and `)$', so one must not match beginning or # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', # as well as any symbol that contains `d'. exclude_expsyms_GCJ="_GLOBAL_OFFSET_TABLE_" # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out # platforms (ab)use it in PIC code, but their linkers get confused if # the symbol is explicitly referenced. Since portable code cannot # rely on this symbol name, it's probably fine to never include it in # preloaded symbol tables. extract_expsyms_cmds= # Just being paranoid about ensuring that cc_basename is set. for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` case $host_os in cygwin* | mingw* | pw32*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. if test "$GCC" != yes; then with_gnu_ld=no fi ;; interix*) # we just hope/assume this is gcc and not c89 (= MSVC++) with_gnu_ld=yes ;; openbsd*) with_gnu_ld=no ;; esac ld_shlibs_GCJ=yes if test "$with_gnu_ld" = yes; then # If archive_cmds runs LD, not CC, wlarc should be empty wlarc='${wl}' # Set some defaults for GNU ld with shared library support. These # are reset later if shared libraries are not supported. Putting them # here allows them to be overridden if necessary. runpath_var=LD_RUN_PATH hardcode_libdir_flag_spec_GCJ='${wl}--rpath ${wl}$libdir' export_dynamic_flag_spec_GCJ='${wl}--export-dynamic' # ancient GNU ld didn't support --whole-archive et. al. if $LD --help 2>&1 | grep 'no-whole-archive' > /dev/null; then whole_archive_flag_spec_GCJ="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' else whole_archive_flag_spec_GCJ= fi supports_anon_versioning=no case `$LD -v 2>/dev/null` in *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... *\ 2.11.*) ;; # other 2.11 versions *) supports_anon_versioning=yes ;; esac # See if GNU ld supports shared libraries. case $host_os in aix3* | aix4* | aix5*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs_GCJ=no cat <&2 *** Warning: the GNU linker, at least up to release 2.9.1, is reported *** to be unable to reliably create shared libraries on AIX. *** Therefore, libtool is disabling shared libraries support. If you *** really care for shared libraries, you may want to modify your PATH *** so that a non-GNU linker is found, and then restart. EOF fi ;; amigaos*) archive_cmds_GCJ='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_minus_L_GCJ=yes # Samuel A. Falvo II reports # that the semantics of dynamic libraries on AmigaOS, at least up # to version 4, is to share data among multiple programs linked # with the same dynamic library. Since this doesn't match the # behavior of shared libraries on other platforms, we can't use # them. ld_shlibs_GCJ=no ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then allow_undefined_flag_GCJ=unsupported # Joseph Beckenbach says some releases of gcc # support --undefined. This deserves some investigation. FIXME archive_cmds_GCJ='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' else ld_shlibs_GCJ=no fi ;; cygwin* | mingw* | pw32*) # _LT_AC_TAGVAR(hardcode_libdir_flag_spec, GCJ) is actually meaningless, # as there is no search path for DLLs. hardcode_libdir_flag_spec_GCJ='-L$libdir' allow_undefined_flag_GCJ=unsupported always_export_symbols_GCJ=no enable_shared_with_static_runtimes_GCJ=yes export_symbols_cmds_GCJ='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS] /s/.* \([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW] /s/.* //'\'' | sort | uniq > $export_symbols' if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' # If the export-symbols file already is a .def file (1st line # is EXPORTS), use it as is; otherwise, prepend... archive_expsym_cmds_GCJ='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then cp $export_symbols $output_objdir/$soname.def; else echo EXPORTS > $output_objdir/$soname.def; cat $export_symbols >> $output_objdir/$soname.def; fi~ $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' else ld_shlibs_GCJ=no fi ;; interix3*) hardcode_direct_GCJ=no hardcode_shlibpath_var_GCJ=no hardcode_libdir_flag_spec_GCJ='${wl}-rpath,$libdir' export_dynamic_flag_spec_GCJ='${wl}-E' # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. # Instead, shared libraries are loaded at an image base (0x10000000 by # default) and relocated if they conflict, which is a slow very memory # consuming and fragmenting process. To avoid this, we pick a random, # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link # time. Moving up from 0x10000000 also allows more sbrk(2) space. archive_cmds_GCJ='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' archive_expsym_cmds_GCJ='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' ;; linux*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then tmp_addflag= case $cc_basename,$host_cpu in pgcc*) # Portland Group C compiler whole_archive_flag_spec_GCJ='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag' ;; pgf77* | pgf90* | pgf95*) # Portland Group f77 and f90 compilers whole_archive_flag_spec_GCJ='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}--no-whole-archive' tmp_addflag=' $pic_flag -Mnomain' ;; ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 tmp_addflag=' -i_dynamic' ;; efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 tmp_addflag=' -i_dynamic -nofor_main' ;; ifc* | ifort*) # Intel Fortran compiler tmp_addflag=' -nofor_main' ;; esac archive_cmds_GCJ='$CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' if test $supports_anon_versioning = yes; then archive_expsym_cmds_GCJ='$echo "{ global:" > $output_objdir/$libname.ver~ cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ $echo "local: *; };" >> $output_objdir/$libname.ver~ $CC -shared'"$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' fi else ld_shlibs_GCJ=no fi ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds_GCJ='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' wlarc= else archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' fi ;; solaris*) if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then ld_shlibs_GCJ=no cat <&2 *** Warning: The releases 2.8.* of the GNU linker cannot reliably *** create shared libraries on Solaris systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.9.1 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. EOF elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs_GCJ=no fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) case `$LD -v 2>&1` in *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) ld_shlibs_GCJ=no cat <<_LT_EOF 1>&2 *** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not *** reliably create shared libraries on SCO systems. Therefore, libtool *** is disabling shared libraries support. We urge you to upgrade GNU *** binutils to release 2.16.91.0.3 or newer. Another option is to modify *** your PATH or compiler configuration so that the native linker is *** used, and then restart. _LT_EOF ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then hardcode_libdir_flag_spec_GCJ='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`' archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib' archive_expsym_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname,\${SCOABSPATH:+${install_libdir}/}$soname,-retain-symbols-file,$export_symbols -o $lib' else ld_shlibs_GCJ=no fi ;; esac ;; sunos4*) archive_cmds_GCJ='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' wlarc= hardcode_direct_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' archive_expsym_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' else ld_shlibs_GCJ=no fi ;; esac if test "$ld_shlibs_GCJ" = no; then runpath_var= hardcode_libdir_flag_spec_GCJ= export_dynamic_flag_spec_GCJ= whole_archive_flag_spec_GCJ= fi else # PORTME fill in a description of your system's linker (not GNU ld) case $host_os in aix3*) allow_undefined_flag_GCJ=unsupported always_export_symbols_GCJ=yes archive_expsym_cmds_GCJ='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' # Note: this linker hardcodes the directories in LIBPATH if there # are no directories specified by -L. hardcode_minus_L_GCJ=yes if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then # Neither direct hardcoding nor static linking is supported with a # broken collect2. hardcode_direct_GCJ=unsupported fi ;; aix4* | aix5*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. aix_use_runtimelinking=no exp_sym_flag='-Bexport' no_entry_flag="" else # If we're using GNU nm, then we don't want the "-C" option. # -C means demangle to AIX nm, but means don't demangle with GNU nm if $NM -V 2>&1 | grep 'GNU' > /dev/null; then export_symbols_cmds_GCJ='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' else export_symbols_cmds_GCJ='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$2 == "T") || (\$2 == "D") || (\$2 == "B")) && (substr(\$3,1,1) != ".")) { print \$3 } }'\'' | sort -u > $export_symbols' fi aix_use_runtimelinking=no # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. case $host_os in aix4.[23]|aix4.[23].*|aix5*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes break fi done ;; esac exp_sym_flag='-bexport' no_entry_flag='-bnoentry' fi # When large executables or shared objects are built, AIX ld can # have problems creating the table of contents. If linking a library # or program results in "error TOC overflow" add -mminimal-toc to # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. archive_cmds_GCJ='' hardcode_direct_GCJ=yes hardcode_libdir_separator_GCJ=':' link_all_deplibs_GCJ=yes if test "$GCC" = yes; then case $host_os in aix4.[012]|aix4.[012].*) # We only want to do this on AIX 4.2 and lower, the check # below for broken collect2 doesn't work under 4.3+ collect2name=`${CC} -print-prog-name=collect2` if test -f "$collect2name" && \ strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 hardcode_direct_GCJ=yes else # We have old collect2 hardcode_direct_GCJ=unsupported # It fails to find uninstalled libraries when the uninstalled # path is not listed in the libpath. Setting hardcode_minus_L # to unsupported forces relinking hardcode_minus_L_GCJ=yes hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_libdir_separator_GCJ= fi ;; esac shared_flag='-shared' if test "$aix_use_runtimelinking" = yes; then shared_flag="$shared_flag "'${wl}-G' fi else # not using gcc if test "$host_cpu" = ia64; then # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release # chokes on -Wl,-G. The following line is correct: shared_flag='-G' else if test "$aix_use_runtimelinking" = yes; then shared_flag='${wl}-G' else shared_flag='${wl}-bM:SRE' fi fi fi # It seems that -bexpall does not export symbols beginning with # underscore (_), so it is better to generate a list of symbols to export. always_export_symbols_GCJ=yes if test "$aix_use_runtimelinking" = yes; then # Warning - without using the other runtime loading flags (-brtl), # -berok will link without error, but may produce a broken library. allow_undefined_flag_GCJ='-berok' # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_GCJ='${wl}-blibpath:$libdir:'"$aix_libpath" archive_expsym_cmds_GCJ="\$CC"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" else if test "$host_cpu" = ia64; then hardcode_libdir_flag_spec_GCJ='${wl}-R $libdir:/usr/lib:/lib' allow_undefined_flag_GCJ="-z nodefs" archive_expsym_cmds_GCJ="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" else # Determine the default libpath from the value encoded in an empty executable. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` # Check for a 64-bit object if we didn't find anything. if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'`; fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi hardcode_libdir_flag_spec_GCJ='${wl}-blibpath:$libdir:'"$aix_libpath" # Warning - without using the other run time loading flags, # -berok will link without error, but may produce a broken library. no_undefined_flag_GCJ=' ${wl}-bernotok' allow_undefined_flag_GCJ=' ${wl}-berok' # Exported symbols can be pulled into shared objects from archives whole_archive_flag_spec_GCJ='$convenience' archive_cmds_need_lc_GCJ=yes # This is similar to how AIX traditionally builds its shared libraries. archive_expsym_cmds_GCJ="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' fi fi ;; amigaos*) archive_cmds_GCJ='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_minus_L_GCJ=yes # see comment about different semantics on the GNU ld section ld_shlibs_GCJ=no ;; bsdi[45]*) export_dynamic_flag_spec_GCJ=-rdynamic ;; cygwin* | mingw* | pw32*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is # no search path for DLLs. hardcode_libdir_flag_spec_GCJ=' ' allow_undefined_flag_GCJ=unsupported # Tell ltmain to make .lib files, not .a files. libext=lib # Tell ltmain to make .dll files, not .so files. shrext_cmds=".dll" # FIXME: Setting linknames here is a bad hack. archive_cmds_GCJ='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | $SED -e '\''s/ -lc$//'\''` -link -dll~linknames=' # The linker will automatically build a .lib file if we build a DLL. old_archive_From_new_cmds_GCJ='true' # FIXME: Should let the user specify the lib program. old_archive_cmds_GCJ='lib /OUT:$oldlib$oldobjs$old_deplibs' fix_srcfile_path_GCJ='`cygpath -w "$srcfile"`' enable_shared_with_static_runtimes_GCJ=yes ;; darwin* | rhapsody*) case $host_os in rhapsody* | darwin1.[012]) allow_undefined_flag_GCJ='${wl}-undefined ${wl}suppress' ;; *) # Darwin 1.3 on if test -z ${MACOSX_DEPLOYMENT_TARGET} ; then allow_undefined_flag_GCJ='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' else case ${MACOSX_DEPLOYMENT_TARGET} in 10.[012]) allow_undefined_flag_GCJ='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; 10.*) allow_undefined_flag_GCJ='${wl}-undefined ${wl}dynamic_lookup' ;; esac fi ;; esac archive_cmds_need_lc_GCJ=no hardcode_direct_GCJ=no hardcode_automatic_GCJ=yes hardcode_shlibpath_var_GCJ=unsupported whole_archive_flag_spec_GCJ='' link_all_deplibs_GCJ=yes if test "$GCC" = yes ; then output_verbose_link_cmd='echo' archive_cmds_GCJ='$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring' module_cmds_GCJ='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds_GCJ='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -dynamiclib $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags -install_name $rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds_GCJ='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' else case $cc_basename in xlc*) output_verbose_link_cmd='echo' archive_cmds_GCJ='$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}`echo $rpath/$soname` $verstring' module_cmds_GCJ='$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags' # Don't fix this by using the ld -exported_symbols_list flag, it doesn't exist in older darwin lds archive_expsym_cmds_GCJ='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC -qmkshrobj $allow_undefined_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-install_name ${wl}$rpath/$soname $verstring~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' module_expsym_cmds_GCJ='sed -e "s,#.*,," -e "s,^[ ]*,," -e "s,^\(..*\),_&," < $export_symbols > $output_objdir/${libname}-symbols.expsym~$CC $allow_undefined_flag -o $lib -bundle $libobjs $deplibs$compiler_flags~nmedit -s $output_objdir/${libname}-symbols.expsym ${lib}' ;; *) ld_shlibs_GCJ=no ;; esac fi ;; dgux*) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_shlibpath_var_GCJ=no ;; freebsd1*) ld_shlibs_GCJ=no ;; # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor # support. Future versions do this automatically, but an explicit c++rt0.o # does not break anything, and helps significantly (at the cost of a little # extra space). freebsd2.2*) archive_cmds_GCJ='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' hardcode_libdir_flag_spec_GCJ='-R$libdir' hardcode_direct_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; # Unfortunately, older versions of FreeBSD 2 do not have this feature. freebsd2*) archive_cmds_GCJ='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_GCJ=yes hardcode_minus_L_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; # FreeBSD 3 and greater uses gcc -shared to do shared libraries. freebsd* | kfreebsd*-gnu | dragonfly*) archive_cmds_GCJ='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec_GCJ='-R$libdir' hardcode_direct_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; hpux9*) if test "$GCC" = yes; then archive_cmds_GCJ='$rm $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' else archive_cmds_GCJ='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' fi hardcode_libdir_flag_spec_GCJ='${wl}+b ${wl}$libdir' hardcode_libdir_separator_GCJ=: hardcode_direct_GCJ=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_GCJ=yes export_dynamic_flag_spec_GCJ='${wl}-E' ;; hpux10*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then archive_cmds_GCJ='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_GCJ='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec_GCJ='${wl}+b ${wl}$libdir' hardcode_libdir_separator_GCJ=: hardcode_direct_GCJ=yes export_dynamic_flag_spec_GCJ='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_GCJ=yes fi ;; hpux11*) if test "$GCC" = yes -a "$with_gnu_ld" = no; then case $host_cpu in hppa*64*) archive_cmds_GCJ='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds_GCJ='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_GCJ='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac else case $host_cpu in hppa*64*) archive_cmds_GCJ='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' ;; ia64*) archive_cmds_GCJ='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' ;; *) archive_cmds_GCJ='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' ;; esac fi if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec_GCJ='${wl}+b ${wl}$libdir' hardcode_libdir_separator_GCJ=: case $host_cpu in hppa*64*|ia64*) hardcode_libdir_flag_spec_ld_GCJ='+b $libdir' hardcode_direct_GCJ=no hardcode_shlibpath_var_GCJ=no ;; *) hardcode_direct_GCJ=yes export_dynamic_flag_spec_GCJ='${wl}-E' # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L_GCJ=yes ;; esac fi ;; irix5* | irix6* | nonstopux*) if test "$GCC" = yes; then archive_cmds_GCJ='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else archive_cmds_GCJ='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_ld_GCJ='-rpath $libdir' fi hardcode_libdir_flag_spec_GCJ='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_GCJ=: link_all_deplibs_GCJ=yes ;; netbsd*) if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then archive_cmds_GCJ='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out else archive_cmds_GCJ='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF fi hardcode_libdir_flag_spec_GCJ='-R$libdir' hardcode_direct_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; newsos6) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_GCJ=yes hardcode_libdir_flag_spec_GCJ='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_GCJ=: hardcode_shlibpath_var_GCJ=no ;; openbsd*) hardcode_direct_GCJ=yes hardcode_shlibpath_var_GCJ=no if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then archive_cmds_GCJ='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' hardcode_libdir_flag_spec_GCJ='${wl}-rpath,$libdir' export_dynamic_flag_spec_GCJ='${wl}-E' else case $host_os in openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) archive_cmds_GCJ='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_GCJ='-R$libdir' ;; *) archive_cmds_GCJ='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' hardcode_libdir_flag_spec_GCJ='${wl}-rpath,$libdir' ;; esac fi ;; os2*) hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_minus_L_GCJ=yes allow_undefined_flag_GCJ=unsupported archive_cmds_GCJ='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' old_archive_From_new_cmds_GCJ='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' ;; osf3*) if test "$GCC" = yes; then allow_undefined_flag_GCJ=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_GCJ='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' else allow_undefined_flag_GCJ=' -expect_unresolved \*' archive_cmds_GCJ='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' fi hardcode_libdir_flag_spec_GCJ='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator_GCJ=: ;; osf4* | osf5*) # as osf3* with the addition of -msym flag if test "$GCC" = yes; then allow_undefined_flag_GCJ=' ${wl}-expect_unresolved ${wl}\*' archive_cmds_GCJ='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' hardcode_libdir_flag_spec_GCJ='${wl}-rpath ${wl}$libdir' else allow_undefined_flag_GCJ=' -expect_unresolved \*' archive_cmds_GCJ='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib' archive_expsym_cmds_GCJ='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib~$rm $lib.exp' # Both c and cxx compiler support -rpath directly hardcode_libdir_flag_spec_GCJ='-rpath $libdir' fi hardcode_libdir_separator_GCJ=: ;; solaris*) no_undefined_flag_GCJ=' -z text' if test "$GCC" = yes; then wlarc='${wl}' archive_cmds_GCJ='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $CC -shared ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$rm $lib.exp' else wlarc='' archive_cmds_GCJ='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' archive_expsym_cmds_GCJ='$echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp' fi hardcode_libdir_flag_spec_GCJ='-R$libdir' hardcode_shlibpath_var_GCJ=no case $host_os in solaris2.[0-5] | solaris2.[0-5].*) ;; *) # The compiler driver will combine linker options so we # cannot just pass the convience library names through # without $wl, iff we do not link with $LD. # Luckily, gcc supports the same syntax we need for Sun Studio. # Supported since Solaris 2.6 (maybe 2.5.1?) case $wlarc in '') whole_archive_flag_spec_GCJ='-z allextract$convenience -z defaultextract' ;; *) whole_archive_flag_spec_GCJ='${wl}-z ${wl}allextract`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; $echo \"$new_convenience\"` ${wl}-z ${wl}defaultextract' ;; esac ;; esac link_all_deplibs_GCJ=yes ;; sunos4*) if test "x$host_vendor" = xsequent; then # Use $CC to link under sequent, because it throws in some extra .o # files that make .init and .fini sections work. archive_cmds_GCJ='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_GCJ='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' fi hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_direct_GCJ=yes hardcode_minus_L_GCJ=yes hardcode_shlibpath_var_GCJ=no ;; sysv4) case $host_vendor in sni) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_GCJ=yes # is this really true??? ;; siemens) ## LD is ld it makes a PLAMLIB ## CC just makes a GrossModule. archive_cmds_GCJ='$LD -G -o $lib $libobjs $deplibs $linker_flags' reload_cmds_GCJ='$CC -r -o $output$reload_objs' hardcode_direct_GCJ=no ;; motorola) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_direct_GCJ=no #Motorola manual says yes, but my tests say they lie ;; esac runpath_var='LD_RUN_PATH' hardcode_shlibpath_var_GCJ=no ;; sysv4.3*) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var_GCJ=no export_dynamic_flag_spec_GCJ='-Bexport' ;; sysv4*MP*) if test -d /usr/nec; then archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_shlibpath_var_GCJ=no runpath_var=LD_RUN_PATH hardcode_runpath_var=yes ld_shlibs_GCJ=yes fi ;; sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7*) no_undefined_flag_GCJ='${wl}-z,text' archive_cmds_need_lc_GCJ=no hardcode_shlibpath_var_GCJ=no runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds_GCJ='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_GCJ='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; sysv5* | sco3.2v5* | sco5v6*) # Note: We can NOT use -z defs as we might desire, because we do not # link with -lc, and that would cause any symbols used from libc to # always be unresolved, which means just about no library would # ever link correctly. If we're not using GNU ld we use -z text # though, which does catch some bad symbols but isn't as heavy-handed # as -z defs. no_undefined_flag_GCJ='${wl}-z,text' allow_undefined_flag_GCJ='${wl}-z,nodefs' archive_cmds_need_lc_GCJ=no hardcode_shlibpath_var_GCJ=no hardcode_libdir_flag_spec_GCJ='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' hardcode_libdir_separator_GCJ=':' link_all_deplibs_GCJ=yes export_dynamic_flag_spec_GCJ='${wl}-Bexport' runpath_var='LD_RUN_PATH' if test "$GCC" = yes; then archive_cmds_GCJ='$CC -shared ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' else archive_cmds_GCJ='$CC -G ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' archive_expsym_cmds_GCJ='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,\${SCOABSPATH:+${install_libdir}/}$soname -o $lib $libobjs $deplibs $compiler_flags' fi ;; uts4*) archive_cmds_GCJ='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' hardcode_libdir_flag_spec_GCJ='-L$libdir' hardcode_shlibpath_var_GCJ=no ;; *) ld_shlibs_GCJ=no ;; esac fi echo "$as_me:$LINENO: result: $ld_shlibs_GCJ" >&5 echo "${ECHO_T}$ld_shlibs_GCJ" >&6 test "$ld_shlibs_GCJ" = no && can_build_shared=no # # Do we need to explicitly link libc? # case "x$archive_cmds_need_lc_GCJ" in x|xyes) # Assume -lc should be added archive_cmds_need_lc_GCJ=yes if test "$enable_shared" = yes && test "$GCC" = yes; then case $archive_cmds_GCJ in *'~'*) # FIXME: we may have to deal with multi-command sequences. ;; '$CC '*) # Test whether the compiler implicitly links with -lc since on some # systems, -lgcc has to come before -lc. If gcc already passes -lc # to ld, don't add -lc before -lgcc. echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5 echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6 $rm conftest* printf "$lt_simple_compile_test_code" > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } 2>conftest.err; then soname=conftest lib=conftest libobjs=conftest.$ac_objext deplibs= wl=$lt_prog_compiler_wl_GCJ pic_flag=$lt_prog_compiler_pic_GCJ compiler_flags=-v linker_flags=-v verstring= output_objdir=. libname=conftest lt_save_allow_undefined_flag=$allow_undefined_flag_GCJ allow_undefined_flag_GCJ= if { (eval echo "$as_me:$LINENO: \"$archive_cmds_GCJ 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1\"") >&5 (eval $archive_cmds_GCJ 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } then archive_cmds_need_lc_GCJ=no else archive_cmds_need_lc_GCJ=yes fi allow_undefined_flag_GCJ=$lt_save_allow_undefined_flag else cat conftest.err 1>&5 fi $rm conftest* echo "$as_me:$LINENO: result: $archive_cmds_need_lc_GCJ" >&5 echo "${ECHO_T}$archive_cmds_need_lc_GCJ" >&6 ;; esac fi ;; esac echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5 echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6 library_names_spec= libname_spec='lib$name' soname_spec= shrext_cmds=".so" postinstall_cmds= postuninstall_cmds= finish_cmds= finish_eval= shlibpath_var= shlibpath_overrides_runpath=unknown version_type=none dynamic_linker="$host_os ld.so" sys_lib_dlsearch_path_spec="/lib /usr/lib" if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';' >/dev/null ; then # if the path contains ";" then we assume it to be the separator # otherwise default to the standard path separator (i.e. ":") - it is # assumed that no part of a normal pathname contains ";" but that should # okay in the real world where ";" in dirpaths is itself problematic. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi else sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" fi need_lib_prefix=unknown hardcode_into_libs=no # when you set need_version to no, make sure it does not cause -set_version # flags to be left without arguments need_version=unknown case $host_os in aix3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' shlibpath_var=LIBPATH # AIX 3 has no versioning support, so we append a major version to the name. soname_spec='${libname}${release}${shared_ext}$major' ;; aix4* | aix5*) version_type=linux need_lib_prefix=no need_version=no hardcode_into_libs=yes if test "$host_cpu" = ia64; then # AIX 5 supports IA64 library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH else # With GCC up to 2.95.x, collect2 would create an import file # for dependence libraries. The import file would start with # the line `#! .'. This would cause the generated library to # depend on `.', always an invalid library. This was fixed in # development snapshots of GCC prior to 3.0. case $host_os in aix4 | aix4.[01] | aix4.[01].*) if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' echo ' yes ' echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then : else can_build_shared=no fi ;; esac # AIX (on Power*) has no versioning support, so currently we can not hardcode correct # soname into executable. Probably we can add versioning support to # collect2, so additional links can be useful in future. if test "$aix_use_runtimelinking" = yes; then # If using run time linking (on AIX 4.2 or later) use lib.so # instead of lib.a to let people know that these are not # typical AIX shared libraries. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' else # We preserve .a as extension for shared libraries through AIX4.2 # and later when we are not doing run time linking. library_names_spec='${libname}${release}.a $libname.a' soname_spec='${libname}${release}${shared_ext}$major' fi shlibpath_var=LIBPATH fi ;; amigaos*) library_names_spec='$libname.ixlibrary $libname.a' # Create ${libname}_ixlibrary.a entries in /sys/libs. finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' ;; beos*) library_names_spec='${libname}${shared_ext}' dynamic_linker="$host_os ld.so" shlibpath_var=LIBRARY_PATH ;; bsdi[45]*) version_type=linux need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" # the default ld.so.conf also contains /usr/contrib/lib and # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow # libtool to hard-code these into programs ;; cygwin* | mingw* | pw32*) version_type=windows shrext_cmds=".dll" need_version=no need_lib_prefix=no case $GCC,$host_os in yes,cygwin* | yes,mingw* | yes,pw32*) library_names_spec='$libname.dll.a' # DLL is installed to $(libdir)/../bin by postinstall_cmds postinstall_cmds='base_file=`basename \${file}`~ dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i;echo \$dlname'\''`~ dldir=$destdir/`dirname \$dlpath`~ test -d \$dldir || mkdir -p \$dldir~ $install_prog $dir/$dlname \$dldir/$dlname~ chmod a+x \$dldir/$dlname' postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ dlpath=$dir/\$dldll~ $rm \$dlpath' shlibpath_overrides_runpath=yes case $host_os in cygwin*) # Cygwin DLLs use 'cyg' prefix rather than 'lib' soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec="/usr/lib /lib/w32api /lib /usr/local/lib" ;; mingw*) # MinGW DLLs use traditional 'lib' prefix soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | $SED -e "s/^libraries://" -e "s,=/,/,g"` if echo "$sys_lib_search_path_spec" | grep ';[c-zC-Z]:/' >/dev/null; then # It is most probably a Windows format PATH printed by # mingw gcc, but we are running on Cygwin. Gcc prints its search # path with ; separators, and with drive letters. We can handle the # drive letters (cygwin fileutils understands them), so leave them, # especially as we might pass files found there to a mingw objdump, # which wouldn't understand a cygwinified path. Ahh. sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` else sys_lib_search_path_spec=`echo "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` fi ;; pw32*) # pw32 DLLs use 'pw' prefix rather than 'lib' library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' ;; esac ;; *) library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' ;; esac dynamic_linker='Win32 ld.exe' # FIXME: first we should search . and the directory the executable is in shlibpath_var=PATH ;; darwin* | rhapsody*) dynamic_linker="$host_os dyld" version_type=darwin need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${versuffix}$shared_ext ${libname}${release}${major}$shared_ext ${libname}$shared_ext' soname_spec='${libname}${release}${major}$shared_ext' shlibpath_overrides_runpath=yes shlibpath_var=DYLD_LIBRARY_PATH shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' # Apple's gcc prints 'gcc -print-search-dirs' doesn't operate the same. if test "$GCC" = yes; then sys_lib_search_path_spec=`$CC -print-search-dirs | tr "\n" "$PATH_SEPARATOR" | sed -e 's/libraries:/@libraries:/' | tr "@" "\n" | grep "^libraries:" | sed -e "s/^libraries://" -e "s,=/,/,g" -e "s,$PATH_SEPARATOR, ,g" -e "s,.*,& /lib /usr/lib /usr/local/lib,g"` else sys_lib_search_path_spec='/lib /usr/lib /usr/local/lib' fi sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' ;; dgux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; freebsd1*) dynamic_linker=no ;; kfreebsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; freebsd* | dragonfly*) # DragonFly does not have aout. When/if they implement a new # versioning mechanism, adjust this. if test -x /usr/bin/objformat; then objformat=`/usr/bin/objformat` else case $host_os in freebsd[123]*) objformat=aout ;; *) objformat=elf ;; esac fi version_type=freebsd-$objformat case $version_type in freebsd-elf*) library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' need_version=no need_lib_prefix=no ;; freebsd-*) library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' need_version=yes ;; esac shlibpath_var=LD_LIBRARY_PATH case $host_os in freebsd2*) shlibpath_overrides_runpath=yes ;; freebsd3.[01]* | freebsdelf3.[01]*) shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; freebsd*) # from 4.6 on shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; esac ;; gnu*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes ;; hpux9* | hpux10* | hpux11*) # Give a soname corresponding to the major version so that dld.sl refuses to # link against other versions. version_type=sunos need_lib_prefix=no need_version=no case $host_cpu in ia64*) shrext_cmds='.so' hardcode_into_libs=yes dynamic_linker="$host_os dld.so" shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' if test "X$HPUX_IA64_MODE" = X32; then sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" else sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" fi sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; hppa*64*) shrext_cmds='.sl' hardcode_into_libs=yes dynamic_linker="$host_os dld.sl" shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec ;; *) shrext_cmds='.sl' dynamic_linker="$host_os dld.sl" shlibpath_var=SHLIB_PATH shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' ;; esac # HP-UX runs *really* slowly unless shared libraries are mode 555. postinstall_cmds='chmod 555 $lib' ;; interix3*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes ;; irix5* | irix6* | nonstopux*) case $host_os in nonstopux*) version_type=nonstopux ;; *) if test "$lt_cv_prog_gnu_ld" = yes; then version_type=linux else version_type=irix fi ;; esac need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' case $host_os in irix5* | nonstopux*) libsuff= shlibsuff= ;; *) case $LD in # libtool.m4 will add one of these switches to LD *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= libmagic=32-bit;; *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 libmagic=N32;; *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 libmagic=64-bit;; *) libsuff= shlibsuff= libmagic=never-match;; esac ;; esac shlibpath_var=LD_LIBRARY${shlibsuff}_PATH shlibpath_overrides_runpath=no sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" hardcode_into_libs=yes ;; # No shared lib support for Linux oldld, aout, or coff. linux*oldld* | linux*aout* | linux*coff*) dynamic_linker=no ;; # This must be Linux ELF. linux*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no # This implies no fast_install, which is unacceptable. # Some rework will be needed to allow for fast_install # before this can be enabled. hardcode_into_libs=yes # find out which ABI we are using libsuff= case "$host_cpu" in x86_64*|s390x*|powerpc64*) echo '#line 24834 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then case `/usr/bin/file conftest.$ac_objext` in *64-bit*) libsuff=64 sys_lib_search_path_spec="/lib${libsuff} /usr/lib${libsuff} /usr/local/lib${libsuff}" ;; esac fi rm -rf conftest* ;; esac # Append ld.so.conf contents to the search path if test -f /etc/ld.so.conf; then lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;/^$/d' | tr '\n' ' '` sys_lib_dlsearch_path_spec="/lib${libsuff} /usr/lib${libsuff} $lt_ld_extra" fi # We used to test for /lib/ld.so.1 and disable shared libraries on # powerpc, because MkLinux only supported shared libraries with the # GNU dynamic linker. Since this was broken with cross compilers, # most powerpc-linux boxes support dynamic linking these days and # people can always --disable-shared, the test was removed, and we # assume the GNU/Linux dynamic linker is in use. dynamic_linker='GNU/Linux ld.so' ;; knetbsd*-gnu) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=no hardcode_into_libs=yes dynamic_linker='GNU ld.so' ;; netbsd*) version_type=sunos need_lib_prefix=no need_version=no if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' dynamic_linker='NetBSD (a.out) ld.so' else library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' dynamic_linker='NetBSD ld.elf_so' fi shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes ;; newsos6) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; nto-qnx*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes ;; openbsd*) version_type=sunos sys_lib_dlsearch_path_spec="/usr/lib" need_lib_prefix=no # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. case $host_os in openbsd3.3 | openbsd3.3.*) need_version=yes ;; *) need_version=no ;; esac library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' shlibpath_var=LD_LIBRARY_PATH if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then case $host_os in openbsd2.[89] | openbsd2.[89].*) shlibpath_overrides_runpath=no ;; *) shlibpath_overrides_runpath=yes ;; esac else shlibpath_overrides_runpath=yes fi ;; os2*) libname_spec='$name' shrext_cmds=".dll" need_lib_prefix=no library_names_spec='$libname${shared_ext} $libname.a' dynamic_linker='OS/2 ld.exe' shlibpath_var=LIBPATH ;; osf3* | osf4* | osf5*) version_type=osf need_lib_prefix=no need_version=no soname_spec='${libname}${release}${shared_ext}$major' library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' shlibpath_var=LD_LIBRARY_PATH sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" ;; solaris*) version_type=linux need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes hardcode_into_libs=yes # ldd complains unless libraries are executable postinstall_cmds='chmod +x $lib' ;; sunos4*) version_type=sunos library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' shlibpath_var=LD_LIBRARY_PATH shlibpath_overrides_runpath=yes if test "$with_gnu_ld" = yes; then need_lib_prefix=no fi need_version=yes ;; sysv4 | sysv4.3*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH case $host_vendor in sni) shlibpath_overrides_runpath=no need_lib_prefix=no export_dynamic_flag_spec='${wl}-Blargedynsym' runpath_var=LD_RUN_PATH ;; siemens) need_lib_prefix=no ;; motorola) need_lib_prefix=no need_version=no shlibpath_overrides_runpath=no sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' ;; esac ;; sysv4*MP*) if test -d /usr/nec ;then version_type=linux library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' soname_spec='$libname${shared_ext}.$major' shlibpath_var=LD_LIBRARY_PATH fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) version_type=freebsd-elf need_lib_prefix=no need_version=no library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH hardcode_into_libs=yes if test "$with_gnu_ld" = yes; then sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' shlibpath_overrides_runpath=no else sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' shlibpath_overrides_runpath=yes case $host_os in sco3.2v5*) sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" ;; esac fi sys_lib_dlsearch_path_spec='/usr/lib' ;; uts4*) version_type=linux library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' soname_spec='${libname}${release}${shared_ext}$major' shlibpath_var=LD_LIBRARY_PATH ;; *) dynamic_linker=no ;; esac echo "$as_me:$LINENO: result: $dynamic_linker" >&5 echo "${ECHO_T}$dynamic_linker" >&6 test "$dynamic_linker" = no && can_build_shared=no variables_saved_for_relink="PATH $shlibpath_var $runpath_var" if test "$GCC" = yes; then variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" fi echo "$as_me:$LINENO: checking how to hardcode library paths into programs" >&5 echo $ECHO_N "checking how to hardcode library paths into programs... $ECHO_C" >&6 hardcode_action_GCJ= if test -n "$hardcode_libdir_flag_spec_GCJ" || \ test -n "$runpath_var_GCJ" || \ test "X$hardcode_automatic_GCJ" = "Xyes" ; then # We can hardcode non-existant directories. if test "$hardcode_direct_GCJ" != no && # If the only mechanism to avoid hardcoding is shlibpath_var, we # have to relink, otherwise we might link with an installed library # when we should be linking with a yet-to-be-installed one ## test "$_LT_AC_TAGVAR(hardcode_shlibpath_var, GCJ)" != no && test "$hardcode_minus_L_GCJ" != no; then # Linking always hardcodes the temporary library directory. hardcode_action_GCJ=relink else # We can link without hardcoding, and we can hardcode nonexisting dirs. hardcode_action_GCJ=immediate fi else # We cannot hardcode anything, or else we can only hardcode existing # directories. hardcode_action_GCJ=unsupported fi echo "$as_me:$LINENO: result: $hardcode_action_GCJ" >&5 echo "${ECHO_T}$hardcode_action_GCJ" >&6 if test "$hardcode_action_GCJ" = relink; then # Fast installation is not supported enable_fast_install=no elif test "$shlibpath_overrides_runpath" = yes || test "$enable_shared" = no; then # Fast installation is not necessary enable_fast_install=needless fi # The else clause should only fire when bootstrapping the # libtool distribution, otherwise you forgot to ship ltmain.sh # with your package, and you will get complaints that there are # no rules to generate ltmain.sh. if test -f "$ltmain"; then # See if we are running on zsh, and set the options which allow our commands through # without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Now quote all the things that may contain metacharacters while being # careful not to overquote the AC_SUBSTed values. We take copies of the # variables and quote the copies for generation of the libtool script. for var in echo old_CC old_CFLAGS AR AR_FLAGS EGREP RANLIB LN_S LTCC LTCFLAGS NM \ SED SHELL STRIP \ libname_spec library_names_spec soname_spec extract_expsyms_cmds \ old_striplib striplib file_magic_cmd finish_cmds finish_eval \ deplibs_check_method reload_flag reload_cmds need_locks \ lt_cv_sys_global_symbol_pipe lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \ old_postinstall_cmds old_postuninstall_cmds \ compiler_GCJ \ CC_GCJ \ LD_GCJ \ lt_prog_compiler_wl_GCJ \ lt_prog_compiler_pic_GCJ \ lt_prog_compiler_static_GCJ \ lt_prog_compiler_no_builtin_flag_GCJ \ export_dynamic_flag_spec_GCJ \ thread_safe_flag_spec_GCJ \ whole_archive_flag_spec_GCJ \ enable_shared_with_static_runtimes_GCJ \ old_archive_cmds_GCJ \ old_archive_from_new_cmds_GCJ \ predep_objects_GCJ \ postdep_objects_GCJ \ predeps_GCJ \ postdeps_GCJ \ compiler_lib_search_path_GCJ \ archive_cmds_GCJ \ archive_expsym_cmds_GCJ \ postinstall_cmds_GCJ \ postuninstall_cmds_GCJ \ old_archive_from_expsyms_cmds_GCJ \ allow_undefined_flag_GCJ \ no_undefined_flag_GCJ \ export_symbols_cmds_GCJ \ hardcode_libdir_flag_spec_GCJ \ hardcode_libdir_flag_spec_ld_GCJ \ hardcode_libdir_separator_GCJ \ hardcode_automatic_GCJ \ module_cmds_GCJ \ module_expsym_cmds_GCJ \ lt_cv_prog_compiler_c_o_GCJ \ exclude_expsyms_GCJ \ include_expsyms_GCJ; do case $var in old_archive_cmds_GCJ | \ old_archive_from_new_cmds_GCJ | \ archive_cmds_GCJ | \ archive_expsym_cmds_GCJ | \ module_cmds_GCJ | \ module_expsym_cmds_GCJ | \ old_archive_from_expsyms_cmds_GCJ | \ export_symbols_cmds_GCJ | \ extract_expsyms_cmds | reload_cmds | finish_cmds | \ postinstall_cmds | postuninstall_cmds | \ old_postinstall_cmds | old_postuninstall_cmds | \ sys_lib_search_path_spec | sys_lib_dlsearch_path_spec) # Double-quote double-evaled strings. eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ;; *) eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ;; esac done case $lt_echo in *'\$0 --fallback-echo"') lt_echo=`$echo "X$lt_echo" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'` ;; esac cfgfile="$ofile" cat <<__EOF__ >> "$cfgfile" # ### BEGIN LIBTOOL TAG CONFIG: $tagname # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # Shell to use when invoking shell scripts. SHELL=$lt_SHELL # Whether or not to build shared libraries. build_libtool_libs=$enable_shared # Whether or not to build static libraries. build_old_libs=$enable_static # Whether or not to add -lc for building shared libraries. build_libtool_need_lc=$archive_cmds_need_lc_GCJ # Whether or not to disallow shared libs when runtime libs are static allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_GCJ # Whether or not to optimize for fast installation. fast_install=$enable_fast_install # The host system. host_alias=$host_alias host=$host host_os=$host_os # The build system. build_alias=$build_alias build=$build build_os=$build_os # An echo program that does not interpret backslashes. echo=$lt_echo # The archiver. AR=$lt_AR AR_FLAGS=$lt_AR_FLAGS # A C compiler. LTCC=$lt_LTCC # LTCC compiler flags. LTCFLAGS=$lt_LTCFLAGS # A language-specific compiler. CC=$lt_compiler_GCJ # Is the compiler the GNU C compiler? with_gcc=$GCC_GCJ gcc_dir=\`gcc -print-file-name=. | $SED 's,/\.$,,'\` gcc_ver=\`gcc -dumpversion\` # An ERE matcher. EGREP=$lt_EGREP # The linker used to build libraries. LD=$lt_LD_GCJ # Whether we need hard or soft links. LN_S=$lt_LN_S # A BSD-compatible nm program. NM=$lt_NM # A symbol stripping program STRIP=$lt_STRIP # Used to examine libraries when file_magic_cmd begins "file" MAGIC_CMD=$MAGIC_CMD # Used on cygwin: DLL creation program. DLLTOOL="$DLLTOOL" # Used on cygwin: object dumper. OBJDUMP="$OBJDUMP" # Used on cygwin: assembler. AS="$AS" # The name of the directory that contains temporary libtool files. objdir=$objdir # How to create reloadable object files. reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds # How to pass a linker flag through the compiler. wl=$lt_lt_prog_compiler_wl_GCJ # Object file suffix (normally "o"). objext="$ac_objext" # Old archive suffix (normally "a"). libext="$libext" # Shared library suffix (normally ".so"). shrext_cmds='$shrext_cmds' # Executable file suffix (normally ""). exeext="$exeext" # Additional compiler flags for building library objects. pic_flag=$lt_lt_prog_compiler_pic_GCJ pic_mode=$pic_mode # What is the maximum length of a command? max_cmd_len=$lt_cv_sys_max_cmd_len # Does compiler simultaneously support -c and -o options? compiler_c_o=$lt_lt_cv_prog_compiler_c_o_GCJ # Must we lock files when doing compilation? need_locks=$lt_need_locks # Do we need the lib prefix for modules? need_lib_prefix=$need_lib_prefix # Do we need a version for libraries? need_version=$need_version # Whether dlopen is supported. dlopen_support=$enable_dlopen # Whether dlopen of programs is supported. dlopen_self=$enable_dlopen_self # Whether dlopen of statically linked programs is supported. dlopen_self_static=$enable_dlopen_self_static # Compiler flag to prevent dynamic linking. link_static_flag=$lt_lt_prog_compiler_static_GCJ # Compiler flag to turn off builtin functions. no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_GCJ # Compiler flag to allow reflexive dlopens. export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_GCJ # Compiler flag to generate shared objects directly from archives. whole_archive_flag_spec=$lt_whole_archive_flag_spec_GCJ # Compiler flag to generate thread-safe objects. thread_safe_flag_spec=$lt_thread_safe_flag_spec_GCJ # Library versioning type. version_type=$version_type # Format of library name prefix. libname_spec=$lt_libname_spec # List of archive names. First name is the real one, the rest are links. # The last name is the one that the linker finds with -lNAME. library_names_spec=$lt_library_names_spec # The coded name of the library, if different from the real name. soname_spec=$lt_soname_spec # Commands used to build and install an old-style archive. RANLIB=$lt_RANLIB old_archive_cmds=$lt_old_archive_cmds_GCJ old_postinstall_cmds=$lt_old_postinstall_cmds old_postuninstall_cmds=$lt_old_postuninstall_cmds # Create an old-style archive from a shared archive. old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_GCJ # Create a temporary old-style archive to link instead of a shared archive. old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_GCJ # Commands used to build and install a shared archive. archive_cmds=$lt_archive_cmds_GCJ archive_expsym_cmds=$lt_archive_expsym_cmds_GCJ postinstall_cmds=$lt_postinstall_cmds postuninstall_cmds=$lt_postuninstall_cmds # Commands used to build a loadable module (assumed same as above if empty) module_cmds=$lt_module_cmds_GCJ module_expsym_cmds=$lt_module_expsym_cmds_GCJ # Commands to strip libraries. old_striplib=$lt_old_striplib striplib=$lt_striplib # Dependencies to place before the objects being linked to create a # shared library. predep_objects=\`echo $lt_predep_objects_GCJ | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place after the objects being linked to create a # shared library. postdep_objects=\`echo $lt_postdep_objects_GCJ | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place before the objects being linked to create a # shared library. predeps=$lt_predeps_GCJ # Dependencies to place after the objects being linked to create a # shared library. postdeps=$lt_postdeps_GCJ # The library search path used internally by the compiler when linking # a shared library. compiler_lib_search_path=\`echo $lt_compiler_lib_search_path_GCJ | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method # Command to use when deplibs_check_method == file_magic. file_magic_cmd=$lt_file_magic_cmd # Flag that allows shared libraries with undefined symbols to be built. allow_undefined_flag=$lt_allow_undefined_flag_GCJ # Flag that forces no undefined symbols. no_undefined_flag=$lt_no_undefined_flag_GCJ # Commands used to finish a libtool library installation in a directory. finish_cmds=$lt_finish_cmds # Same as above, but a single script fragment to be evaled but not shown. finish_eval=$lt_finish_eval # Take the output of nm and produce a listing of raw symbols and C names. global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe # Transform the output of nm in a proper C declaration global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl # Transform the output of nm in a C name address pair global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address # This is the shared library runtime path variable. runpath_var=$runpath_var # This is the shared library path variable. shlibpath_var=$shlibpath_var # Is shlibpath searched before the hard-coded library search path? shlibpath_overrides_runpath=$shlibpath_overrides_runpath # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action_GCJ # Whether we should hardcode library paths into libraries. hardcode_into_libs=$hardcode_into_libs # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_GCJ # If ld is used when linking, flag to hardcode \$libdir into # a binary during linking. This must work even if \$libdir does # not exist. hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_GCJ # Whether we need a single -rpath flag with a separated argument. hardcode_libdir_separator=$lt_hardcode_libdir_separator_GCJ # Set to yes if using DIR/libNAME${shared_ext} during linking hardcodes DIR into the # resulting binary. hardcode_direct=$hardcode_direct_GCJ # Set to yes if using the -LDIR flag during linking hardcodes DIR into the # resulting binary. hardcode_minus_L=$hardcode_minus_L_GCJ # Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into # the resulting binary. hardcode_shlibpath_var=$hardcode_shlibpath_var_GCJ # Set to yes if building a shared library automatically hardcodes DIR into the library # and all subsequent libraries and executables linked against it. hardcode_automatic=$hardcode_automatic_GCJ # Variables whose values should be saved in libtool wrapper scripts and # restored at relink time. variables_saved_for_relink="$variables_saved_for_relink" # Whether libtool must link a program against all its dependency libraries. link_all_deplibs=$link_all_deplibs_GCJ # Compile-time system search path for libraries sys_lib_search_path_spec=\`echo $lt_sys_lib_search_path_spec | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Run-time system search path for libraries sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec # Fix the shell variable \$srcfile for the compiler. fix_srcfile_path="$fix_srcfile_path_GCJ" # Set to yes if exported symbols are required. always_export_symbols=$always_export_symbols_GCJ # The commands to list exported symbols. export_symbols_cmds=$lt_export_symbols_cmds_GCJ # The commands to extract the exported symbol list from a shared archive. extract_expsyms_cmds=$lt_extract_expsyms_cmds # Symbols that should not be listed in the preloaded symbols. exclude_expsyms=$lt_exclude_expsyms_GCJ # Symbols that must always be exported. include_expsyms=$lt_include_expsyms_GCJ # ### END LIBTOOL TAG CONFIG: $tagname __EOF__ else # If there is no Makefile yet, we rely on a make rule to execute # `config.status --recheck' to rerun these tests and create the # libtool script then. ltmain_in=`echo $ltmain | sed -e 's/\.sh$/.in/'` if test -f "$ltmain_in"; then test -f Makefile && make "$ltmain" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CC="$lt_save_CC" else tagname="" fi ;; RC) # Source file extension for RC test sources. ac_ext=rc # Object file extension for compiled RC test sources. objext=o objext_RC=$objext # Code to be used in simple compile tests lt_simple_compile_test_code='sample MENU { MENUITEM "&Soup", 100, CHECKED }\n' # Code to be used in simple link tests lt_simple_link_test_code="$lt_simple_compile_test_code" # ltmain only uses $CC for tagged configurations so make sure $CC is set. # If no C compiler was specified, use CC. LTCC=${LTCC-"$CC"} # If no C compiler flags were specified, use CFLAGS. LTCFLAGS=${LTCFLAGS-"$CFLAGS"} # Allow CC to be a program name with arguments. compiler=$CC # save warnings/boilerplate of simple test code ac_outfile=conftest.$ac_objext printf "$lt_simple_compile_test_code" >conftest.$ac_ext eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_compiler_boilerplate=`cat conftest.err` $rm conftest* ac_outfile=conftest.$ac_objext printf "$lt_simple_link_test_code" >conftest.$ac_ext eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err _lt_linker_boilerplate=`cat conftest.err` $rm conftest* # Allow CC to be a program name with arguments. lt_save_CC="$CC" CC=${RC-"windres"} compiler=$CC compiler_RC=$CC for cc_temp in $compiler""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`$echo "X$cc_temp" | $Xsed -e 's%.*/%%' -e "s%^$host_alias-%%"` lt_cv_prog_compiler_c_o_RC=yes # The else clause should only fire when bootstrapping the # libtool distribution, otherwise you forgot to ship ltmain.sh # with your package, and you will get complaints that there are # no rules to generate ltmain.sh. if test -f "$ltmain"; then # See if we are running on zsh, and set the options which allow our commands through # without removal of \ escapes. if test -n "${ZSH_VERSION+set}" ; then setopt NO_GLOB_SUBST fi # Now quote all the things that may contain metacharacters while being # careful not to overquote the AC_SUBSTed values. We take copies of the # variables and quote the copies for generation of the libtool script. for var in echo old_CC old_CFLAGS AR AR_FLAGS EGREP RANLIB LN_S LTCC LTCFLAGS NM \ SED SHELL STRIP \ libname_spec library_names_spec soname_spec extract_expsyms_cmds \ old_striplib striplib file_magic_cmd finish_cmds finish_eval \ deplibs_check_method reload_flag reload_cmds need_locks \ lt_cv_sys_global_symbol_pipe lt_cv_sys_global_symbol_to_cdecl \ lt_cv_sys_global_symbol_to_c_name_address \ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \ old_postinstall_cmds old_postuninstall_cmds \ compiler_RC \ CC_RC \ LD_RC \ lt_prog_compiler_wl_RC \ lt_prog_compiler_pic_RC \ lt_prog_compiler_static_RC \ lt_prog_compiler_no_builtin_flag_RC \ export_dynamic_flag_spec_RC \ thread_safe_flag_spec_RC \ whole_archive_flag_spec_RC \ enable_shared_with_static_runtimes_RC \ old_archive_cmds_RC \ old_archive_from_new_cmds_RC \ predep_objects_RC \ postdep_objects_RC \ predeps_RC \ postdeps_RC \ compiler_lib_search_path_RC \ archive_cmds_RC \ archive_expsym_cmds_RC \ postinstall_cmds_RC \ postuninstall_cmds_RC \ old_archive_from_expsyms_cmds_RC \ allow_undefined_flag_RC \ no_undefined_flag_RC \ export_symbols_cmds_RC \ hardcode_libdir_flag_spec_RC \ hardcode_libdir_flag_spec_ld_RC \ hardcode_libdir_separator_RC \ hardcode_automatic_RC \ module_cmds_RC \ module_expsym_cmds_RC \ lt_cv_prog_compiler_c_o_RC \ exclude_expsyms_RC \ include_expsyms_RC; do case $var in old_archive_cmds_RC | \ old_archive_from_new_cmds_RC | \ archive_cmds_RC | \ archive_expsym_cmds_RC | \ module_cmds_RC | \ module_expsym_cmds_RC | \ old_archive_from_expsyms_cmds_RC | \ export_symbols_cmds_RC | \ extract_expsyms_cmds | reload_cmds | finish_cmds | \ postinstall_cmds | postuninstall_cmds | \ old_postinstall_cmds | old_postuninstall_cmds | \ sys_lib_search_path_spec | sys_lib_dlsearch_path_spec) # Double-quote double-evaled strings. eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ;; *) eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ;; esac done case $lt_echo in *'\$0 --fallback-echo"') lt_echo=`$echo "X$lt_echo" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'` ;; esac cfgfile="$ofile" cat <<__EOF__ >> "$cfgfile" # ### BEGIN LIBTOOL TAG CONFIG: $tagname # Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: # Shell to use when invoking shell scripts. SHELL=$lt_SHELL # Whether or not to build shared libraries. build_libtool_libs=$enable_shared # Whether or not to build static libraries. build_old_libs=$enable_static # Whether or not to add -lc for building shared libraries. build_libtool_need_lc=$archive_cmds_need_lc_RC # Whether or not to disallow shared libs when runtime libs are static allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_RC # Whether or not to optimize for fast installation. fast_install=$enable_fast_install # The host system. host_alias=$host_alias host=$host host_os=$host_os # The build system. build_alias=$build_alias build=$build build_os=$build_os # An echo program that does not interpret backslashes. echo=$lt_echo # The archiver. AR=$lt_AR AR_FLAGS=$lt_AR_FLAGS # A C compiler. LTCC=$lt_LTCC # LTCC compiler flags. LTCFLAGS=$lt_LTCFLAGS # A language-specific compiler. CC=$lt_compiler_RC # Is the compiler the GNU C compiler? with_gcc=$GCC_RC gcc_dir=\`gcc -print-file-name=. | $SED 's,/\.$,,'\` gcc_ver=\`gcc -dumpversion\` # An ERE matcher. EGREP=$lt_EGREP # The linker used to build libraries. LD=$lt_LD_RC # Whether we need hard or soft links. LN_S=$lt_LN_S # A BSD-compatible nm program. NM=$lt_NM # A symbol stripping program STRIP=$lt_STRIP # Used to examine libraries when file_magic_cmd begins "file" MAGIC_CMD=$MAGIC_CMD # Used on cygwin: DLL creation program. DLLTOOL="$DLLTOOL" # Used on cygwin: object dumper. OBJDUMP="$OBJDUMP" # Used on cygwin: assembler. AS="$AS" # The name of the directory that contains temporary libtool files. objdir=$objdir # How to create reloadable object files. reload_flag=$lt_reload_flag reload_cmds=$lt_reload_cmds # How to pass a linker flag through the compiler. wl=$lt_lt_prog_compiler_wl_RC # Object file suffix (normally "o"). objext="$ac_objext" # Old archive suffix (normally "a"). libext="$libext" # Shared library suffix (normally ".so"). shrext_cmds='$shrext_cmds' # Executable file suffix (normally ""). exeext="$exeext" # Additional compiler flags for building library objects. pic_flag=$lt_lt_prog_compiler_pic_RC pic_mode=$pic_mode # What is the maximum length of a command? max_cmd_len=$lt_cv_sys_max_cmd_len # Does compiler simultaneously support -c and -o options? compiler_c_o=$lt_lt_cv_prog_compiler_c_o_RC # Must we lock files when doing compilation? need_locks=$lt_need_locks # Do we need the lib prefix for modules? need_lib_prefix=$need_lib_prefix # Do we need a version for libraries? need_version=$need_version # Whether dlopen is supported. dlopen_support=$enable_dlopen # Whether dlopen of programs is supported. dlopen_self=$enable_dlopen_self # Whether dlopen of statically linked programs is supported. dlopen_self_static=$enable_dlopen_self_static # Compiler flag to prevent dynamic linking. link_static_flag=$lt_lt_prog_compiler_static_RC # Compiler flag to turn off builtin functions. no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_RC # Compiler flag to allow reflexive dlopens. export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_RC # Compiler flag to generate shared objects directly from archives. whole_archive_flag_spec=$lt_whole_archive_flag_spec_RC # Compiler flag to generate thread-safe objects. thread_safe_flag_spec=$lt_thread_safe_flag_spec_RC # Library versioning type. version_type=$version_type # Format of library name prefix. libname_spec=$lt_libname_spec # List of archive names. First name is the real one, the rest are links. # The last name is the one that the linker finds with -lNAME. library_names_spec=$lt_library_names_spec # The coded name of the library, if different from the real name. soname_spec=$lt_soname_spec # Commands used to build and install an old-style archive. RANLIB=$lt_RANLIB old_archive_cmds=$lt_old_archive_cmds_RC old_postinstall_cmds=$lt_old_postinstall_cmds old_postuninstall_cmds=$lt_old_postuninstall_cmds # Create an old-style archive from a shared archive. old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_RC # Create a temporary old-style archive to link instead of a shared archive. old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_RC # Commands used to build and install a shared archive. archive_cmds=$lt_archive_cmds_RC archive_expsym_cmds=$lt_archive_expsym_cmds_RC postinstall_cmds=$lt_postinstall_cmds postuninstall_cmds=$lt_postuninstall_cmds # Commands used to build a loadable module (assumed same as above if empty) module_cmds=$lt_module_cmds_RC module_expsym_cmds=$lt_module_expsym_cmds_RC # Commands to strip libraries. old_striplib=$lt_old_striplib striplib=$lt_striplib # Dependencies to place before the objects being linked to create a # shared library. predep_objects=\`echo $lt_predep_objects_RC | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place after the objects being linked to create a # shared library. postdep_objects=\`echo $lt_postdep_objects_RC | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Dependencies to place before the objects being linked to create a # shared library. predeps=$lt_predeps_RC # Dependencies to place after the objects being linked to create a # shared library. postdeps=$lt_postdeps_RC # The library search path used internally by the compiler when linking # a shared library. compiler_lib_search_path=\`echo $lt_compiler_lib_search_path_RC | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Method to check whether dependent libraries are shared objects. deplibs_check_method=$lt_deplibs_check_method # Command to use when deplibs_check_method == file_magic. file_magic_cmd=$lt_file_magic_cmd # Flag that allows shared libraries with undefined symbols to be built. allow_undefined_flag=$lt_allow_undefined_flag_RC # Flag that forces no undefined symbols. no_undefined_flag=$lt_no_undefined_flag_RC # Commands used to finish a libtool library installation in a directory. finish_cmds=$lt_finish_cmds # Same as above, but a single script fragment to be evaled but not shown. finish_eval=$lt_finish_eval # Take the output of nm and produce a listing of raw symbols and C names. global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe # Transform the output of nm in a proper C declaration global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl # Transform the output of nm in a C name address pair global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address # This is the shared library runtime path variable. runpath_var=$runpath_var # This is the shared library path variable. shlibpath_var=$shlibpath_var # Is shlibpath searched before the hard-coded library search path? shlibpath_overrides_runpath=$shlibpath_overrides_runpath # How to hardcode a shared library path into an executable. hardcode_action=$hardcode_action_RC # Whether we should hardcode library paths into libraries. hardcode_into_libs=$hardcode_into_libs # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_RC # If ld is used when linking, flag to hardcode \$libdir into # a binary during linking. This must work even if \$libdir does # not exist. hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_RC # Whether we need a single -rpath flag with a separated argument. hardcode_libdir_separator=$lt_hardcode_libdir_separator_RC # Set to yes if using DIR/libNAME${shared_ext} during linking hardcodes DIR into the # resulting binary. hardcode_direct=$hardcode_direct_RC # Set to yes if using the -LDIR flag during linking hardcodes DIR into the # resulting binary. hardcode_minus_L=$hardcode_minus_L_RC # Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into # the resulting binary. hardcode_shlibpath_var=$hardcode_shlibpath_var_RC # Set to yes if building a shared library automatically hardcodes DIR into the library # and all subsequent libraries and executables linked against it. hardcode_automatic=$hardcode_automatic_RC # Variables whose values should be saved in libtool wrapper scripts and # restored at relink time. variables_saved_for_relink="$variables_saved_for_relink" # Whether libtool must link a program against all its dependency libraries. link_all_deplibs=$link_all_deplibs_RC # Compile-time system search path for libraries sys_lib_search_path_spec=\`echo $lt_sys_lib_search_path_spec | \$SED -e "s@\${gcc_dir}@\\\${gcc_dir}@g;s@\${gcc_ver}@\\\${gcc_ver}@g"\` # Run-time system search path for libraries sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec # Fix the shell variable \$srcfile for the compiler. fix_srcfile_path="$fix_srcfile_path_RC" # Set to yes if exported symbols are required. always_export_symbols=$always_export_symbols_RC # The commands to list exported symbols. export_symbols_cmds=$lt_export_symbols_cmds_RC # The commands to extract the exported symbol list from a shared archive. extract_expsyms_cmds=$lt_extract_expsyms_cmds # Symbols that should not be listed in the preloaded symbols. exclude_expsyms=$lt_exclude_expsyms_RC # Symbols that must always be exported. include_expsyms=$lt_include_expsyms_RC # ### END LIBTOOL TAG CONFIG: $tagname __EOF__ else # If there is no Makefile yet, we rely on a make rule to execute # `config.status --recheck' to rerun these tests and create the # libtool script then. ltmain_in=`echo $ltmain | sed -e 's/\.sh$/.in/'` if test -f "$ltmain_in"; then test -f Makefile && make "$ltmain" fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_linkonly='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_objext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu CC="$lt_save_CC" ;; *) { { echo "$as_me:$LINENO: error: Unsupported tag name: $tagname" >&5 echo "$as_me: error: Unsupported tag name: $tagname" >&2;} { (exit 1); exit 1; }; } ;; esac # Append the new tag name to the list of available tags. if test -n "$tagname" ; then available_tags="$available_tags $tagname" fi fi done IFS="$lt_save_ifs" # Now substitute the updated list of available tags. if eval "sed -e 's/^available_tags=.*\$/available_tags=\"$available_tags\"/' \"$ofile\" > \"${ofile}T\""; then mv "${ofile}T" "$ofile" chmod +x "$ofile" else rm -f "${ofile}T" { { echo "$as_me:$LINENO: error: unable to update list of available tagged configurations." >&5 echo "$as_me: error: unable to update list of available tagged configurations." >&2;} { (exit 1); exit 1; }; } fi fi # This can be used to rebuild libtool when needed LIBTOOL_DEPS="$ac_aux_dir/ltmain.sh" # Always use our own libtool. LIBTOOL='$(SHELL) $(top_builddir)/libtool' # Prevent multiple expansion # Do we build shared libraries? # (enable_shared is set by the function AC_ENABLE_SHARED in libtool.m4) SHARED_LIBS="${enable_shared}" # Print a few more lines for configure --help # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Check whether --with- or --without- was given. if test "${with_+set}" = set; then withval="$with_" fi; # Substitute variables # Generate makefiles echo "" echo "Create Makefiles and configuration files" echo "----------------------------------------" echo "" # Initialize the list of Makefiles to be created SUNDIALS_MAKEFILES="Makefile" # Initialize list of additional configure files to be created SUNDIALS_CONFIGFILES="include/sundials/sundials_config.h:include/sundials/sundials_config.in" SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/sundials-config:bin/sundials-config.in" # Initialize lists of solver modules and example modules SLV_MODULES="src/sundials" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/sundials/Makefile" EXS_MODULES="" # NVECTOR modules if test -d ${srcdir}/src/nvec_ser ; then SLV_MODULES="${SLV_MODULES} src/nvec_ser" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_ser/Makefile" fi if test -d ${srcdir}/src/nvec_par && test "X${MPI_C_COMP_OK}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/nvec_par" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_par/Makefile" fi if test -d ${srcdir}/src/nvec_spcpar && test "X${MPI_C_COMP_OK}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/nvec_spcpar" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_spcpar/Makefile" fi # CVODE module if test "X${CVODE_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cvode" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvode/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/cvode/fcmix ; then SLV_MODULES="${SLV_MODULES} src/cvode/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvode/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/serial ; then EXS_MODULES="${EXS_MODULES} examples/cvode/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/cvode/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvode/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvode/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # CVODES module if test "X${CVODES_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cvodes" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvodes/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/serial ; then EXS_MODULES="${EXS_MODULES} examples/cvodes/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvodes/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # IDA module if test "X${IDA_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/ida" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/ida/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/ida/fcmix ; then SLV_MODULES="${SLV_MODULES} src/ida/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/ida/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/serial ; then EXS_MODULES="${EXS_MODULES} examples/ida/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/ida/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/parallel ; then EXS_MODULES="${EXS_MODULES} examples/ida/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/ida/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # IDAS module if test "X${IDAS_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/idas" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/idas/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/serial ; then EXS_MODULES="${EXS_MODULES} examples/idas/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/parallel ; then EXS_MODULES="${EXS_MODULES} examples/idas/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # KINSOL module if test "X${KINSOL_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/kinsol" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/kinsol/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/kinsol/fcmix ; then SLV_MODULES="${SLV_MODULES} src/kinsol/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/kinsol/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/serial ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/parallel ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # CPODES module if test "X${CPODES_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cpodes" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cpodes/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/serial ; then EXS_MODULES="${EXS_MODULES} examples/cpodes/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cpodes/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # Add Fortran update script to the list of additional files to be generated if test "X${BUILD_F77_UPDATE_SCRIPT}" = "Xyes"; then SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/fortran-update.sh:bin/fortran-update.in" fi # If needed, add Makefile update script to the list of additional files to be generated if test "X${EXAMPLES_ENABLED}" = "Xyes" && test "X${EXS_INSTDIR}" != "Xno"; then SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/makefile-update.sh:bin/makefile-update.in" fi # Set-up postprocessing commands if test "X${EXAMPLES_ENABLED}" = "Xyes" && test "X${EXS_INSTDIR}" != "Xno"; then ac_config_commands="$ac_config_commands postprocessing" # If installing examples, the Makefiles that will be exported must # be post-processed to complete the substitution of all variables. # After config.status runs, each example subdirectory contains an # export makefile, named Makefile_ex, which was created from the # common template in examples/templates. # # The following variables are still to be substituted at this point: # SOLVER # EXAMPLES # EXAMPLES_BL # SOLVER_LIB SOLVER_FLIB # NVEC_LIB NVEC_FLIB # # This function is called ONLY if examples are enabled AND examples will # be installed. If so, it sets up commands to be called after config.status # has generated a first version of the Makefiles for export: # # (1) For each solver, proceed ONLY if the solver is enabled. # (2) For each type of examples, proceed ONLY if they can be compiled AND # the example directory exists. # CVODE module if test "X${CVODE_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands cvode_ser_ex_bl" else ac_config_commands="$ac_config_commands cvode_ser_ex" fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands cvode_fser_ex_bl" else ac_config_commands="$ac_config_commands cvode_fser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/parallel ; then ac_config_commands="$ac_config_commands cvode_par_ex" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_parallel ; then ac_config_commands="$ac_config_commands cvode_fpar_ex" fi fi # CVODES module if test "X${CVODES_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands cvodes_ser_ex_bl" else ac_config_commands="$ac_config_commands cvodes_ser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/parallel ; then ac_config_commands="$ac_config_commands cvodes_par_ex" fi fi # IDA module if test "X${IDA_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands ida_ser_ex_bl" else ac_config_commands="$ac_config_commands ida_ser_ex" fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands ida_fser_ex_bl" else ac_config_commands="$ac_config_commands ida_fser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/parallel ; then ac_config_commands="$ac_config_commands ida_par_ex" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_parallel ; then ac_config_commands="$ac_config_commands ida_fpar_ex" fi fi # IDAS module if test "X${IDAS_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands idas_ser_ex_bl" else ac_config_commands="$ac_config_commands idas_ser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/parallel ; then ac_config_commands="$ac_config_commands idas_par_ex" fi fi # KINSOL module if test "X${KINSOL_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands kinsol_ser_ex_bl" else ac_config_commands="$ac_config_commands kinsol_ser_ex" fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands kinsol_fser_ex_bl" else ac_config_commands="$ac_config_commands kinsol_fser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/parallel ; then ac_config_commands="$ac_config_commands kinsol_par_ex" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_parallel ; then ac_config_commands="$ac_config_commands kinsol_fpar_ex" fi fi # CPODES module if test "X${CPODES_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then ac_config_commands="$ac_config_commands cpodes_ser_ex_bl" else ac_config_commands="$ac_config_commands cpodes_ser_ex" fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/parallel ; then ac_config_commands="$ac_config_commands cpodes_par_ex" fi fi fi # Specify files to be configured and call AC_OUTPUT ac_config_files="$ac_config_files ${SUNDIALS_MAKEFILES}" ac_config_files="$ac_config_files ${SUNDIALS_CONFIGFILES}" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by SUNDIALS $as_me 2.5.0, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Configuration commands: $config_commands Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ SUNDIALS config.status 2.5.0 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir INSTALL="$INSTALL" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "${SUNDIALS_MAKEFILES}" ) CONFIG_FILES="$CONFIG_FILES ${SUNDIALS_MAKEFILES}" ;; "${SUNDIALS_CONFIGFILES}" ) CONFIG_FILES="$CONFIG_FILES ${SUNDIALS_CONFIGFILES}" ;; "postprocessing" ) CONFIG_COMMANDS="$CONFIG_COMMANDS postprocessing" ;; "cvode_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_ser_ex_bl" ;; "cvode_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_ser_ex" ;; "cvode_fser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_fser_ex_bl" ;; "cvode_fser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_fser_ex" ;; "cvode_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_par_ex" ;; "cvode_fpar_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvode_fpar_ex" ;; "cvodes_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvodes_ser_ex_bl" ;; "cvodes_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvodes_ser_ex" ;; "cvodes_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cvodes_par_ex" ;; "ida_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_ser_ex_bl" ;; "ida_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_ser_ex" ;; "ida_fser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_fser_ex_bl" ;; "ida_fser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_fser_ex" ;; "ida_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_par_ex" ;; "ida_fpar_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS ida_fpar_ex" ;; "idas_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS idas_ser_ex_bl" ;; "idas_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS idas_ser_ex" ;; "idas_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS idas_par_ex" ;; "kinsol_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_ser_ex_bl" ;; "kinsol_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_ser_ex" ;; "kinsol_fser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_fser_ex_bl" ;; "kinsol_fser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_fser_ex" ;; "kinsol_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_par_ex" ;; "kinsol_fpar_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS kinsol_fpar_ex" ;; "cpodes_ser_ex_bl" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cpodes_ser_ex_bl" ;; "cpodes_ser_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cpodes_ser_ex" ;; "cpodes_par_ex" ) CONFIG_COMMANDS="$CONFIG_COMMANDS cpodes_par_ex" ;; "config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h:config.hin" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@build@,$build,;t t s,@build_cpu@,$build_cpu,;t t s,@build_vendor@,$build_vendor,;t t s,@build_os@,$build_os,;t t s,@host@,$host,;t t s,@host_cpu@,$host_cpu,;t t s,@host_vendor@,$host_vendor,;t t s,@host_os@,$host_os,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t s,@INSTALL_DATA@,$INSTALL_DATA,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@CPP@,$CPP,;t t s,@EGREP@,$EGREP,;t t s,@FGREP@,$FGREP,;t t s,@F77@,$F77,;t t s,@FFLAGS@,$FFLAGS,;t t s,@ac_ct_F77@,$ac_ct_F77,;t t s,@FLIBS@,$FLIBS,;t t s,@MPICC_COMP@,$MPICC_COMP,;t t s,@MPIF77_COMP@,$MPIF77_COMP,;t t s,@SED@,$SED,;t t s,@LN_S@,$LN_S,;t t s,@ECHO@,$ECHO,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@STRIP@,$STRIP,;t t s,@ac_ct_STRIP@,$ac_ct_STRIP,;t t s,@DLLTOOL@,$DLLTOOL,;t t s,@ac_ct_DLLTOOL@,$ac_ct_DLLTOOL,;t t s,@AS@,$AS,;t t s,@ac_ct_AS@,$ac_ct_AS,;t t s,@OBJDUMP@,$OBJDUMP,;t t s,@ac_ct_OBJDUMP@,$ac_ct_OBJDUMP,;t t s,@CXX@,$CXX,;t t s,@CXXFLAGS@,$CXXFLAGS,;t t s,@ac_ct_CXX@,$ac_ct_CXX,;t t s,@CXXCPP@,$CXXCPP,;t t s,@LIBTOOL@,$LIBTOOL,;t t s,@SHARED_LIBS@,$SHARED_LIBS,;t t s,@MPICC@,$MPICC,;t t s,@MPIF77@,$MPIF77,;t t s,@MPI_INC_DIR@,$MPI_INC_DIR,;t t s,@MPI_LIB_DIR@,$MPI_LIB_DIR,;t t s,@MPI_LIBS@,$MPI_LIBS,;t t s,@MPI_FLAGS@,$MPI_FLAGS,;t t s,@FCMIX_ENABLED@,$FCMIX_ENABLED,;t t s,@FLOAT_TYPE@,$FLOAT_TYPE,;t t s,@LIBTOOL_DEPS@,$LIBTOOL_DEPS,;t t s,@F77_MANGLE_MACRO1@,$F77_MANGLE_MACRO1,;t t s,@F77_MANGLE_MACRO2@,$F77_MANGLE_MACRO2,;t t s,@F77_CASE@,$F77_CASE,;t t s,@F77_UNDERSCORES@,$F77_UNDERSCORES,;t t s,@PRECISION_LEVEL@,$PRECISION_LEVEL,;t t s,@GENERIC_MATH_LIB@,$GENERIC_MATH_LIB,;t t s,@BLAS_LAPACK_MACRO@,$BLAS_LAPACK_MACRO,;t t s,@SUNDIALS_EXPORT@,$SUNDIALS_EXPORT,;t t s,@F77_MPI_COMM_F2C@,$F77_MPI_COMM_F2C,;t t s,@F77_LNKR@,$F77_LNKR,;t t s,@F77_LIBS@,$F77_LIBS,;t t s,@F77_LDFLAGS@,$F77_LDFLAGS,;t t s,@LAPACK_ENABLED@,$LAPACK_ENABLED,;t t s,@BLAS_LAPACK_LIBS@,$BLAS_LAPACK_LIBS,;t t s,@MPIF77_LNKR@,$MPIF77_LNKR,;t t s,@SLV_MODULES@,$SLV_MODULES,;t t s,@EXS_MODULES@,$EXS_MODULES,;t t s,@EXS_INSTDIR@,$EXS_INSTDIR,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac case $INSTALL in [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; *) ac_INSTALL=$ac_top_builddir$INSTALL ;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t s,@INSTALL@,$ac_INSTALL,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_HEADER section. # # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. # # ac_d sets the value in "#define NAME VALUE" lines. ac_dA='s,^\([ ]*\)#\([ ]*define[ ][ ]*\)' ac_dB='[ ].*$,\1#\2' ac_dC=' ' ac_dD=',;t' # ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE". ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_uB='$,\1#\2define\3' ac_uC=' ' ac_uD=',;t' for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } # Do quote $f, to prevent DOS paths from being IFS'd. echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } # Remove the trailing spaces. sed 's/[ ]*$//' $ac_file_inputs >$tmp/in _ACEOF # Transform confdefs.h into two sed scripts, `conftest.defines' and # `conftest.undefs', that substitutes the proper values into # config.h.in to produce config.h. The first handles `#define' # templates, and the second `#undef' templates. # And first: Protect against being on the right side of a sed subst in # config.status. Protect against being in an unquoted here document # in config.status. rm -f conftest.defines conftest.undefs # Using a here document instead of a string reduces the quoting nightmare. # Putting comments in sed scripts is not portable. # # `end' is used to avoid that the second main sed command (meant for # 0-ary CPP macros) applies to n-ary macro definitions. # See the Autoconf documentation for `clear'. cat >confdef2sed.sed <<\_ACEOF s/[\\&,]/\\&/g s,[\\$`],\\&,g t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp t end s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp : end _ACEOF # If some macros were called several times there might be several times # the same #defines, which is useless. Nevertheless, we may not want to # sort them, since we want the *last* AC-DEFINE to be honored. uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs rm -f confdef2sed.sed # This sed command replaces #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. cat >>conftest.undefs <<\_ACEOF s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, _ACEOF # Break up conftest.defines because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS echo ' :' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.defines >/dev/null do # Write a limited-size here document to $tmp/defines.sed. echo ' cat >$tmp/defines.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#define' lines. echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/defines.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines echo ' fi # grep' >>$CONFIG_STATUS echo >>$CONFIG_STATUS # Break up conftest.undefs because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #undef templates' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.undefs >/dev/null do # Write a limited-size here document to $tmp/undefs.sed. echo ' cat >$tmp/undefs.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#undef' echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/undefs.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail rm -f conftest.undefs mv conftest.tail conftest.undefs done rm -f conftest.undefs cat >>$CONFIG_STATUS <<\_ACEOF # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then echo "/* Generated by configure. */" >$tmp/config.h else echo "/* $ac_file. Generated by configure. */" >$tmp/config.h fi cat $tmp/in >>$tmp/config.h rm -f $tmp/in if test x"$ac_file" != x-; then if diff $ac_file $tmp/config.h >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } rm -f $ac_file mv $tmp/config.h $ac_file fi else cat $tmp/config.h rm -f $tmp/config.h fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_COMMANDS section. # for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue ac_dest=`echo "$ac_file" | sed 's,:.*,,'` ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_dir=`(dirname "$ac_dest") 2>/dev/null || $as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_dest" : 'X\(//\)[^/]' \| \ X"$ac_dest" : 'X\(//\)$' \| \ X"$ac_dest" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_dest" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac { echo "$as_me:$LINENO: executing $ac_dest commands" >&5 echo "$as_me: executing $ac_dest commands" >&6;} case $ac_dest in postprocessing ) echo "" echo "Postprocess exported Makefiles" echo "------------------------------" echo "" ;; cvode_ser_ex_bl ) IN_FILE="examples/cvode/serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_bnd cvDirectDemo_ls cvDiurnal_kry_bp cvDiurnal_kry cvKrylovDemo_ls cvKrylovDemo_prec cvRoberts_dns cvRoberts_dns_uw" EXAMPLES_BL="cvAdvDiff_bndL cvRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvode_ser_ex ) IN_FILE="examples/cvode/serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_bnd cvDirectDemo_ls cvDiurnal_kry_bp cvDiurnal_kry cvKrylovDemo_ls cvKrylovDemo_prec cvRoberts_dns cvRoberts_dns_uw" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvode_fser_ex_bl ) IN_FILE="examples/cvode/fcmix_serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvAdvDiff_bnd fcvDiurnal_kry_bp fcvDiurnal_kry fcvRoberts_dns" EXAMPLES_BL="fcvRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvode_fser_ex ) IN_FILE="examples/cvode/fcmix_serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvAdvDiff_bnd fcvDiurnal_kry_bp fcvDiurnal_kry fcvRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvode_par_ex ) IN_FILE="examples/cvode/parallel/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_non_p cvDiurnal_kry_bbd_p cvDiurnal_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvode_fpar_ex ) IN_FILE="examples/cvode/fcmix_parallel/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvDiag_non_p fcvDiag_kry_bbd_p fcvDiag_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvodes_ser_ex_bl ) IN_FILE="examples/cvodes/serial/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAi_bnd cvsAdvDiff_FSA_non cvsDiurnal_kry_bp cvsFoodWeb_ASAp_kry cvsKrylovDemo_prec cvsAdvDiff_bnd cvsDirectDemo_ls cvsDiurnal_kry cvsHessian_ASA_FSA cvsRoberts_ASAi_dns cvsRoberts_dns_uw cvsDiurnal_FSA_kry cvsFoodWeb_ASAi_kry cvsKrylovDemo_ls cvsRoberts_dns cvsRoberts_FSA_dns" EXAMPLES_BL="cvsRoberts_dnsL cvsAdvDiff_bndL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvodes_ser_ex ) IN_FILE="examples/cvodes/serial/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAi_bnd cvsAdvDiff_FSA_non cvsDiurnal_kry_bp cvsFoodWeb_ASAp_kry cvsKrylovDemo_prec cvsAdvDiff_bnd cvsDirectDemo_ls cvsDiurnal_kry cvsHessian_ASA_FSA cvsRoberts_ASAi_dns cvsRoberts_dns_uw cvsDiurnal_FSA_kry cvsFoodWeb_ASAi_kry cvsKrylovDemo_ls cvsRoberts_dns cvsRoberts_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cvodes_par_ex ) IN_FILE="examples/cvodes/parallel/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAp_non_p cvsAdvDiff_non_p cvsDiurnal_FSA_kry_p cvsDiurnal_kry_p cvsAdvDiff_FSA_non_p cvsAtmDisp_ASAi_kry_bbd_p cvsDiurnal_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_ser_ex_bl ) IN_FILE="examples/ida/serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_bnd idaHeat2D_bnd idaHeat2D_kry idaKrylovDemo_ls idaRoberts_dns idaSlCrank_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_ser_ex ) IN_FILE="examples/ida/serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_bnd idaHeat2D_bnd idaHeat2D_kry idaKrylovDemo_ls idaRoberts_dns idaSlCrank_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_fser_ex_bl ) IN_FILE="examples/ida/fcmix_serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_fser_ex ) IN_FILE="examples/ida/fcmix_serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_par_ex ) IN_FILE="examples/ida/parallel/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_kry_bbd_p idaFoodWeb_kry_p idaHeat2D_kry_bbd_p idaHeat2D_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; ida_fpar_ex ) IN_FILE="examples/ida/fcmix_parallel/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaHeat2D_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; idas_ser_ex_bl ) IN_FILE="examples/idas/serial/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasAkzoNob_ASAi_dns idasFoodWeb_bnd idasHeat2D_kry idasKrylovDemo_ls idasRoberts_dns idasSlCrank_dns idasAkzoNob_dns idasHeat2D_bnd idasHessian_ASA_FSA idasRoberts_ASAi_dns idasRoberts_FSA_dns idasSlCrank_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; idas_ser_ex ) IN_FILE="examples/idas/serial/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasAkzoNob_ASAi_dns idasFoodWeb_bnd idasHeat2D_kry idasKrylovDemo_ls idasRoberts_dns idasSlCrank_dns idasAkzoNob_dns idasHeat2D_bnd idasHessian_ASA_FSA idasRoberts_ASAi_dns idasRoberts_FSA_dns idasSlCrank_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; idas_par_ex ) IN_FILE="examples/idas/parallel/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasBruss_ASAp_kry_bbd_p idasBruss_kry_bbd_p idasFoodWeb_kry_p idasHeat2D_kry_bbd_p idasBruss_FSA_kry_bbd_p idasFoodWeb_kry_bbd_p idasHeat2D_FSA_kry_bbd_p idasHeat2D_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_ser_ex_bl ) IN_FILE="examples/kinsol/serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFerTron_dns kinFoodWeb_kry kinKrylovDemo_ls kinLaplace_bnd kinRoboKin_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_ser_ex ) IN_FILE="examples/kinsol/serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFerTron_dns kinFoodWeb_kry kinKrylovDemo_ls kinLaplace_bnd kinRoboKin_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_fser_ex_bl ) IN_FILE="examples/kinsol/fcmix_serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_fser_ex ) IN_FILE="examples/kinsol/fcmix_serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_par_ex ) IN_FILE="examples/kinsol/parallel/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFoodWeb_kry_bbd_p kinFoodWeb_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; kinsol_fpar_ex ) IN_FILE="examples/kinsol/fcmix_parallel/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cpodes_ser_ex_bl ) IN_FILE="examples/cpodes/serial/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsAdvDiff_bnd cpsAdvDiff_non cpsNewtCrd_dns cpsPend_dns cpsRoberts_dns cpsVanDPol_non" EXAMPLES_BL="cpsAdvDiff_bndL cpsPend_dnsL cpsRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cpodes_ser_ex ) IN_FILE="examples/cpodes/serial/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsAdvDiff_bnd cpsAdvDiff_non cpsNewtCrd_dns cpsPend_dns cpsRoberts_dns cpsVanDPol_non" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; cpodes_par_ex ) IN_FILE="examples/cpodes/parallel/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsHeat2D_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ;; esac done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi # Display summary if test "X${SUNDIALS_WARN_FLAG}" = "Xyes"; then echo " *************** * WARNING * *************** At least one warning was issued. Some features were disabled. Review the configure output and/or the contents of config.log before proceeding with the build. " fi echo " ------------------------------ SUNDIALS Configuration Summary ------------------------------" echo " Configuration ------------- Host System: ${host} Build System: ${build} C Preprocessor: ${CPP} C Preprocessor Flags: ${CPPFLAGS} C Compiler: ${CC} C Compiler Flags ${CFLAGS} C Linker: ${CC} Linker Flags: ${LDFLAGS} Libraries: ${LIBS}" if test "X${F77_OK}" = "Xyes"; then echo " Fortran Compiler: ${F77} Fortran Compiler Flags: ${FFLAGS} Fortran Linker: ${F77_LNKR} Extra Fortran Libraries: ${FLIBS}" fi if test "X${MPI_ENABLED}" = "Xyes" && test "X${MPI_C_COMP_OK}" = "Xyes"; then echo " MPI Root Directory: ${MPI_ROOT_DIR} MPI Include Directory: ${MPI_INC_DIR} MPI Library Directory: ${MPI_LIB_DIR} MPI Flags: ${MPI_FLAGS} Extra MPI Libraries: ${MPI_LIBS} Using MPI-C script? ${USE_MPICC_SCRIPT} MPI-C: ${MPICC}" fi if test "X${MPI_ENABLED}" = "Xyes" && test "X${F77_EXAMPLES_ENABLED}" = "Xyes" && test "X${MPI_F77_COMP_OK}" = "Xyes"; then echo " Using MPI-Fortran script? ${USE_MPIF77_SCRIPT} MPI-Fortran: ${MPIF77} MPI-Fortran Linker: ${MPIF77_LNKR}" fi # Determine SOURCE, BUILD, and EXEC_PREFIX directories cv_srcdir=`( cd ${srcdir} ; pwd )` cv_builddir=`pwd` if test "X${exec_prefix}" = "XNONE"; then cv_exec_prefix="${prefix}" else cv_exec_prefix="${exec_prefix}" fi echo " srcdir: ${cv_srcdir} builddir: ${cv_builddir} prefix: ${prefix} exec_prefix: ${cv_exec_prefix} includedir: ${includedir} libdir: ${libdir}" if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo " examples installed in: ${EXS_INSTDIR}" fi echo " Modules ------- " if test "X${CVODE_ENABLED}" = "Xyes"; then THIS_LINE="CVODE" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FCVODE" fi echo " ${THIS_LINE}" fi if test "X${CVODES_ENABLED}" = "Xyes"; then THIS_LINE="CVODES" echo " ${THIS_LINE}" fi if test "X${IDA_ENABLED}" = "Xyes"; then THIS_LINE="IDA" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FIDA" fi echo " ${THIS_LINE}" fi if test "X${IDAS_ENABLED}" = "Xyes"; then THIS_LINE="IDAS" echo " ${THIS_LINE}" fi if test "X${KINSOL_ENABLED}" = "Xyes"; then THIS_LINE="KINSOL" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FKINSOL" fi echo " ${THIS_LINE}" fi if test "X${CPODES_ENABLED}" = "Xyes"; then THIS_LINE="CPODES" echo " ${THIS_LINE}" fi if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo " Examples -------- " echo " Serial C examples: ${SERIAL_C_EXAMPLES}" echo " Parallel C examples: ${PARALLEL_C_EXAMPLES}" echo " Serial Fortran examples: ${SERIAL_F77_EXAMPLES}" echo " Parallel Fortran examples: ${PARALLEL_F77_EXAMPLES}" fi echo " Type 'make' and then 'make install' to build and install ${PACKAGE_STRING}." echo " ---------------------------------- Finished SUNDIALS Configure Script ---------------------------------- " sundials-2.5.0/LICENSE0000600000175000017500000000575611741421110015224 0ustar sylvestresylvestreCopyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by S.D. Cohen, A.C. Hindmarsh, R. Serban, D. Shumaker, and A.G. Taylor. UCRL-CODE-155951 (CVODE) UCRL-CODE-155950 (CVODES) UCRL-CODE-155952 (IDA) UCRL-CODE-237203 (IDAS) UCRL-CODE-155953 (KINSOL) All rights reserved. This file is part of SUNDIALS. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/configure.ac0000600000175000017500000000733711741421110016502 0ustar sylvestresylvestre# ------------------------------------------------------------------------ # $Revision: 1.52 $ # $Date: 2009/02/17 03:11:47 $ # ------------------------------------------------------------------------ # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ------------------------------------------------------------------------ # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ------------------------------------------------------------------------ # Process this file with autoconf to produce a configure script. # ------------------------------------------------------------------------ # Initialize configure AC_INIT(SUNDIALS, 2.5.0, radu@llnl.gov) # Display greeting SUNDIALS_GREETING # Specify directory containing auxillary build tools and M4 files AC_CONFIG_AUX_DIR([config]) # Miscellaneous SUNDIALS initializations echo "Initialization" echo "--------------" echo "" SUNDIALS_INITIALIZE # Test enable/disable features SUNDIALS_ENABLES # Set C compilation (Required) echo "" echo "C Compiler Settings" echo "-------------------" echo "" AC_PROG_CC(cc gcc) SUNDIALS_SET_CC # Set Fortran support if test "X${FCMIX_ENABLED}" = "Xyes" || test "X${LAPACK_ENABLED}" = "Xyes"; then echo "" echo "Fortran Settings" echo "----------------" echo "" SUNDIALS_F77_SUPPORT fi # Set MPI support (Optional) if test "X${MPI_ENABLED}" = "Xyes"; then echo "" echo "MPI-C Settings" echo "--------------" echo "" SUNDIALS_SET_MPICC fi if test "X${MPI_C_COMP_OK}" = "Xyes"; then if test "X${FCMIX_ENABLED}" = "Xyes"; then echo "" echo "MPI-2 Functionality" echo "-------------------" echo "" SUNDIALS_CHECK_MPI2 fi if test "X${F77_EXAMPLES_ENABLED}" = "Xyes"; then echo "" echo "MPI-Fortran Settings" echo "--------------------" echo "" SUNDIALS_SET_MPIF77 fi fi # Set examples modules if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo "" echo "Examples" echo "--------" echo "" SUNDIALS_SET_EXAMPLES fi # Run libtool checks echo "" echo "Libtool Settings" echo "----------------" echo "" AC_DISABLE_SHARED AC_LIBTOOL_WIN32_DLL AC_PROG_LIBTOOL # Do we build shared libraries? # (enable_shared is set by the function AC_ENABLE_SHARED in libtool.m4) SHARED_LIBS="${enable_shared}" # Print a few more lines for configure --help SUNDIALS_MORE_HELP # Substitute variables AC_SUBST(SHARED_LIBS) AC_SUBST(MPICC) AC_SUBST(MPIF77) AC_SUBST(MPI_INC_DIR) AC_SUBST(MPI_LIB_DIR) AC_SUBST(MPI_LIBS) AC_SUBST(MPI_FLAGS) AC_SUBST(FCMIX_ENABLED) AC_SUBST(FLOAT_TYPE) AC_SUBST(LIBTOOL_DEPS) AC_SUBST(F77_MANGLE_MACRO1) AC_SUBST(F77_MANGLE_MACRO2) AC_SUBST(F77_CASE) AC_SUBST(F77_UNDERSCORES) AC_SUBST(PRECISION_LEVEL) AC_SUBST(GENERIC_MATH_LIB) AC_SUBST(BLAS_LAPACK_MACRO) AC_SUBST(SUNDIALS_EXPORT) AC_SUBST(F77_MPI_COMM_F2C) AC_SUBST(F77_LNKR) AC_SUBST(F77_LIBS) AC_SUBST(F77_LDFLAGS) AC_SUBST(LAPACK_ENABLED) AC_SUBST(BLAS_LAPACK_LIBS) AC_SUBST(MPIF77_LNKR) AC_SUBST(OBJEXT) AC_SUBST(EXEEXT) AC_SUBST(SLV_MODULES) AC_SUBST(EXS_MODULES) AC_SUBST(EXS_INSTDIR) # Generate makefiles echo "" echo "Create Makefiles and configuration files" echo "----------------------------------------" echo "" SUNDIALS_BUILD_MODULES_LIST # Set-up postprocessing commands if test "X${EXAMPLES_ENABLED}" = "Xyes" && test "X${EXS_INSTDIR}" != "Xno"; then AC_CONFIG_COMMANDS([postprocessing], [ echo "" echo "Postprocess exported Makefiles" echo "------------------------------" echo "" ]) SUNDIALS_POST_PROCESSING fi # Specify files to be configured and call AC_OUTPUT AC_CONFIG_FILES([${SUNDIALS_MAKEFILES}]) AC_CONFIG_FILES([${SUNDIALS_CONFIGFILES}]) AC_OUTPUT # Display summary SUNDIALS_REPORT sundials-2.5.0/config.hin0000600000175000017500000000514411741421110016153 0ustar sylvestresylvestre/* config.hin. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the header file. */ #undef HAVE_DLFCN_H /* Define to 1 if you have the header file. */ #undef HAVE_FLOAT_H /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H /* Define to 1 if you have the `m' library (-lm). */ #undef HAVE_LIBM /* Define to 1 if you have the header file. */ #undef HAVE_MATH_H /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_STAT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT /* Define to the full name of this package. */ #undef PACKAGE_NAME /* Define to the full name and version of this package. */ #undef PACKAGE_STRING /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME /* Define to the version of this package. */ #undef PACKAGE_VERSION /* The size of a `double', as computed by sizeof. */ #undef SIZEOF_DOUBLE /* The size of a `float', as computed by sizeof. */ #undef SIZEOF_FLOAT /* The size of a `int', as computed by sizeof. */ #undef SIZEOF_INT /* The size of a `long double', as computed by sizeof. */ #undef SIZEOF_LONG_DOUBLE /* The size of a `long int', as computed by sizeof. */ #undef SIZEOF_LONG_INT /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS /* Availability of Blas/Lapack libraries */ #undef SUNDIALS_BLAS_LAPACK /* Define SUNDIALS data type 'realtype' as 'double' */ #undef SUNDIALS_DOUBLE_PRECISION /* Define SUNDIALS data type 'realtype' as 'long double' */ #undef SUNDIALS_EXTENDED_PRECISION /* FCMIX: Define name-mangling macro for C identifiers */ #undef SUNDIALS_F77_FUNC /* FCMIX: Define name-mangling macro for C identifiers with underscores */ #undef SUNDIALS_F77_FUNC_ /* FNVECTOR: Allow user to specify different MPI communicator */ #undef SUNDIALS_MPI_COMM_F2C /* Define SUNDIALS data type 'realtype' as 'float' */ #undef SUNDIALS_SINGLE_PRECISION /* Use generic math functions */ #undef SUNDIALS_USE_GENERIC_MATH sundials-2.5.0/acinclude.m40000600000175000017500000030042611741421110016400 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.58 $ # $Date: 2010/12/15 22:28:17 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # # SUNDIALS autoconf macros # # The functions defined here fall into the following categories: # # (1) Initializations: # SUNDIALS_GREETING # SUNDIALS_INITIALIZE # SUNDIALS_ENABLES # # (2) C compiler tests # SUNDIALS_SET_CC # SUNDIALS_CC_CHECK # SUNDIALS_CPLUSPLUS_CHECK # # (3) Fortran support # SUNDIALS_F77_SUPPORT # SUNDIALS_F77_CHECK # SUNDIALS_F77_LNKR_CHECK # SUNDIALS_F77_NAME_MANGLING # SUNDIALS_F77_LAPACK_SET # # (4) Parallel support # SUNDIALS_SET_MPICC # SUNDIALS_CHECK_MPICC # SUNDIALS_CC_WITH_MPI_CHECK # SUNDIALS_SET_MPIF77 # SUNDIALS_CHECK_MPIF77 # SUNDIALS_MPIF77_LNKR_CHECK # SUNDIALS_F77_WITH_MPI_CHECK # SUNDIALS_CHECK_MPI2 # # (5) Finalizations: # SUNDIALS_MORE_HELP # SUNDIALS_SET_EXAMPLES # SUNDIALS_BUILD_MODULES_LIST # SUNDIALS_POST_PROCESSING # SUNDIALS_REPORT # # ----------------------------------------------------------------- #=================================================================# # # # # # I N I T I A L I Z A T I O N S # # # # # #================================================================== #------------------------------------------------------------------ # GREETING #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_GREETING], [ # Say Hi! echo " --------------------------------- Running SUNDIALS Configure Script --------------------------------- " ]) dnl END SUNDIALS_GREETING #------------------------------------------------------------------ # PERFORM INITIALIZATIONS #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_INITIALIZE], [ # Reference custom macros m4_include([config/mod_fortran.m4]) m4_include([config/mod_c.m4]) m4_include([config/cust_general.m4]) # Make input filename DOS compatible (change config.h.in to config.hin) AC_CONFIG_HEADERS([config.h:config.hin]) # Make user aware of copyright notice (input COPYRIGHT information) AC_COPYRIGHT( [ Copyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. All rights reserved. For details, see the LICENSE file. ]) # Specify root of source tree # Given file is guaranteed to exist in all SUNDIALS packages AC_CONFIG_SRCDIR([/src/sundials/sundials_nvector.c]) # Get host information # AC_CANONICAL_BUILD defines the following variables: build, build_cpu, # build_vendor, and build_os AC_CANONICAL_BUILD # AC_CANONICAL_HOST defines the following variables: host, host_cpu, # host_vendor, and host_os AC_CANONICAL_HOST # Set MAKE if necessary # Must include @SET_MAKE@ in each Makefile.in file # AC_SUBST is called automatically for SET_MAKE AC_PROG_MAKE_SET # Defines INSTALL (sets to path of "install" program) # Also sets INSTALL_PROGRAM and INSTALL_SCRIPT AC_PROG_INSTALL # Set defaults for config/sundials_config.in file F77_MANGLE_MACRO1="" F77_MANGLE_MACRO2="" PRECISION_LEVEL="" GENERIC_MATH_LIB="" BLAS_LAPACK_MACRO="" F77_MPI_COMM_F2C="" SUNDIALS_EXPORT="#define SUNDIALS_EXPORT" # Initialize enable status of various modules, options, and features # to their default values # # NOTE: when CPODES is released, change its default to enabled. # CVODE_ENABLED="yes" CVODES_ENABLED="yes" IDA_ENABLED="yes" IDAS_ENABLED="yes" KINSOL_ENABLED="yes" LAPACK_ENABLED="yes" FCMIX_ENABLED="yes" MPI_ENABLED="yes" # CPODES_ENABLED="no" # EXAMPLES_ENABLED="no" F77_EXAMPLES_ENABLED="no" # Initialize variables that may NOT necessarily be initialized # during normal execution. Should NOT use uninitialized variables F77_OK="no" LAPACK_OK="no" MPI_C_COMP_OK="no" MPI_F77_COMP_OK="no" # This variable is set to "yes" if an AC_MSG_WARN statement # was executed SUNDIALS_WARN_FLAG="no" ]) dnl END SUNDIALS_INITIALIZE #------------------------------------------------------------------ # TEST ENABLES # # The following variables may be changed here (default value in []): # # CVODE_ENABLED - enable CVODE module [yes] # CVODES_ENABLED - enable CVODES module [yes] # IDA_ENABLED - enable IDA module [yes] # IDAS_ENABLED - enable IDAS module [yes] # KINSOL_ENABLED - enable KINSOL module [yes] # FCMIX_ENABLED - enable Fortran-C interfaces [yes] # LAPACK_ENABLED - enable Lapack support [yes] # MPI_ENABLED - enable parallel support [yes] # EXAMPLES_ENABLED - enable example programs [no] # F77_EXAMPLES_ENABLED - enable Fortran example programs [no] # #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_ENABLES], [ # Check if user wants to disable CVODE module # If not, then make certain source directory actually exists AC_ARG_ENABLE(cvode, [AC_HELP_STRING([--disable-cvode],[disable configuration of CVODE])], [ if test "X${enableval}" = "Xno"; then CVODE_ENABLED="no" fi ], [ if test -d ${srcdir}/src/cvode ; then CVODE_ENABLED="yes" else CVODE_ENABLED="no" fi ]) # Check if user wants to disable CVODES module # If not, then make certain source directory actually exists AC_ARG_ENABLE(cvodes, [AC_HELP_STRING([--disable-cvodes],[disable configuration of CVODES])], [ if test "X${enableval}" = "Xno"; then CVODES_ENABLED="no" fi ], [ if test -d ${srcdir}/src/cvodes ; then CVODES_ENABLED="yes" else CVODES_ENABLED="no" fi ]) # Check if user wants to disable IDA module # If not, then make certain source directory actually exists AC_ARG_ENABLE(ida, [AC_HELP_STRING([--disable-ida],[disable configuration of IDA])], [ if test "X${enableval}" = "Xno"; then IDA_ENABLED="no" fi ], [ if test -d ${srcdir}/src/ida ; then IDA_ENABLED="yes" else IDA_ENABLED="no" fi ]) # Check if user wants to disable IDAS module # If not, then make certain source directory actually exists AC_ARG_ENABLE(idas, [AC_HELP_STRING([--disable-idas],[disable configuration of IDAS])], [ if test "X${enableval}" = "Xno"; then IDAS_ENABLED="no" fi ], [ if test -d ${srcdir}/src/idas ; then IDAS_ENABLED="yes" else IDAS_ENABLED="no" fi ]) # Check if user wants to disable KINSOL MODULE # If not, then make certain source directory actually exists AC_ARG_ENABLE(kinsol, [AC_HELP_STRING([--disable-kinsol],[disable configuration of KINSOL])], [ if test "X${enableval}" = "Xno"; then KINSOL_ENABLED="no" fi ], [ if test -d ${srcdir}/src/kinsol ; then KINSOL_ENABLED="yes" else KINSOL_ENABLED="no" fi ]) # Check if user wants to disable CPODES module # If not, then make certain source directory actually exists AC_ARG_ENABLE(cpodes, [AC_HELP_STRING([--disable-cpodes],[disable configuration of CPODES])], [ if test "X${enableval}" = "Xno"; then CPODES_ENABLED="no" fi ], [ if test -d ${srcdir}/src/cpodes ; then CPODES_ENABLED="yes" else CPODES_ENABLED="no" fi ]) # Check if user wants to disable Fortran support (FCMIX components). AC_ARG_ENABLE([fcmix], [AC_HELP_STRING([--disable-fcmix], [disable Fortran-C support])], [ if test "X${enableval}" = "Xno"; then FCMIX_ENABLED="no" fi ], [ if test "X${CVODE_ENABLED}" = "Xno" && test "X${KINSOL_ENABLED}" = "Xno" && test "X${IDA_ENABLED}" = "Xno"; then FCMIX_ENABLED="no" fi ]) # Check if user wants to disable Lapack support. AC_ARG_ENABLE([lapack], [AC_HELP_STRING([--disable-lapack], [disable Lapack support])], [ if test "X${enableval}" = "Xno"; then LAPACK_ENABLED="no" fi ]) # Check if user wants to disable support for MPI. # If not, set the default based on whetehr certain source directories exist AC_ARG_ENABLE([mpi], [AC_HELP_STRING([--disable-mpi],[disable MPI support])], [ if test "X${enableval}" = "Xno"; then MPI_ENABLED="no" fi ], [ if test -d ${srcdir}/src/nvec_par || test -d ${srcdir}/src/nvec_spcpar; then MPI_ENABLED="yes" else MPI_ENABLED="no" fi ]) # Check if user wants to enable all examples. # Examples are NOT built by default AC_ARG_ENABLE(examples, [AC_HELP_STRING([--enable-examples],[enable configuration of examples])], [ if test "X${enableval}" = "Xno"; then EXAMPLES_ENABLED="no" else EXAMPLES_ENABLED="yes" fi ]) # Fortran examples are enabled only if both FCMIX and EXAMPLES are enabled if test "X${FCMIX_ENABLED}" = "Xyes" && test "X${EXAMPLES_ENABLED}" = "Xyes"; then F77_EXAMPLES_ENABLED="yes" fi ]) dnl END SUNDIALS_ENABLES #=================================================================# # # # # # C C O M P I L E R T E S T S # # # # # #================================================================== #------------------------------------------------------------------ # CHECK C COMPILER #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_SET_CC], [ if test "X${CC}" = "X"; then echo "" echo " Unable to find a working C compiler" echo "" echo " Try using CC to explicitly specify a C compiler" echo "" AC_MSG_ERROR([cannot find a C compiler]) else SUNDIALS_CC_CHECK fi ]) dnl END SUNDIALS_SET_CC AC_DEFUN([SUNDIALS_CC_CHECK], [ # Default is C programming language (initialize language stack) AC_LANG([C]) AC_ARG_WITH([],[],[]) # Set floating-point precision: single [C type 'float'] # double [C type 'double'] (default) # extended [C type 'long double'] # Provide variable description templates for config.hin and config.h files # Required by autoheader utility AH_TEMPLATE([SUNDIALS_SINGLE_PRECISION], [Define SUNDIALS data type 'realtype' as 'float']) AH_TEMPLATE([SUNDIALS_DOUBLE_PRECISION], [Define SUNDIALS data type 'realtype' as 'double']) AH_TEMPLATE([SUNDIALS_EXTENDED_PRECISION], [Define SUNDIALS data type 'realtype' as 'long double']) AC_MSG_CHECKING([floating-point data type to use]) AC_ARG_WITH(precision, [AC_HELP_STRING([--with-precision=ARG], [specify floating-point precision (single/double/extended) [double]])], [ if test "X${withval}" = "Xsingle"; then AC_MSG_RESULT([float]) AC_DEFINE([SUNDIALS_SINGLE_PRECISION],[1],[]) FLOAT_TYPE="single" PRECISION_LEVEL="#define SUNDIALS_SINGLE_PRECISION 1" elif test "X${withval}" = "Xdouble"; then AC_MSG_RESULT([double]) AC_DEFINE([SUNDIALS_DOUBLE_PRECISION],[1],[]) FLOAT_TYPE="double" PRECISION_LEVEL="#define SUNDIALS_DOUBLE_PRECISION 1" elif test "X${withval}" = "Xextended"; then AC_MSG_RESULT([long double]) AC_DEFINE([SUNDIALS_EXTENDED_PRECISION],[1],[]) FLOAT_TYPE="extended" PRECISION_LEVEL="#define SUNDIALS_EXTENDED_PRECISION 1" else AC_MSG_ERROR([invalid input]) fi ], [ # Use 'double' by default AC_MSG_RESULT([double]) AC_DEFINE([SUNDIALS_DOUBLE_PRECISION],[1],[]) FLOAT_TYPE="double" PRECISION_LEVEL="#define SUNDIALS_DOUBLE_PRECISION 1" ]) AC_ARG_WITH([],[ ],[]) # Overwrite CFLAGS AC_MSG_CHECKING([for C compiler flags]) AC_ARG_WITH(cflags, [AC_HELP_STRING([--with-cflags=ARG],[specify C compiler flags (CFLAGS will be overridden)])], [ AC_MSG_RESULT([${withval}]) CFLAGS="${withval}" ], [ AC_MSG_RESULT([none]) ]) # Set CPP to command that runs C preprocessor AC_PROG_CPP # Overwrite CPPFLAGS AC_MSG_CHECKING([for C/C++ preprocessor flags]) AC_ARG_WITH(cppflags, [AC_HELP_STRING([--with-cppflags=ARG],[specify C/C++ preprocessor flags (CPPFLAGS will be overridden)])], [ AC_MSG_RESULT([${withval}]) CPPFLAGS="${withval}" ], [ AC_MSG_RESULT([none]) ]) # Overwrite LDFLAGS AC_MSG_CHECKING([for linker flags]) AC_ARG_WITH(ldflags, [AC_HELP_STRING([--with-ldflags=ARG],[specify linker flags (LDFLAGS will be overridden)])], [ AC_MSG_RESULT([${withval}]) LDFLAGS="${withval}" ], [ AC_MSG_RESULT([none]) ]) # Add any additional libraries AC_MSG_CHECKING([for extra libraries]) AC_ARG_WITH(libs, [AC_HELP_STRING([--with-libs=ARG],[add extra libraries])], [ AC_MSG_RESULT([${withval}]) if test "X${LIBS}" = "X"; then LIBS="${withval}" else LIBS="${LIBS} ${withval}" fi ], [ AC_MSG_RESULT([none]) ]) # Defines STDC_HEADERS if the following header files are found: stdlib.h, # stdarg.h, string.h, and float.h # We really only need stdlib.h and float.h AC_HEADER_STDC AC_CHECK_HEADERS([stdlib.h float.h math.h]) # Set flag indicating if generic function names should be used # Provide variable description template for config.hin and config.h files # Required by autoheader utility AH_TEMPLATE([SUNDIALS_USE_GENERIC_MATH], [Use generic math functions]) # Check if math library contains abs(), fabs(), pow(), and sqrt() functions (required) # May update LIBS (meaning add additional library, namely libm) MATH_FABS_OK="yes" MATH_POW_OK="yes" MATH_SQRT_OK="yes" # Save copy of LIBS variable and unset LIBS SAVED_LIBS="${LIBS}" LIBS="" # The abs routine is defined for an integer argument, so check for it regardless of # the level of precision chosen AC_CHECK_LIB([m],abs,[],[AC_MSG_ERROR([cannot find abs function])]) TEMP_MATH_LIB="${LIBS}" LIBS="" # Check for single-precision math routines if test "X${FLOAT_TYPE}" = "Xsingle"; then AC_CHECK_LIB([m],fabsf,[],[MATH_FABS_OK="no"]) AC_CHECK_LIB([m],powf,[],[MATH_POW_OK="no"]) AC_CHECK_LIB([m],sqrtf,[],[MATH_SQRT_OK="no"]) # Check for extended-precision math routines elif test "X${FLOAT_TYPE}" = "Xextended"; then AC_CHECK_LIB([m],fabsl,[],[MATH_FABS_OK="no"]) AC_CHECK_LIB([m],powl,[],[MATH_POW_OK="no"]) AC_CHECK_LIB([m],sqrtl,[],[MATH_SQRT_OK="no"]) # Check for (generic) double-precision math routines elif test "X${FLOAT_TYPE}" = "Xdouble"; then AC_CHECK_LIB([m],fabs,[],[AC_MSG_ERROR([cannot find fabs function])]) AC_CHECK_LIB([m],pow,[],[AC_MSG_ERROR([cannot find pow function])]) AC_CHECK_LIB([m],sqrt,[],[AC_MSG_ERROR([cannot find sqrt function])]) fi # If cannot find precision-specific implementations, then check for generic versions if test "X${MATH_FABS_OK}" = "Xno" || test "X${MATH_POW_OK}" = "Xno" || test "X${MATH_SQRT_OK}" = "Xno"; then AC_CHECK_LIB([m],fabs,[],[AC_MSG_ERROR([cannot find fabs function])]) AC_CHECK_LIB([m],pow,[],[AC_MSG_ERROR([cannot find pow function])]) AC_CHECK_LIB([m],sqrt,[],[AC_MSG_ERROR([cannot find sqrt function])]) # If all generic math routines are available, then set SUNDIALS_USE_GENERIC_MATH flag # for use by sundials_math.c file (preprocessor macros) AC_DEFINE([SUNDIALS_USE_GENERIC_MATH],[1],[]) GENERIC_MATH_LIB="#define SUNDIALS_USE_GENERIC_MATH" # If found all precision-specific routines, then set SUNDIALS_USE_GENERIC_MATH only if # building SUNDIALS libraries with double-precision else if test "X${FLOAT_TYPE}" = "Xdouble"; then AC_DEFINE([SUNDIALS_USE_GENERIC_MATH],[1],[]) GENERIC_MATH_LIB="#define SUNDIALS_USE_GENERIC_MATH" else AC_DEFINE([SUNDIALS_USE_GENERIC_MATH],[0],[]) fi fi # Add math library to LIBS environment variable LIBS="${TEMP_MATH_LIB}" AC_MSG_CHECKING([for additional required C libraries]) if test "X${LIBS}" = "X"; then if test "X${SAVED_LIBS}" = "X"; then LIBS="" else LIBS="${SAVED_LIBS}" fi AC_MSG_RESULT([none]) else AC_MSG_RESULT([${LIBS}]) if test "X${SAVED_LIBS}" = "X"; then LIBS="${LIBS}" else LIBS="${LIBS} ${SAVED_LIBS}" fi fi # Check sizeof(int) - used to modify Fortran examples AC_CHECK_SIZEOF(int) # Check sizeof(long int) - used to modify Fortran examples AC_CHECK_SIZEOF(long int) # Check sizeof(realtype), where realtype is either float, double # or long double - used to modify Fortran examples if test "X${FLOAT_TYPE}" = "Xsingle"; then AC_CHECK_SIZEOF(float) elif test "X${FLOAT_TYPE}" = "Xdouble"; then AC_CHECK_SIZEOF(double) elif test "X${FLOAT_TYPE}" = "Xextended"; then AC_CHECK_SIZEOF(long double) fi # Defines EGREP and exports via AC_SUBST - used by FCMIX Makefile's AC_PROG_EGREP # Defines FGREP and exports via AC_SUBST - used by FCMIX Makefile's AC_PROG_FGREP # Check if CC is a C++ compiler # Note: If CC is a C++ compiler and MPI is enabled, then we will # check for "mpiCC" instead of "mpicc" if an MPI compiler was NOT specified SUNDIALS_CPLUSPLUS_CHECK([${CC}]) ]) dnl END SUNDIALS_SET_CC #------------------------------------------------------------------ # CHECK IF COMPILER IS A C++ COMPILER #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_CPLUSPLUS_CHECK], [ # Rename argument COMP_NAME="$1" # Update the language stack AC_LANG_PUSH([C]) # Check if using a C++ compiler AC_MSG_CHECKING([if ${COMP_NAME} is a C++ compiler]) AC_RUN_IFELSE( [AC_LANG_PROGRAM([[]], [[ #ifdef __cplusplus return(0); #else return(1); #endif ]])], [ AC_MSG_RESULT([yes]) # COMP_NAME is a C++ compiler USING_CPLUSPLUS_COMP="yes" ], [ AC_MSG_RESULT([no]) # COMP_NAMPE is NOT a C++ compiler USING_CPLUSPLUS_COMP="no" ]) # Revert back to previous language AC_LANG_POP([C]) ]) dnl END SUNDIALS_CPLUSPLUS_CHECK #=================================================================# # # # # # F O R T R A N S U P P O R T # # # # # #================================================================== #------------------------------------------------------------------ # FORTRAN SUPPORT # # Fortran support is required if FCMIX is enabled OR if LAPACK # is enabled. In either case, we need a working F77 compiler in # order to determine the Fortran name-mangling scheme. # # If we do need Fortran support, we first find and test a F77 # compiler, determine the mangling scheme, then we find the # libraries required to link C and Fortran. # # Throughout this function we use the control variable F77_OK # which was initialized to "no". #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_SUPPORT], [ F77_OK="yes" # Look for a F77 compiler # If unsuccessful, disable all Fortran support AC_PROG_F77(f77 g77) if test "X${F77}" = "X"; then F77_OK="no" SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to find a working Fortran compiler" echo "" echo " Try using F77 to explicitly specify a C compiler" echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" FCMIX_ENABLED="no" LAPACK_ENABLED="no" F77_EXAMPLES_ENABLED="no" fi # Check Fortran compiler # If unsuccessful, disable all Fortran support if test "X${F77_OK}" = "Xyes"; then SUNDIALS_F77_CHECK if test "X${F77_OK}" = "Xno"; then SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to compile test program using given Fortran compiler." echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" FCMIX_ENABLED="no" LAPACK_ENABLED="no" F77_EXAMPLES_ENABLED="no" fi fi # Determine the Fortran name-mangling scheme # If successfull, provide variable description templates for config.hin # and config.h files required by autoheader utility # Otherwise, disable all Fortran support. if test "X${F77_OK}" = "Xyes"; then SUNDIALS_F77_NAME_MANGLING AH_TEMPLATE([SUNDIALS_F77_FUNC], [FCMIX: Define name-mangling macro for C identifiers]) AH_TEMPLATE([SUNDIALS_F77_FUNC_], [FCMIX: Define name-mangling macro for C identifiers with underscores]) if test "X${F77_OK}" = "Xno"; then SUNDIALS_WARN_FLAG="yes" echo "" echo " Unable to determine Fortran name-mangling scheme." echo "" if test "X${FCMIX_ENABLED}" = "Xyes"; then echo " Disabling compilation of Fortran-C interfaces..." fi if test "X${LAPACK_ENABLED}" = "Xyes"; then echo " Disabling compilation of Blas/Lapack interfaces..." fi echo "" F77_EXAMPLES_ENABLED="no" FCMIX_ENABLED="no" LAPACK_ENABLED="no" fi fi # If LAPACK is enabled, determine the proper library linkage # If successful, set the libaries # Otherwise, disable all Blas/Lapack support. if test "X${LAPACK_ENABLED}" = "Xyes" && test "X${F77_OK}" = "Xyes"; then SUNDIALS_F77_LAPACK_SET if test "X${LAPACK_OK}" = "Xyes"; then AC_MSG_CHECKING([for Blas/Lapack library linkage]) BLAS_LAPACK_LIBS="${LAPACK_LIBS} ${BLAS_LIBS} ${LIBS} ${FLIBS}" AC_MSG_RESULT([${LAPACK_LIBS} ${BLAS_LIBS}]) else SUNDIALS_WARN_FLAG="yes" AC_MSG_CHECKING([for Blas/Lapack library linkage]) AC_MSG_RESULT("no") echo "" echo " Unable to determine Blas/Lapack library linkage." echo "" echo " Try using --with-blas and --with-lapack." echo "" echo " Disabling compilation of Blas/Lapack interfaces..." LAPACK_ENABLED="no" fi fi # Set the macro BLAS_LAPACK_MACRO for expansion in sundials_config.h AH_TEMPLATE([SUNDIALS_BLAS_LAPACK], [Availability of Blas/Lapack libraries]) if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_DEFINE([SUNDIALS_BLAS_LAPACK],[1],[]) BLAS_LAPACK_MACRO="#define SUNDIALS_BLAS_LAPACK 1" else AC_DEFINE([SUNDIALS_BLAS_LAPACK],[0],[]) BLAS_LAPACK_MACRO="#define SUNDIALS_BLAS_LAPACK 0" fi ]) dnl SUNDIALS_F77_SUPPORT #------------------------------------------------------------------ # CHECK FORTRAN COMPILER # # Test the Fortran compiler by attempting to compile and link a # simple Fortran program. If the test succeeds, set F77_OK=yes. # If the test fails, set F77_OK="no" # # Finally, check if we must use a Fortran compiler to link the # Fortran codes (default is to use CC). #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_CHECK], [ AC_LANG_PUSH([Fortran 77]) # Add any additional FFLAGS AC_MSG_CHECKING([for extra Fortran compiler flags]) AC_ARG_WITH(fflags, [AC_HELP_STRING([--with-fflags=ARG],[add extra Fortran compiler flags])], [ AC_MSG_RESULT([${withval}]) FFLAGS="${FFLAGS} ${withval}" ], [ AC_MSG_RESULT([none]) ]) # Add any required linker flags to FLIBS # Note: if FLIBS is defined, it is left unchanged AC_F77_LIBRARY_LDFLAGS # Try to compile a simple Fortran program (no linking) AC_COMPILE_IFELSE( [AC_LANG_SOURCE( [[ SUBROUTINE SUNDIALS() RETURN END ]])], [F77_OK="yes"], [F77_OK="no"]) # If CC is a C++ compiler (decided in SUNDIALS_CPLUSPLUS_CHECK), we must use # it to link the Fortran examples. In this case, test if that is successful. # Otherwise, simply use F77 as the linker if test "X${F77_OK}" = "Xyes"; then AC_MSG_CHECKING([which linker to use]) if test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then SUNDIALS_F77_LNKR_CHECK else F77_LNKR="${F77}" fi AC_MSG_RESULT([${F77_LNKR}]) fi # Reset language (remove 'Fortran 77' from stack) AC_LANG_POP([Fortran 77]) ]) dnl END SUNDIALS_SET_F77 #------------------------------------------------------------------ # F77 LINKER CHECK # Check if the C++ compiler CC can be used to link a Fortran program. #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_LNKR_CHECK], [ F77_LNKR_CHECK_OK="no" # Compile simple Fortran example, but do NOT link # Note: result stored as conftest.${ac_objext} AC_COMPILE_IFELSE( [AC_LANG_SOURCE( [[ PROGRAM SUNDIALS WRITE(*,*)'TEST' END ]])], [ # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="${LIBS} ${FLIBS}" # Switch working language to C for next test AC_LANG_PUSH([C]) # Check if CC can link Fortran example # Note: AC_LINKONLY_IFELSE is a custom macro (modifications made to # general.m4 and c.m4) (see config/cust_general.m4 and config/mod_c.m4) AC_LINKONLY_IFELSE([],[F77_LNKR_CHECK_OK="yes"],[F77_LNKR_CHECK_OK="no"]) # Revert back to previous language (Fortran 77) AC_LANG_POP([C]) # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" ]) # If either the compilation or the linking failed, we should # disable building the Fortran examples # For now, use F77 as the linker... if test "X${F77_LNKR_CHECK_OK}" = "Xyes"; then F77_LNKR="${CC}" else F77_LNKR="${F77}" fi ]) dnl SUNDIALS_F77_LNKR_CHECK #------------------------------------------------------------------ # DETERMINE FORTRAN NAME-MANGLING SCHEME # # Compiling a simple Fortran example and link it using a C compiler. # Interpret results to infer name-mangling scheme. #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_NAME_MANGLING], [ AC_LANG_PUSH([Fortran 77]) # (1) Compile a dummy Fortran subroutine named SUNDIALS FNAME_STATUS="none" AC_COMPILE_IFELSE( [AC_LANG_SOURCE( [[ SUBROUTINE SUNDIALS() RETURN END ]])], [ mv conftest.${ac_objext} f77_wrapper_check.${ac_objext} # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="f77_wrapper_check.${ac_objext} ${LIBS} ${FLIBS}" AC_LANG_PUSH([C]) for i in "sundials" "SUNDIALS" do for j in "" "_" "__" do F77_MANGLED_NAME="${i}${j}" AC_LINK_IFELSE([AC_LANG_CALL([],[${F77_MANGLED_NAME}])],[FNAME_STATUS="set" ; break 2]) done done AC_LANG_POP([C]) # If test succeeded, then set the F77_MANGLE_MACRO1 macro if test "X${FNAME_STATUS}" = "Xset"; then if test "X${i}" = "Xsundials"; then FNAME_MSG="lower case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name" dgemm="dgemm" dgetrf="dgetrf" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name ## _],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name ## _" dgemm="dgemm_" dgetrf="dgetrf_" else FNAME_MSG="${FNAME_MSG} + two underscores" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name ## __],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) name ## __" dgemm="dgemm__" dgetrf="dgetrf__" fi else FNAME_MSG="upper case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME" dgemm="DGEMM" dgetrf="DGETRF" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name ## _],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME ## _" dgemm="DGEMM_" dgetrf="DGETRF_" else FNAME_MSG="${FNAME_MSG} + two underscores" AC_DEFINE([SUNDIALS_F77_FUNC(name,NAME)],[name ## __],[]) F77_MANGLE_MACRO1="#define SUNDIALS_F77_FUNC(name,NAME) NAME ## __" dgemm="DGEMM__" dgetrf="DGETRF__" fi fi AC_MSG_CHECKING([for Fortran name-mangling scheme of C identifiers]) AC_MSG_RESULT([${FNAME_MSG}]) else F77_OK="no" fi # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" ]) # Remove temporary file rm -f f77_wrapper_check.${ac_objext} # (2) Compile a dummy Fortran subroutine named SUN_DIALS FNAME_STATUS="none" AC_COMPILE_IFELSE( [AC_LANG_SOURCE( [[ SUBROUTINE SUN_DIALS() RETURN END ]])], [ mv conftest.${ac_objext} f77_wrapper_check.${ac_objext} # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="f77_wrapper_check.${ac_objext} ${LIBS} ${FLIBS}" AC_LANG_PUSH([C]) for i in "sun_dials" "SUN_DIALS" do for j in "" "_" "__" do F77_MANGLED_NAME="${i}${j}" AC_LINK_IFELSE([AC_LANG_CALL([],[${F77_MANGLED_NAME}])],[FNAME_STATUS="set" ; break 2]) done done AC_LANG_POP([C]) # If test succeeded, then set the F77_MANGLE_MACRO2 macro if test "X${FNAME_STATUS}" = "Xset"; then if test "X${i}" = "Xsun_dials"; then FNAME_MSG="lower case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name ## _],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name ## _" else FNAME_MSG="${FNAME_MSG} + two underscores" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name ## __],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) name ## __" fi else FNAME_MSG="upper case " if test "X${j}" = "X"; then FNAME_MSG="${FNAME_MSG} + no underscore" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME" elif test "X${j}" = "X_"; then FNAME_MSG="${FNAME_MSG} + one underscore" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name ## _],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## _" else FNAME_MSG="${FNAME_MSG} + two underscores" AC_DEFINE([SUNDIALS_F77_FUNC_(name,NAME)],[name ## __],[]) F77_MANGLE_MACRO2="#define SUNDIALS_F77_FUNC_(name,NAME) NAME ## __" fi fi AC_MSG_CHECKING([for Fortran name-mangling scheme of C identifiers with underscores]) AC_MSG_RESULT([${FNAME_MSG}]) else F77_OK="no" fi # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" ]) # Remove temporary file rm -f f77_wrapper_check.${ac_objext} AC_LANG_POP([Fortran 77]) ]) dnl END SUNDIALS_SET_FNAME #------------------------------------------------------------------ # DETERMINE BLAS/LAPACK LIBRARY LINKAGE SCHEME # # If successful, this function sets LAPACK_OK="yes". # Otherwise, it sets LAPACK_OK="no" #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_LAPACK_SET], [ # Check if the user specifies Blas libraries AC_ARG_WITH(blas, [AC_HELP_STRING([--with-blas=ARG],[specify Blas library])], [ case $withval in -* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$withval" ;; *) BLAS_LIBS="-l$withval" ;; esac ]) # Check if the user specifies Lapack libraries AC_ARG_WITH(lapack, [AC_HELP_STRING([--with-lapack=ARG],[specify Lapack library])], [ case $withval in -* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$withval" ;; *) LAPACK_LIBS="-l$withval" ;; esac ]) acx_blas_ok=no acx_lapack_ok=no # BLAS_LIBS # --------- acx_blas_save_LIBS="$LIBS" LIBS="$LIBS $FLIBS" # First, check BLAS_LIBS environment variable if test "x$BLAS_LIBS" != x; then save_LIBS="$LIBS" LIBS="$BLAS_LIBS $LIBS" AC_MSG_CHECKING([aha for $dgemm in $BLAS_LIBS]) AC_TRY_LINK_FUNC($dgemm, [acx_blas_ok=yes], [BLAS_LIBS=""]) AC_MSG_RESULT($acx_blas_ok) LIBS="$save_LIBS" fi # BLAS linked to by default? (happens on some supercomputers) if test $acx_blas_ok = no; then save_LIBS="$LIBS"; LIBS="$LIBS" AC_CHECK_FUNC($dgemm, [acx_blas_ok=yes]) LIBS="$save_LIBS" fi # BLAS in Alpha CXML library? if test $acx_blas_ok = no; then AC_CHECK_LIB(cxml, $dgemm, [acx_blas_ok=yes;BLAS_LIBS="-lcxml"]) fi # BLAS in Alpha DXML library? (now called CXML, see above) if test $acx_blas_ok = no; then AC_CHECK_LIB(dxml, $dgemm, [acx_blas_ok=yes;BLAS_LIBS="-ldxml"]) fi # BLAS in Sun Performance library? if test $acx_blas_ok = no; then if test "x$GCC" != xyes; then # only works with Sun CC AC_CHECK_LIB(sunmath, acosp, [AC_CHECK_LIB(sunperf, $dgemm, [BLAS_LIBS="-xlic_lib=sunperf -lsunmath" acx_blas_ok=yes],[],[-lsunmath])]) fi fi # BLAS in SCSL library? (SGI/Cray Scientific Library) if test $acx_blas_ok = no; then AC_CHECK_LIB(scs, $dgemm, [acx_blas_ok=yes; BLAS_LIBS="-lscs"]) fi # BLAS in SGIMATH library? if test $acx_blas_ok = no; then AC_CHECK_LIB(complib.sgimath, $dgemm, [acx_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"]) fi # BLAS in IBM ESSL library? (requires generic BLAS lib, too) if test $acx_blas_ok = no; then AC_CHECK_LIB(blas, $dgemm, [AC_CHECK_LIB(essl, $dgemm, [acx_blas_ok=yes; BLAS_LIBS="-lessl -lblas"], [], [-lblas $FLIBS])]) fi # Generic BLAS library? if test $acx_blas_ok = no; then AC_CHECK_LIB(blas, $dgemm, [acx_blas_ok=yes; BLAS_LIBS="-lblas"]) fi LIBS="$acx_blas_save_LIBS" # LAPACK # ------ # If we didn't find a Blas implementation, disable tests for Lapack if test $acx_blas_ok = no; then acx_lapack_ok=disabled fi # Check LAPACK_LIBS environment variable if test $acx_lapack_ok = no; then if test "x$LAPACK_LIBS" != x; then save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS" AC_MSG_CHECKING([for $dgetrf in $LAPACK_LIBS]) AC_TRY_LINK_FUNC($dgetrf, [acx_lapack_ok=yes], [LAPACK_LIBS=""]) AC_MSG_RESULT($acx_lapack_ok) LIBS="$save_LIBS" if test acx_lapack_ok = no; then LAPACK_LIBS="" fi fi fi # LAPACK linked to by default? (is sometimes included in BLAS lib) if test $acx_lapack_ok = no; then save_LIBS="$LIBS" LIBS="$LIBS $BLAS_LIBS $FLIBS" AC_CHECK_FUNC($dgetrf, [acx_lapack_ok=yes]) LIBS="$save_LIBS" fi # Generic LAPACK library? for lapack in lapack lapack_rs6k; do if test $acx_lapack_ok = no; then save_LIBS="$LIBS" LIBS="$BLAS_LIBS $LIBS" AC_CHECK_LIB($lapack, $dgetrf, [acx_lapack_ok=yes; LAPACK_LIBS="-l$lapack"], [], [$FLIBS]) LIBS="$save_LIBS" fi done # If we have both libraries, set LAPACK_OK to yes # ----------------------------------------------------- if test $acx_blas_ok = yes && test $acx_lapack_ok = yes; then LAPACK_OK="yes" else LAPACK_OK="no" fi ]) dnl SUNDIALS_F77_LAPACK_SET #=================================================================# # # # # # P A R A L L E L S U P P O R T # # # # # #================================================================== #------------------------------------------------------------------ # CHECK MPI-C COMPILER #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_SET_MPICC], [ AC_ARG_WITH([],[ ],[]) # MPI root directory AC_ARG_WITH(mpi-root, [AC_HELP_STRING([--with-mpi-root=MPIROOT],[use MPI root directory])], [ MPI_ROOT_DIR="${withval}" ], [ MPI_ROOT_DIR="" ]) # MPI include directory AC_ARG_WITH(mpi-incdir, [AC_HELP_STRING([--with-mpi-incdir=DIR],[MPI include directory @<:@MPIROOT/include@:>@])], [ MPI_INC_DIR="${withval}" ], [ MPI_INC_DIR="" ]) # MPI library directory AC_ARG_WITH(mpi-libdir, [AC_HELP_STRING([--with-mpi-libdir=DIR],[MPI library directory @<:@MPIROOT/lib@:>@])], [ MPI_LIB_DIR="${withval}" ], [ MPI_LIB_DIR="" ]) # MPI libraries AC_ARG_WITH(mpi-libs, [AC_HELP_STRING([--with-mpi-libs=ARG],[MPI libraries])], [ MPI_LIBS="${withval}" ], [ MPI_LIBS="" ]) # MPI flags AC_ARG_WITH(mpi-flags, [AC_HELP_STRING([--with-mpi-flags=ARG],[MPI-specific flags])], [ MPI_FLAGS="${withval}" MPI_FLAGS_OK="yes" ], [ MPI_FLAGS="" MPI_FLAGS_OK="no" ]) # MPI-C compiler MPICC_COMP_GIVEN="yes" AC_MSG_CHECKING([if using MPI-C script]) AC_ARG_WITH(mpicc, [AC_HELP_STRING([--with-mpicc[[[[=ARG]]]]],[specify MPI-C compiler to use @<:@mpicc@:>@])], [ if test "X${withval}" = "Xno"; then USE_MPICC_SCRIPT="no" else USE_MPICC_SCRIPT="yes" MPICC_COMP="${withval}" fi ], [ USE_MPICC_SCRIPT="yes" MPICC_COMP="mpicc" MPICC_COMP_GIVEN="no" ]) AC_MSG_RESULT([${USE_MPICC_SCRIPT}]) # If CC is a C++ compiler, then we certainly do NOT want to use an MPI-C script # Note: USING_CPLUSPLUS_COMP was defined by a call to SUNDIALS_CPLUSPLUS_CHECK # in SUNDIALS_SET_CC # Note: If the user specified an MPI-C script, then we will NOT do anything for now if test "X${MPICC_COMP_GIVEN}" = "Xno" && test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then MPICC_COMP="mpiCC" fi # Check MPI-C compiler (either MPI compiler script or regular C compiler) if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then SUNDIALS_CHECK_MPICC else MPICC_COMP="${CC}" MPICC="${CC}" SUNDIALS_CC_WITH_MPI_CHECK fi ]) dnl END SUNDIALS_SET_MPICC #------------------------------------------------------------------ # TEST MPI-C COMPILER #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_CHECK_MPICC], [ # Test MPI-C compiler (meaning test MPICC_COMP) # Check if MPI-C compiler can be found AC_MSG_CHECKING([if absolute path to ${MPICC_COMP} was given]) # CASE 1: MPICC_COMP was found (cannot check if executable because the # "-x" flag is NOT portable) if test -f ${MPICC_COMP} ; then AC_MSG_RESULT([yes]) MPICC_COMP_EXISTS="yes" # Determine MPI_INC_DIR and MPI_LIB_DIR for use by Makefile MPI_BASE_DIR=`AS_DIRNAME(["${MPICC_COMP}"])` TMP_MPI_INC_DIR="${MPI_BASE_DIR}/../include" TMP_MPI_LIB_DIR="${MPI_BASE_DIR}/../lib" # CASE 2: MPICC_COMP could NOT be found and MPI_ROOT_DIR was NOT specified, # so search in PATH else AC_MSG_RESULT([no]) if test "X${MPI_ROOT_DIR}" = "X"; then # Try to find location of executable (perhaps directory was entered # incorrectly) TEMP_MPICC_COMP=`basename "${MPICC_COMP}"` AC_PATH_PROG([MPICC_COMP],[${TEMP_MPICC_COMP}],[none]) # Cannot find executable in PATH if test "X${MPICC_COMP}" = "Xnone"; then MPICC_COMP_EXISTS="no" MPICC_COMP="" # Found executable and set MPICC_COMP to absolute pathname else MPICC_COMP_EXISTS="yes" MPI_BASE_DIR=`AS_DIRNAME(["${MPICC_COMP}"])` TMP_MPI_INC_DIR="${MPI_BASE_DIR}/../include" TMP_MPI_LIB_DIR="${MPI_BASE_DIR}/../lib" fi # CASE 3: MPICC_COMP could NOT be found, but MPI_ROOT_DIR was specified else AC_MSG_CHECKING([if ${MPICC_COMP} exists in ${MPI_ROOT_DIR}/bin]) # MPICC_COMP should really only contain an executable name # Found location of MPICC_COMP if test -f ${MPI_ROOT_DIR}/bin/${MPICC_COMP} ; then AC_MSG_RESULT([yes]) MPICC_COMP_EXISTS="yes" MPICC_COMP="${MPI_ROOT_DIR}/bin/${MPICC_COMP}" TMP_MPI_INC_DIR="${MPI_ROOT_DIR}/include" TMP_MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" # Could NOT find MPICC_COMP anywhere else AC_MSG_RESULT([no]) MPICC_COMP_EXISTS="no" MPICC_COMP="" fi fi fi # If MPICC_COMP exists, set MPICC and (conditionally) set MPI_INC_DIR # and MPI_LIB_DIR so that we do not end up with empty -I options. # Otherwise, issue warning message if test "X${MPICC_COMP_EXISTS}" = "Xyes"; then MPICC="${MPICC_COMP}" MPI_C_COMP_OK="yes" # If MPI_INC_DIR is empty, set it to TMP_MPI_INC_DIR if test "X${MPI_INC_DIR}" = "X"; then MPI_INC_DIR="$TMP_MPI_INC_DIR" fi # If MPI_LIB_DIR is empty, set it to TMP_MPI_LIB_DIR if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="$TMP_MPI_LIB_DIR" fi else AC_MSG_WARN([cannot find MPI-C compiler]) echo "" echo " Unable to find a functional MPI-C compiler." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPICC="" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi ]) dnl END SUNDIALS_CHECK_MPICC #------------------------------------------------------------------ # TEST C COMPILER WITH MPI #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_CC_WITH_MPI_CHECK], [ # Test if we can compile MPI programs using the CC compiler # and current MPI settings AC_MSG_NOTICE([Testing CC with MPI settings]) # Save copies of CPPFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_CPPFLAGS="${CPPFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" AC_MSG_CHECKING([for location of MPI implementation]) # If MPI include directory was NOT explicitly specified, check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # If MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then AC_MSG_RESULT([not found]) MPI_EXISTS="no" AC_MSG_WARN([cannot find MPI implementation files]) echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update CPPFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" AC_MSG_RESULT([${MPI_INC_DIR}]) if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # MPI include directory was specified so update CPPFLAGS else AC_MSG_RESULT([${MPI_INC_DIR}]) if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then AC_MSG_CHECKING([for location of MPI libraries]) # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" AC_MSG_RESULT([${MPI_LIB_DIR}]) if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else AC_MSG_RESULT([${MPI_LIB_DIR}]) if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries must be included # If no libraries are given, then issue a warning message AC_MSG_CHECKING([for MPI libraries]) if test "X${MPI_LIBS}" = "X"; then AC_MSG_RESULT([none]) AC_MSG_WARN([no MPI libraries were given]) echo "" echo " Unable to compile MPI program using C compiler because" echo " MPI libraries were not specified." echo "" echo " Try using --with-mpi-libdir and --with-mpi-libs to" echo " specify the location and names of the MPI libraries." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" # MPI libraries were specified so update LIBS else AC_MSG_RESULT([${MPI_LIBS}]) if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi # Set the MPI_C_COMP_OK variable to NULL so we can conditionally execute # the next test MPI_C_COMP_OK="" fi if test "X${MPI_C_COMP_OK}" = "X"; then AC_MSG_CHECKING([if C compiler can compile MPI programs]) AC_LINK_IFELSE( [AC_LANG_PROGRAM([[#include "mpi.h"]],[[int c; char **v; MPI_Init(&c,&v);]])], [AC_MSG_RESULT([yes]) MPI_C_COMP_OK="yes"], [AC_MSG_RESULT([no]) AC_MSG_WARN([C compiler cannot compile MPI programs]) echo "" echo " Unable to compile MPI program using C compiler." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling the parallel NVECTOR module and all parallel examples..." echo "" MPI_C_COMP_OK="no" SUNDIALS_WARN_FLAG="yes"]) fi else MPI_C_COMP_OK="no" fi # Restore CPPFLAGS, LDFLAGS and LIBS CPPFLAGS="${SAVED_CPPFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" ]) dnl END SUNDIALS_CC_WITH_MPI_CHECK #------------------------------------------------------------------ # SET MPI-F77 COMPILER # # These tests are done only if all of the following are still true: # - MPI is enabled # - F77 examples are enabled # - F77 works #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_SET_MPIF77], [ AC_MSG_CHECKING([if using MPI-Fortran script]) AC_ARG_WITH(mpif77, [AC_HELP_STRING([--with-mpif77[[[[=ARG]]]]],[specify MPI-Fortran compiler to use @<:@mpif77@:>@])], [ if test "X${withval}" = "Xno"; then USE_MPIF77_SCRIPT="no" else USE_MPIF77_SCRIPT="yes" MPIF77_COMP="${withval}" fi ], [ USE_MPIF77_SCRIPT="yes" MPIF77_COMP="mpif77" ]) AC_MSG_RESULT([${USE_MPIF77_SCRIPT}]) # Check MPI-Fortran compiler (either MPI compiler script or regular Fortran compiler) if test "X${USE_MPIF77_SCRIPT}" = "Xyes"; then SUNDIALS_CHECK_MPIF77 else MPIF77_COMP="${F77}" MPIF77="${F77}" SUNDIALS_F77_WITH_MPI_CHECK fi ]) dnl END SUNDIALS_SET_MPIF77 #------------------------------------------------------------------ # TEST MPIF77 COMPILER SCRIPT #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_CHECK_MPIF77], [ # Test the MPI-Fortran compiler (meaning test MPIF77_COMP) # Check if MPI-Fortran compiler can be found AC_MSG_CHECKING([if absolute path to ${MPIF77_COMP} was given]) # CASE 1: MPIF77_COMP was found (cannot check if executable because the # "-x" flag is NOT portable) if test -f ${MPIF77_COMP} ; then AC_MSG_RESULT([yes]) MPIF77_COMP_EXISTS="yes" # Determine MPI_INC_DIR and MPI_LIB_DIR for use by Makefile MPI_BASE_DIR=`AS_DIRNAME(["${MPIF77_COMP}"])` # CASE 2: MPIF77_COMP could NOT be found and MPI_ROOT_DIR was NOT specified, # so search in PATH else AC_MSG_RESULT([no]) if test "X${MPI_ROOT_DIR}" = "X"; then # Try to find location of executable (perhaps directory was entered incorrectly) TEMP_MPIF77_COMP=`basename "${MPIF77_COMP}"` AC_PATH_PROG([MPIF77_COMP],[${TEMP_MPIF77_COMP}],[none]) # Cannot find executable in PATH if test "X${MPIF77_COMP}" = "Xnone"; then MPIF77_COMP_EXISTS="no" MPIF77_COMP="" # Found executable and set MPIF77_COMP to absolute pathname else MPIF77_COMP_EXISTS="yes" MPI_BASE_DIR=`AS_DIRNAME(["${MPIF77_COMP}"])` fi # CASE 3: MPIF77_COMP could NOT be found, but MPI_ROOT_DIR was specified else AC_MSG_CHECKING([if ${MPIF77_COMP} exists in ${MPI_ROOT_DIR}/bin]) # MPIF77_COMP should really only contain an executable name # Found location of MPIF77_COMP if test -f ${MPI_ROOT_DIR}/bin/${MPIF77_COMP} ; then AC_MSG_RESULT([yes]) MPIF77_COMP_EXISTS="yes" MPIF77_COMP="${MPI_ROOT_DIR}/bin/${MPIF77_COMP}" # Could NOT find MPIF77_COMP anywhere else AC_MSG_RESULT([no]) MPIF77_COMP_EXISTS="no" MPIF77_COMP="" fi fi fi # Issue warning message if MPIF77_COMP does NOT exist, else set MPIF77 if test "X${MPIF77_COMP_EXISTS}" = "Xyes"; then MPIF77="${MPIF77_COMP}" MPI_F77_COMP_OK="yes" # Note that we do not have to worry about empty MPI_INC_DIR and MPI_LIB_DIR # here as they were set in SUNDIALS_CHECK_MPICC # Check if we must use the MPI-Fortran compiler script (MPIF77) to link # the Fortran examples (default is to use MPICC) SUNDIALS_MPIF77_LNKR_CHECK else AC_MSG_WARN([cannot find MPI-Fortran compiler]) echo "" echo " Unable to find a functional MPI-Fortran compiler." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling parallel Fortran examples...." echo "" MPIF77="" MPI_F77_COMP_OK="no" SUNDIALS_WARN_FLAG="yes" fi ]) dnl END SUNDIALS_CHECK_MPIF77 #------------------------------------------------------------------ # DETERMINE MPI-FORTRAN LINKER IF USING MPIF77 SCRIPT #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_MPIF77_LNKR_CHECK], [ # If we are NOT using an MPI script, then MPICC_COMP == CC and we do NOT need # to check again if CC is a C++ compiler as we already know the answer if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then # Check if using a C++ compiler (meaning MPI-C++ script) # Save result from CC check SAVED_USING_CPLUSPLUS_COMP="${USING_CPLUSPLUS_COMP}" SUNDIALS_CPLUSPLUS_CHECK([${MPICC_COMP}]) # MPICC uses a C++ compiler so run the next test if test "X${USING_CPLUSPLUS_COMP}" = "Xyes" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xyes"; then RUN_MPIF77_LNKR_CHECK="yes" # ERROR elif test "X${USING_CPLUSPLUS_COMP}" = "Xyes" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xno"; then AC_MSG_ERROR([${MPICC_COMP} is a C++ compiler but ${CC} is a C compiler]) # MPICC uses a C compiler so skip the next test elif test "X${USING_CPLUSPLUS_COMP}" = "Xno" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xno" ; then RUN_MPIF77_LNKR_CHECK="no" # ERROR elif test "X${USING_CPLUSPLUS_COMP}" = "Xno" && test "X${SAVED_USING_CPLUSPLUS_COMP}" = "Xyes" ; then AC_MSG_ERROR([${MPICC_COMP} is a C compiler but ${CC} is a C++ compiler]) fi # Restore result from CC check USING_CPLUSPLUS_COMP="${SAVED_USING_CPLUSPLUS_COMP}" else AC_MSG_CHECKING([if ${MPICC_COMP} is a C++ compiler]) if test "X${USING_CPLUSPLUS_COMP}" = "Xyes"; then AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi fi AC_MSG_CHECKING([which linker to use]) # Perform the next test only if using a C++ compiler to build NVECTOR_PARALLEL if test "X${RUN_MPIF77_LNKR_CHECK}" = "Xyes"; then MPIF77_LNKR_CHECK_OK="no" # Switch language to "Fortran 77" AC_LANG_PUSH([Fortran 77]) # Temporarily reset F77 environment variable to perform test SAVED_F77="${F77}" F77="${MPIF77_COMP}" # Compile simple Fortran example, but do NOT link # Note: result stored as conftest.${ac_objext} AC_COMPILE_IFELSE( [AC_LANG_SOURCE( [[ PROGRAM SUNDIALS INTEGER IER CALL MPI_INIT(IER) END ]])], [ # Reset F77 to original value F77="${SAVED_F77}" # Revert to previous language AC_LANG_POP([Fortran 77]) # Temporarily reset LIBS environment variable to perform test SAVED_LIBS="${LIBS}" LIBS="${LIBS} ${FLIBS}" # Switch working language to C for next test AC_LANG_PUSH([C]) # Temporarily reset CC environment variable to perform next test SAVED_CC="${CC}" CC="${MPICC_COMP}" # Check if MPICC_COMP can link Fortran example # Note: AC_LINKONLY_IFELSE is a custom macro (modifications made to # general.m4 and c.m4) AC_LINKONLY_IFELSE([],[MPIF77_LNKR_CHECK_OK="yes"],[MPIF77_LNKR_CHECK_OK="no"]) # Reset CC to original value CC="${SAVED_CC}" # Revert back to previous language (Fortran 77) AC_LANG_POP([C]) # Set LIBS environment variable back to original value LIBS="${SAVED_LIBS}" ]) # If either the compilation or the linking failed, we should # disable building the parallel Fortran examples # For now, use MPIF77 as the linker... if test "X${MPIF77_LNKR_CHECK_OK}" = "Xyes"; then MPIF77_LNKR="${MPICC}" else MPIF77_LNKR="${MPIF77}" fi else # Using a C compiler so use MPIF77 to link parallel Fortran examples MPIF77_LNKR="${MPIF77}" fi AC_MSG_RESULT([${MPIF77_LNKR}]) ]) dnl SUNDIALS_MPIF77_LNKR_CHECK #------------------------------------------------------------------ # TEST FORTRAN COMPILER WITH MPI #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_F77_WITH_MPI_CHECK], [ # Test if we can compile MPI programs using the F77 compiler # and current MPI settings AC_MSG_NOTICE([Testing F77 with MPI settings]) AC_LANG_PUSH([Fortran 77]) # Save copies of FFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_FFLAGS="${FFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # This may seem redundant, but we are not guaranteed that # SUNDIALS_CC_WITH_MPI_CHECK has been executed # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" AC_MSG_CHECKING([for location of MPI implementation]) # If MPI include directory was NOT explicitly specified so check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # If MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then AC_MSG_RESULT([not found]) MPI_EXISTS="no" AC_MSG_WARN([cannot find MPI implementation files]) echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling all parallel Fortran examples..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update FFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" AC_MSG_RESULT([${MPI_INC_DIR}]) if test "X${FFLAGS}" = "X"; then FFLAGS="-I${MPI_INC_DIR}" else FFLAGS="${FFLAGS} -I${MPI_INC_DIR}" fi fi # MPI include directory was specified so update FFLAGS else AC_MSG_RESULT([${MPI_INC_DIR}]) if test "X${FFLAGS}" = "X"; then FFLAGS="-I${MPI_INC_DIR}" else FFLAGS="${FFLAGS} -I${MPI_INC_DIR}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then AC_MSG_CHECKING([for location of MPI libraries]) # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" AC_MSG_RESULT([${MPI_LIB_DIR}]) if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else AC_MSG_RESULT([${MPI_LIB_DIR}]) if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries must be included # If no libraries are given, then issue a warning message AC_MSG_CHECKING([for MPI libraries]) if test "X${MPI_LIBS}" = "X"; then AC_MSG_RESULT([none]) echo "" echo " Unable to compile MPI program using Fortran compiler because" echo " MPI libraries were not specified." echo "" echo " Try using --with-mpi-libdir and --with-mpi-libs to" echo " specify the location and names of the MPI libraries." echo "" echo " Disabling all parallel Fortran examples..." echo "" MPI_F77_COMP_OK="no" # MPI libraries were specified so update LIBS else AC_MSG_RESULT([${MPI_LIBS}]) if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi # Set the MPI_F77_COMP_OK variable to NULL so we can conditionally execute # the next test MPI_F77_COMP_OK="" fi if test "X${MPI_F77_COMP_OK}" = "X"; then AC_MSG_CHECKING([if Fortran compiler can compile MPI programs]) AC_LINK_IFELSE( [AC_LANG_PROGRAM([], [ INCLUDE "mpif.h" CALL MPI_INIT(IER) ])], [AC_MSG_RESULT([yes]) MPI_F77_COMP_OK="yes"], [AC_MSG_RESULT([no]) AC_MSG_WARN([Fortran compiler cannot compile MPI programs]) echo "" echo " Unable to compile MPI program using Fortran compiler." echo "" echo " Try using --with-mpif77 to specify a MPI-Fortran compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling all parallel Fortran examples..." echo "" MPI_F77_COMP_OK="no" SUNDIALS_WARN_FLAG="yes"]) # Set MPIF77_LNKR based on value of F77_LNKR # Note: setting MPIF77_LNKR is trivial if NOT using the MPI compiler script # since the SUNDIALS_F77_LNKR_CHECK macro already checked if CC or F77 # should be used AC_MSG_CHECKING([which linker to use]) if test "X${F77_LNKR}" = "X${CC}"; then MPIF77_LNKR="${MPICC}" elif test "X${F77_LNKR}" = "X${F77}"; then MPIF77_LNKR="${MPIF77}" fi AC_MSG_RESULT([${MPIF77_LNKR}]) fi else MPI_F77_COMP_OK="no" fi # Restore FFLAGS, LDFLAGS and LIBS FFLAGS="${SAVED_FFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" AC_LANG_POP([Fortran 77]) ]) dnl END SUNDIALS_F77_WITH_MPI_CHECK #------------------------------------------------------------------ # TEST MPI-2 FUNCTIONALITY #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_CHECK_MPI2], [ # Determine if MPI implementation used to build SUNDIALS provides # MPI-2 functionality. # # Test for MPI_Comm_f2c() function: # (1) NO : FNVECTOR_PARALLEL module will NOT allow user to specify # an MPI communicator and MPI_COMM_WORLD will be used # (2) YES : FNVECTOR_PARALLEL module will allow user to specify # an MPI communicator # # Provide variable description templates for config.hin and config.h files # Required by autoheader utility AH_TEMPLATE([SUNDIALS_MPI_COMM_F2C], [FNVECTOR: Allow user to specify different MPI communicator]) # Save copies of CPPFLAGS, LDFLAGS and LIBS (preserve information) # Temporarily overwritten so we can test MPI implementation SAVED_CPPFLAGS="${CPPFLAGS}" SAVED_LDFLAGS="${LDFLAGS}" SAVED_LIBS="${LIBS}" # Determine location of MPI header files (find MPI include directory) MPI_EXISTS="yes" # MPI include directory was NOT explicitly specified so check if MPI root # directory was given by user if test "X${MPI_INC_DIR}" = "X"; then # MPI root directory was NOT given so issue a warning message if test "X${MPI_ROOT_DIR}" = "X"; then MPI_EXISTS="no" AC_MSG_WARN([cannot find MPI implementation files]) echo "" echo " Unable to find MPI implementation files." echo "" echo " Try using --with-mpicc to specify a MPI-C compiler script," echo " --with-mpi-incdir, --with-mpi-libdir and --with-mpi-libs" echo " to specify the locations of all relevant MPI files, or" echo " --with-mpi-root to specify the base installation directory" echo " of the MPI implementation to be used." echo "" echo " Disabling FNVECTOR_PARALLEL support for user-specified" echo " MPI communicator..." echo "" SUNDIALS_WARN_FLAG="yes" # MPI root directory was given so set MPI_INC_DIR accordingly # Update CPPFLAGS else MPI_INC_DIR="${MPI_ROOT_DIR}/include" if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # MPI include directory was specified so update CPPFLAGS else if test "X${CPPFLAGS}" = "X"; then CPPFLAGS="-I${MPI_INC_DIR}" else CPPFLAGS="${CPPFLAGS} -I${MPI_INC_DIR}" fi # Add MPI_FLAGS if non-empty if test "X${MPI_FLAGS}" = "X"; then CPPFLAGS="${CPPFLAGS}" else CPPFLAGS="${CPPFLAGS} ${MPI_FLAGS}" fi fi # Only continue if found an MPI implementation if test "X${MPI_EXISTS}" = "Xyes"; then # Determine location of MPI libraries # MPI library directory was NOT specified by user so set based upon MPI_ROOT_DIR # Update LDFLAGS if test "X${MPI_LIB_DIR}" = "X"; then MPI_LIB_DIR="${MPI_ROOT_DIR}/lib" if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi # MPI library directory was specified so update LDFLAGS else if test "X${LDFLAGS}" = "X"; then LDFLAGS="-L${MPI_LIB_DIR}" else LDFLAGS="${LDFLAGS} -L${MPI_LIB_DIR}" fi fi # Check if user specified which MPI libraries linker should be use if test "X${MPI_LIBS}" = "X"; then : # MPI libraries were specified so update LIBS else if test "X${LIBS}" = "X"; then LIBS="${MPI_LIBS}" else LIBS="${LIBS} ${MPI_LIBS}" fi fi # Since AC_LINK_IFELSE uses CC, set CC = MPICC if using # an MPI compiler script if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then SAVED_CC="${CC}" CC="${MPICC_COMP}" fi # Check if MPI implementation supports MPI_Comm_f2c() from # MPI-2 specification if test "X${FCMIX_ENABLED}" = "Xyes"; then AC_MSG_CHECKING([for MPI_Comm_f2c() from MPI-2 specification]) AC_LINK_IFELSE( [AC_LANG_PROGRAM([[#include "mpi.h"]], [[ int c; char **v; MPI_Comm C_comm; MPI_Init(&c, &v); C_comm = MPI_Comm_f2c((MPI_Fint) 1); MPI_Finalize(); ]])], [AC_MSG_RESULT([yes]) AC_DEFINE([SUNDIALS_MPI_COMM_F2C],[1],[]) F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 1"], [AC_MSG_RESULT([no]) AC_DEFINE([SUNDIALS_MPI_COMM_F2C],[0],[]) F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 0"]) fi # Reset CC if necessary if test "X${USE_MPICC_SCRIPT}" = "Xyes"; then CC="${SAVED_CC}" fi else AC_DEFINE([SUNDIALS_MPI_COMM_F2C],[0],[]) F77_MPI_COMM_F2C="#define SUNDIALS_MPI_COMM_F2C 0" fi # Restore CPPFLAGS, LDFLAGS and LIBS CPPFLAGS="${SAVED_CPPFLAGS}" LDFLAGS="${SAVED_LDFLAGS}" LIBS="${SAVED_LIBS}" ]) dnl END SUNDIALS_CHECK_MPI2 #=================================================================# # # # # # F I N A L I Z A T I O N S # # # # # #================================================================== #------------------------------------------------------------------ # ADD SOME MORE STUFF TO configure --help #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_MORE_HELP], [ AC_ARG_WITH([],[ ],[]) AC_ARG_WITH([],[NOTES],[]) AC_ARG_WITH([],[ It is legal to set --with-exinstdir to "no", in which case the examples],[]) AC_ARG_WITH([],[ are built but not installed.],[]) AC_ARG_WITH([],[ Enabling the compilation of the examples (--enable-examples) but disabling their],[]) AC_ARG_WITH([],[ installation (--with-exinstdir=no) can be used to test the SUNDIALS libraries.],[]) ]) dnl END SUNDIALS_MORE_HELP #------------------------------------------------------------------ # SET EXAMPLES # # Decide which examples can be built # #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_SET_EXAMPLES], [ # Set proper object file extension # Must export OBJ_EXT via AC_SUBST OBJEXT=".lo" # Check if serial C examples can actually be built SERIAL_C_EXAMPLES="yes" # Check if parallel C examples can actually be built if test "X${MPI_ENABLED}" = "Xyes"; then if test "X${MPI_C_COMP_OK}" = "Xyes"; then PARALLEL_C_EXAMPLES="yes" else PARALLEL_C_EXAMPLES="no" fi else PARALLEL_C_EXAMPLES="disabled" fi # Check if serial F77 examples can actually be built if test "X${FCMIX_ENABLED}" = "Xyes"; then if test "X${F77_OK}" = "Xyes"; then SERIAL_F77_EXAMPLES="yes" else SERIAL_F77_EXAMPLES="no" fi else SERIAL_F77_EXAMPLES="disabled" fi # Check if parallel F77 examples can actually be built if test "X${FCMIX_ENABLED}" = "Xyes" && test "X${MPI_ENABLED}" = "Xyes"; then if test "X${MPI_F77_COMP_OK}" = "Xyes"; then PARALLEL_F77_EXAMPLES="yes" else PARALLEL_F77_EXAMPLES="no" fi else PARALLEL_F77_EXAMPLES="disabled" fi # Notify user AC_MSG_CHECKING([if we can build serial C examples]) AC_MSG_RESULT([${SERIAL_C_EXAMPLES}]) AC_MSG_CHECKING([if we can build parallel C examples]) AC_MSG_RESULT([${PARALLEL_C_EXAMPLES}]) AC_MSG_CHECKING([if we can build serial Fortran examples]) AC_MSG_RESULT([${SERIAL_F77_EXAMPLES}]) AC_MSG_CHECKING([if we can build parallel Fortran examples]) AC_MSG_RESULT([${PARALLEL_F77_EXAMPLES}]) # Check if the Fortran update script (bin/fortran-update.in) is needed if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" || test "X${PARALLEL_F77_EXAMPLES}" = "Xyes"; then BUILD_F77_UPDATE_SCRIPT="yes"; else BUILD_F77_UPDATE_SCRIPT="no" fi # Where should we install the examples? # Note: setting this to "no" will disable example installation! AC_MSG_CHECKING([where to install the SUNDIALS examples]) AC_ARG_WITH([],[ ],[]) AC_ARG_WITH([exinstdir], [AC_HELP_STRING([--with-exinstdir=DIR], [install SUNDIALS examples in DIR @<:@EPREFIX/examples@:>@])], [ EXS_INSTDIR="${withval}" ], [ if test "X${exec_prefix}" = "XNONE"; then if test "X${prefix}" = "XNONE"; then EXS_INSTDIR="\${exec_prefix}/examples" else EXS_INSTDIR="${prefix}/examples" fi else EXS_INSTDIR="${exec_prefix}/examples" fi ]) AC_MSG_RESULT([${EXS_INSTDIR}]) # Prepare substitution variables to create the exported example Makefiles F77_LIBS="${FLIBS} ${LIBS}" if test "X${F77_LNKR}" = "X${F77}"; then F77_LDFLAGS="${FFLAGS} ${LDFLAGS}" else F77_LDFLAGS="${CFLAGS} ${LDFLAGS}" fi ]) dnl END SUNDIALS_SET_EXAMPLES #------------------------------------------------------------------ # BUILD MODULES LIST #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_BUILD_MODULES_LIST], [ # Initialize the list of Makefiles to be created SUNDIALS_MAKEFILES="Makefile" # Initialize list of additional configure files to be created SUNDIALS_CONFIGFILES="include/sundials/sundials_config.h:include/sundials/sundials_config.in" SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/sundials-config:bin/sundials-config.in" # Initialize lists of solver modules and example modules SLV_MODULES="src/sundials" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/sundials/Makefile" EXS_MODULES="" # NVECTOR modules if test -d ${srcdir}/src/nvec_ser ; then SLV_MODULES="${SLV_MODULES} src/nvec_ser" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_ser/Makefile" fi if test -d ${srcdir}/src/nvec_par && test "X${MPI_C_COMP_OK}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/nvec_par" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_par/Makefile" fi if test -d ${srcdir}/src/nvec_spcpar && test "X${MPI_C_COMP_OK}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/nvec_spcpar" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/nvec_spcpar/Makefile" fi # CVODE module if test "X${CVODE_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cvode" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvode/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/cvode/fcmix ; then SLV_MODULES="${SLV_MODULES} src/cvode/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvode/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/serial ; then EXS_MODULES="${EXS_MODULES} examples/cvode/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/cvode/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvode/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvode/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvode/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # CVODES module if test "X${CVODES_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cvodes" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cvodes/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/serial ; then EXS_MODULES="${EXS_MODULES} examples/cvodes/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cvodes/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cvodes/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # IDA module if test "X${IDA_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/ida" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/ida/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/ida/fcmix ; then SLV_MODULES="${SLV_MODULES} src/ida/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/ida/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/serial ; then EXS_MODULES="${EXS_MODULES} examples/ida/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/ida/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/parallel ; then EXS_MODULES="${EXS_MODULES} examples/ida/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/ida/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/ida/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # IDAS module if test "X${IDAS_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/idas" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/idas/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/serial ; then EXS_MODULES="${EXS_MODULES} examples/idas/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/parallel ; then EXS_MODULES="${EXS_MODULES} examples/idas/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/idas/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # KINSOL module if test "X${KINSOL_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/kinsol" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/kinsol/Makefile" if test "X${FCMIX_ENABLED}" = "Xyes" && test -d ${srcdir}/src/kinsol/fcmix ; then SLV_MODULES="${SLV_MODULES} src/kinsol/fcmix" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/kinsol/fcmix/Makefile" fi if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/serial ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_serial ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/fcmix_serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_serial/Makefile_ex:examples/templates/makefile_serial_F77_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/parallel ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_parallel ; then EXS_MODULES="${EXS_MODULES} examples/kinsol/fcmix_parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/kinsol/fcmix_parallel/Makefile_ex:examples/templates/makefile_parallel_F77_ex.in" fi fi # CPODES module if test "X${CPODES_ENABLED}" = "Xyes"; then SLV_MODULES="${SLV_MODULES} src/cpodes" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} src/cpodes/Makefile" if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/serial ; then EXS_MODULES="${EXS_MODULES} examples/cpodes/serial" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/serial/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/serial/Makefile_ex:examples/templates/makefile_serial_C_ex.in" fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/parallel ; then EXS_MODULES="${EXS_MODULES} examples/cpodes/parallel" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/parallel/Makefile" SUNDIALS_MAKEFILES="${SUNDIALS_MAKEFILES} examples/cpodes/parallel/Makefile_ex:examples/templates/makefile_parallel_C_ex.in" fi fi # Add Fortran update script to the list of additional files to be generated if test "X${BUILD_F77_UPDATE_SCRIPT}" = "Xyes"; then SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/fortran-update.sh:bin/fortran-update.in" fi # If needed, add Makefile update script to the list of additional files to be generated if test "X${EXAMPLES_ENABLED}" = "Xyes" && test "X${EXS_INSTDIR}" != "Xno"; then SUNDIALS_CONFIGFILES="${SUNDIALS_CONFIGFILES} bin/makefile-update.sh:bin/makefile-update.in" fi ]) dnl END SUNDIALS_BUILD_MODULES_LIST #------------------------------------------------------------------ # POST PROCESSING OF EXAMPLE Makefiles for export #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_POST_PROCESSING], [ # If installing examples, the Makefiles that will be exported must # be post-processed to complete the substitution of all variables. # After config.status runs, each example subdirectory contains an # export makefile, named Makefile_ex, which was created from the # common template in examples/templates. # # The following variables are still to be substituted at this point: # SOLVER # EXAMPLES # EXAMPLES_BL # SOLVER_LIB SOLVER_FLIB # NVEC_LIB NVEC_FLIB # # This function is called ONLY if examples are enabled AND examples will # be installed. If so, it sets up commands to be called after config.status # has generated a first version of the Makefiles for export: # # (1) For each solver, proceed ONLY if the solver is enabled. # (2) For each type of examples, proceed ONLY if they can be compiled AND # the example directory exists. # CVODE module if test "X${CVODE_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([cvode_ser_ex_bl], [ IN_FILE="examples/cvode/serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_bnd cvDirectDemo_ls cvDiurnal_kry_bp cvDiurnal_kry cvKrylovDemo_ls cvKrylovDemo_prec cvRoberts_dns cvRoberts_dns_uw" EXAMPLES_BL="cvAdvDiff_bndL cvRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([cvode_ser_ex], [ IN_FILE="examples/cvode/serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_bnd cvDirectDemo_ls cvDiurnal_kry_bp cvDiurnal_kry cvKrylovDemo_ls cvKrylovDemo_prec cvRoberts_dns cvRoberts_dns_uw" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([cvode_fser_ex_bl], [ IN_FILE="examples/cvode/fcmix_serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvAdvDiff_bnd fcvDiurnal_kry_bp fcvDiurnal_kry fcvRoberts_dns" EXAMPLES_BL="fcvRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([cvode_fser_ex], [ IN_FILE="examples/cvode/fcmix_serial/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvAdvDiff_bnd fcvDiurnal_kry_bp fcvDiurnal_kry fcvRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/parallel ; then AC_CONFIG_COMMANDS([cvode_par_ex], [ IN_FILE="examples/cvode/parallel/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="" EXAMPLES="cvAdvDiff_non_p cvDiurnal_kry_bbd_p cvDiurnal_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvode/fcmix_parallel ; then AC_CONFIG_COMMANDS([cvode_fpar_ex], [ IN_FILE="examples/cvode/fcmix_parallel/Makefile_ex" SOLVER="CVODE" SOLVER_LIB="sundials_cvode" SOLVER_FLIB="sundials_fcvode" EXAMPLES="fcvDiag_non_p fcvDiag_kry_bbd_p fcvDiag_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi # CVODES module if test "X${CVODES_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([cvodes_ser_ex_bl], [ IN_FILE="examples/cvodes/serial/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAi_bnd cvsAdvDiff_FSA_non cvsDiurnal_kry_bp cvsFoodWeb_ASAp_kry cvsKrylovDemo_prec cvsAdvDiff_bnd cvsDirectDemo_ls cvsDiurnal_kry cvsHessian_ASA_FSA cvsRoberts_ASAi_dns cvsRoberts_dns_uw cvsDiurnal_FSA_kry cvsFoodWeb_ASAi_kry cvsKrylovDemo_ls cvsRoberts_dns cvsRoberts_FSA_dns" EXAMPLES_BL="cvsRoberts_dnsL cvsAdvDiff_bndL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([cvodes_ser_ex], [ IN_FILE="examples/cvodes/serial/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAi_bnd cvsAdvDiff_FSA_non cvsDiurnal_kry_bp cvsFoodWeb_ASAp_kry cvsKrylovDemo_prec cvsAdvDiff_bnd cvsDirectDemo_ls cvsDiurnal_kry cvsHessian_ASA_FSA cvsRoberts_ASAi_dns cvsRoberts_dns_uw cvsDiurnal_FSA_kry cvsFoodWeb_ASAi_kry cvsKrylovDemo_ls cvsRoberts_dns cvsRoberts_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cvodes/parallel ; then AC_CONFIG_COMMANDS([cvodes_par_ex], [ IN_FILE="examples/cvodes/parallel/Makefile_ex" SOLVER="CVODES" SOLVER_LIB="sundials_cvodes" SOLVER_FLIB="" EXAMPLES="cvsAdvDiff_ASAp_non_p cvsAdvDiff_non_p cvsDiurnal_FSA_kry_p cvsDiurnal_kry_p cvsAdvDiff_FSA_non_p cvsAtmDisp_ASAi_kry_bbd_p cvsDiurnal_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi # IDA module if test "X${IDA_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([ida_ser_ex_bl], [ IN_FILE="examples/ida/serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_bnd idaHeat2D_bnd idaHeat2D_kry idaKrylovDemo_ls idaRoberts_dns idaSlCrank_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([ida_ser_ex], [ IN_FILE="examples/ida/serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_bnd idaHeat2D_bnd idaHeat2D_kry idaKrylovDemo_ls idaRoberts_dns idaSlCrank_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([ida_fser_ex_bl], [ IN_FILE="examples/ida/fcmix_serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([ida_fser_ex], [ IN_FILE="examples/ida/fcmix_serial/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaRoberts_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/parallel ; then AC_CONFIG_COMMANDS([ida_par_ex], [ IN_FILE="examples/ida/parallel/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="" EXAMPLES="idaFoodWeb_kry_bbd_p idaFoodWeb_kry_p idaHeat2D_kry_bbd_p idaHeat2D_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/ida/fcmix_parallel ; then AC_CONFIG_COMMANDS([ida_fpar_ex], [ IN_FILE="examples/ida/fcmix_parallel/Makefile_ex" SOLVER="IDA" SOLVER_LIB="sundials_ida" SOLVER_FLIB="sundials_fida" EXAMPLES="fidaHeat2D_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi # IDAS module if test "X${IDAS_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([idas_ser_ex_bl], [ IN_FILE="examples/idas/serial/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasAkzoNob_ASAi_dns idasFoodWeb_bnd idasHeat2D_kry idasKrylovDemo_ls idasRoberts_dns idasSlCrank_dns idasAkzoNob_dns idasHeat2D_bnd idasHessian_ASA_FSA idasRoberts_ASAi_dns idasRoberts_FSA_dns idasSlCrank_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([idas_ser_ex], [ IN_FILE="examples/idas/serial/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasAkzoNob_ASAi_dns idasFoodWeb_bnd idasHeat2D_kry idasKrylovDemo_ls idasRoberts_dns idasSlCrank_dns idasAkzoNob_dns idasHeat2D_bnd idasHessian_ASA_FSA idasRoberts_ASAi_dns idasRoberts_FSA_dns idasSlCrank_FSA_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/idas/parallel ; then AC_CONFIG_COMMANDS([idas_par_ex], [ IN_FILE="examples/idas/parallel/Makefile_ex" SOLVER="IDAS" SOLVER_LIB="sundials_idas" SOLVER_FLIB="" EXAMPLES="idasBruss_ASAp_kry_bbd_p idasBruss_kry_bbd_p idasFoodWeb_kry_p idasHeat2D_kry_bbd_p idasBruss_FSA_kry_bbd_p idasFoodWeb_kry_bbd_p idasHeat2D_FSA_kry_bbd_p idasHeat2D_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi # KINSOL module if test "X${KINSOL_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([kinsol_ser_ex_bl], [ IN_FILE="examples/kinsol/serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFerTron_dns kinFoodWeb_kry kinKrylovDemo_ls kinLaplace_bnd kinRoboKin_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([kinsol_ser_ex], [ IN_FILE="examples/kinsol/serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFerTron_dns kinFoodWeb_kry kinKrylovDemo_ls kinLaplace_bnd kinRoboKin_dns" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${SERIAL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([kinsol_fser_ex_bl], [ IN_FILE="examples/kinsol/fcmix_serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([kinsol_fser_ex], [ IN_FILE="examples/kinsol/fcmix_serial/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/parallel ; then AC_CONFIG_COMMANDS([kinsol_par_ex], [ IN_FILE="examples/kinsol/parallel/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="" EXAMPLES="kinFoodWeb_kry_bbd_p kinFoodWeb_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi if test "X${PARALLEL_F77_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/kinsol/fcmix_parallel ; then AC_CONFIG_COMMANDS([kinsol_fpar_ex], [ IN_FILE="examples/kinsol/fcmix_parallel/Makefile_ex" SOLVER="KINSOL" SOLVER_LIB="sundials_kinsol" SOLVER_FLIB="sundials_fkinsol" EXAMPLES="fkinDiagon_kry_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi # CPODES module if test "X${CPODES_ENABLED}" = "Xyes"; then if test "X${SERIAL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/serial ; then if test "X${LAPACK_ENABLED}" = "Xyes"; then AC_CONFIG_COMMANDS([cpodes_ser_ex_bl], [ IN_FILE="examples/cpodes/serial/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsAdvDiff_bnd cpsAdvDiff_non cpsNewtCrd_dns cpsPend_dns cpsRoberts_dns cpsVanDPol_non" EXAMPLES_BL="cpsAdvDiff_bndL cpsPend_dnsL cpsRoberts_dnsL" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) else AC_CONFIG_COMMANDS([cpodes_ser_ex], [ IN_FILE="examples/cpodes/serial/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsAdvDiff_bnd cpsAdvDiff_non cpsNewtCrd_dns cpsPend_dns cpsRoberts_dns cpsVanDPol_non" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi if test "X${PARALLEL_C_EXAMPLES}" = "Xyes" && test -d ${srcdir}/examples/cpodes/parallel ; then AC_CONFIG_COMMANDS([cpodes_par_ex], [ IN_FILE="examples/cpodes/parallel/Makefile_ex" SOLVER="CPODES" SOLVER_LIB="sundials_cpodes" SOLVER_FLIB="" EXAMPLES="cpsHeat2D_kry_bbd_p" EXAMPLES_BL="" ${SHELL} bin/makefile-update.sh "${IN_FILE}" "${SOLVER}" "${EXAMPLES}" "${EXAMPLES_BL}" "${SOLVER_LIB}" "${SOLVER_FLIB}" ]) fi fi ]) dnl END SUNDIALS_POST_PROCESSING #------------------------------------------------------------------ # PRINT STATUS REPORT #------------------------------------------------------------------ AC_DEFUN([SUNDIALS_REPORT], [ if test "X${SUNDIALS_WARN_FLAG}" = "Xyes"; then echo " *************** * WARNING * *************** At least one warning was issued. Some features were disabled. Review the configure output and/or the contents of config.log before proceeding with the build. " fi echo " ------------------------------ SUNDIALS Configuration Summary ------------------------------" echo " Configuration ------------- Host System: ${host} Build System: ${build} C Preprocessor: ${CPP} C Preprocessor Flags: ${CPPFLAGS} C Compiler: ${CC} C Compiler Flags ${CFLAGS} C Linker: ${CC} Linker Flags: ${LDFLAGS} Libraries: ${LIBS}" if test "X${F77_OK}" = "Xyes"; then echo " Fortran Compiler: ${F77} Fortran Compiler Flags: ${FFLAGS} Fortran Linker: ${F77_LNKR} Extra Fortran Libraries: ${FLIBS}" fi if test "X${MPI_ENABLED}" = "Xyes" && test "X${MPI_C_COMP_OK}" = "Xyes"; then echo " MPI Root Directory: ${MPI_ROOT_DIR} MPI Include Directory: ${MPI_INC_DIR} MPI Library Directory: ${MPI_LIB_DIR} MPI Flags: ${MPI_FLAGS} Extra MPI Libraries: ${MPI_LIBS} Using MPI-C script? ${USE_MPICC_SCRIPT} MPI-C: ${MPICC}" fi if test "X${MPI_ENABLED}" = "Xyes" && test "X${F77_EXAMPLES_ENABLED}" = "Xyes" && test "X${MPI_F77_COMP_OK}" = "Xyes"; then echo " Using MPI-Fortran script? ${USE_MPIF77_SCRIPT} MPI-Fortran: ${MPIF77} MPI-Fortran Linker: ${MPIF77_LNKR}" fi # Determine SOURCE, BUILD, and EXEC_PREFIX directories cv_srcdir=`( cd ${srcdir} ; pwd )` cv_builddir=`pwd` if test "X${exec_prefix}" = "XNONE"; then cv_exec_prefix="${prefix}" else cv_exec_prefix="${exec_prefix}" fi echo " srcdir: ${cv_srcdir} builddir: ${cv_builddir} prefix: ${prefix} exec_prefix: ${cv_exec_prefix} includedir: ${includedir} libdir: ${libdir}" if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo " examples installed in: ${EXS_INSTDIR}" fi echo " Modules ------- " if test "X${CVODE_ENABLED}" = "Xyes"; then THIS_LINE="CVODE" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FCVODE" fi echo " ${THIS_LINE}" fi if test "X${CVODES_ENABLED}" = "Xyes"; then THIS_LINE="CVODES" echo " ${THIS_LINE}" fi if test "X${IDA_ENABLED}" = "Xyes"; then THIS_LINE="IDA" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FIDA" fi echo " ${THIS_LINE}" fi if test "X${IDAS_ENABLED}" = "Xyes"; then THIS_LINE="IDAS" echo " ${THIS_LINE}" fi if test "X${KINSOL_ENABLED}" = "Xyes"; then THIS_LINE="KINSOL" if test "X${FCMIX_ENABLED}" = "Xyes"; then THIS_LINE="${THIS_LINE} FKINSOL" fi echo " ${THIS_LINE}" fi if test "X${CPODES_ENABLED}" = "Xyes"; then THIS_LINE="CPODES" echo " ${THIS_LINE}" fi if test "X${EXAMPLES_ENABLED}" = "Xyes"; then echo " Examples -------- " echo " Serial C examples: ${SERIAL_C_EXAMPLES}" echo " Parallel C examples: ${PARALLEL_C_EXAMPLES}" echo " Serial Fortran examples: ${SERIAL_F77_EXAMPLES}" echo " Parallel Fortran examples: ${PARALLEL_F77_EXAMPLES}" fi echo " Type 'make' and then 'make install' to build and install ${PACKAGE_STRING}." echo " ---------------------------------- Finished SUNDIALS Configure Script ---------------------------------- " ]) dnl END SUNDIALS_REPORT sundials-2.5.0/src/0000755000175000017500000000000011767174700015023 5ustar sylvestresylvestresundials-2.5.0/src/cvode/0000755000175000017500000000000011767174700016123 5ustar sylvestresylvestresundials-2.5.0/src/cvode/cvode_bandpre_impl.h0000600000175000017500000000417611741421121022070 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:19:48 $ * ----------------------------------------------------------------- * Programmer(s): Michael Wittman, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the CVBANDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVBANDPRE_IMPL_H #define _CVBANDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include /* * ----------------------------------------------------------------- * Type: CVBandPrecData * ----------------------------------------------------------------- */ typedef struct CVBandPrecDataRec { /* Data set by user in CVBandPrecInit */ long int N; long int ml, mu; /* Data set by CVBandPrecSetup */ DlsMat savedJ; DlsMat savedP; long int *lpivots; /* Rhs calls */ long int nfeBP; /* Pointer to cvode_mem */ void *cvode_mem; } *CVBandPrecData; /* * ----------------------------------------------------------------- * CVBANDPRE error messages * ----------------------------------------------------------------- */ #define MSGBP_MEM_NULL "Integrator memory is NULL." #define MSGBP_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBP_MEM_FAIL "A memory request failed." #define MSGBP_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBP_PMEM_NULL "Band preconditioner memory is NULL. CVBandPrecInit must be called." #define MSGBP_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/cvode_direct_impl.h0000600000175000017500000001001611741421121021715 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:19:48 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the CVDLS linear solvers. * ----------------------------------------------------------------- */ #ifndef _CVDLS_IMPL_H #define _CVDLS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * CVDLS solver constants * ----------------------------------------------------------------- * CVD_MSBJ maximum number of steps between Jacobian evaluations * CVD_DGMAX maximum change in gamma between Jacobian evaluations * ----------------------------------------------------------------- */ #define CVD_MSBJ 50 #define CVD_DGMAX RCONST(0.2) /* * ----------------------------------------------------------------- * Types : CVDlsMemRec, CVDlsMem * ----------------------------------------------------------------- * CVDlsMem is pointer to a CVDlsMemRec structure. * ----------------------------------------------------------------- */ typedef struct CVDlsMemRec { int d_type; /* SUNDIALS_DENSE or SUNDIALS_BAND */ long int d_n; /* problem dimension */ long int d_ml; /* lower bandwidth of Jacobian */ long int d_mu; /* upper bandwidth of Jacobian */ long int d_smu; /* upper bandwith of M = MIN(N-1,d_mu+d_ml) */ booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ CVDlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ CVDlsBandJacFn d_bjac; /* band Jacobian routine to be called */ void *d_J_data; /* user data is passed to djac or bjac */ DlsMat d_M; /* M = I - gamma * df/dy */ DlsMat d_savedJ; /* savedJ = old Jacobian */ int *d_pivots; /* pivots = int pivot array for PM = LU */ long int *d_lpivots; /* lpivots = long int pivot array for PM = LU */ long int d_nstlj; /* nstlj = nst at last Jacobian eval. */ long int d_nje; /* nje = no. of calls to jac */ long int d_nfeDQ; /* no. of calls to f due to DQ Jacobian approx. */ long int d_last_flag; /* last error return flag */ } *CVDlsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ int cvDlsDenseDQJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int cvDlsBandDQJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ----------------------------------------------------------------- * Error Messages * ----------------------------------------------------------------- */ #define MSGD_CVMEM_NULL "Integrator memory is NULL." #define MSGD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSGD_MEM_FAIL "A memory request failed." #define MSGD_LMEM_NULL "Linear solver memory is NULL." #define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/CMakeLists.txt0000600000175000017500000000722211741421121020636 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the CVODE library INSTALL(CODE "MESSAGE(\"\nInstall CVODE\n\")") # Add variable cvode_SOURCES with the sources for the CVODE library SET(cvode_SOURCES cvode.c cvode_io.c cvode_direct.c cvode_band.c cvode_dense.c cvode_diag.c cvode_spils.c cvode_spbcgs.c cvode_spgmr.c cvode_sptfqmr.c cvode_bandpre.c cvode_bbdpre.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the CVODE library SET(shared_SOURCES sundials_nvector.c sundials_math.c sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_spbcgs.c sundials_spgmr.c sundials_sptfqmr.c ) # Add prefix with complete path to the common SUNDIALS sources ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable cvode_HEADERS with the exported CVODE header files SET(cvode_HEADERS cvode_band.h cvode_bandpre.h cvode_bbdpre.h cvode_dense.h cvode_diag.h cvode_direct.h cvode.h cvode_spbcgs.h cvode_spgmr.h cvode_spils.h cvode_sptfqmr.h ) # Add prefix with complete path to the CVODE header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvode/ cvode_HEADERS) # If Blas/Lapack support was enabled, set-up additional file lists IF(LAPACK_FOUND) SET(cvode_BL_SOURCES cvode_lapack.c) SET(cvode_BL_HEADERS cvode_lapack.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvode/ cvode_BL_HEADERS) ELSE(LAPACK_FOUND) SET(cvode_BL_SOURCES "") SET(cvode_BL_HEADERS "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static CVODE library ADD_LIBRARY(sundials_cvode_static STATIC ${cvode_SOURCES} ${cvode_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_cvode_static PROPERTIES OUTPUT_NAME sundials_cvode CLEAN_DIRECT_OUTPUT 1) # Install the CVODE library INSTALL(TARGETS sundials_cvode_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the CVODE library ADD_LIBRARY(sundials_cvode_shared SHARED ${cvode_SOURCES} ${cvode_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_cvode_shared PROPERTIES OUTPUT_NAME sundials_cvode CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_cvode_shared PROPERTIES VERSION ${cvodelib_VERSION} SOVERSION ${cvodelib_SOVERSION}) # Install the CVODE library INSTALL(TARGETS sundials_cvode_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the CVODE header files INSTALL(FILES ${cvode_HEADERS} ${cvode_BL_HEADERS} DESTINATION include/cvode) # Install the CVODE implementation header file INSTALL(FILES cvode_impl.h DESTINATION include/cvode) # MESSAGE(STATUS "Added CVODE module") sundials-2.5.0/src/cvode/Makefile.in0000600000175000017500000001646311741421121020152 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for CVODE module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include LIB_REVISION = 1:0:0 CVODE_LIB = libsundials_cvode.la CVODE_SRC_FILES = cvode.c cvode_io.c cvode_direct.c cvode_band.c cvode_dense.c cvode_diag.c cvode_spils.c cvode_spbcgs.c cvode_spgmr.c cvode_sptfqmr.c cvode_bandpre.c cvode_bbdpre.c CVODE_BL_SRC_FILES = cvode_lapack.c CVODE_OBJ_FILES = $(CVODE_SRC_FILES:.c=.o) CVODE_BL_OBJ_FILES = $(CVODE_BL_SRC_FILES:.c=.o) CVODE_LIB_FILES = $(CVODE_SRC_FILES:.c=.lo) CVODE_BL_LIB_FILES = $(CVODE_BL_SRC_FILES:.c=.lo) SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ $(top_builddir)/src/sundials/sundials_dense.lo \ $(top_builddir)/src/sundials/sundials_direct.lo \ $(top_builddir)/src/sundials/sundials_iterative.lo \ $(top_builddir)/src/sundials/sundials_spgmr.lo \ $(top_builddir)/src/sundials/sundials_spbcgs.lo \ $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ $(top_builddir)/src/sundials/sundials_math.lo \ $(top_builddir)/src/sundials/sundials_nvector.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(CVODE_LIB) $(CVODE_LIB): shared $(CVODE_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: shared $(CVODE_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(CVODE_LIB) $(CVODE_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) lib_with_bl: shared $(CVODE_LIB_FILES) $(CVODE_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(CVODE_LIB) $(CVODE_LIB_FILES) $(CVODE_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) install: $(CVODE_LIB) $(mkinstalldirs) $(includedir)/cvode $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(CVODE_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_direct.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_dense.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_band.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_diag.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_spils.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_spbcgs.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_spgmr.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_sptfqmr.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_bandpre.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_bbdpre.h $(includedir)/cvode/ $(INSTALL_HEADER) $(top_srcdir)/src/cvode/cvode_impl.h $(includedir)/cvode/ @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ $(INSTALL_HEADER) $(top_srcdir)/include/cvode/cvode_lapack.h $(includedir)/cvode/ ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(CVODE_LIB) rm -f $(includedir)/cvode/cvode.h rm -f $(includedir)/cvode/cvode_direct.h rm -f $(includedir)/cvode/cvode_dense.h rm -f $(includedir)/cvode/cvode_band.h rm -f $(includedir)/cvode/cvode_diag.h rm -f $(includedir)/cvode/cvode_lapack.h rm -f $(includedir)/cvode/cvode_spils.h rm -f $(includedir)/cvode/cvode_spbcgs.h rm -f $(includedir)/cvode/cvode_spgmr.h rm -f $(includedir)/cvode/cvode_sptfqmr.h rm -f $(includedir)/cvode/cvode_bandpre.h rm -f $(includedir)/cvode/cvode_bbdpre.h rm -f $(includedir)/cvode/cvode_impl.h $(rminstalldirs) $(includedir)/cvode shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(CVODE_LIB) rm -f $(CVODE_LIB_FILES) rm -f $(CVODE_BL_LIB_FILES) rm -f $(CVODE_OBJ_FILES) rm -f $(CVODE_BL_OBJ_FILES) distclean: clean rm -f Makefile cvode.lo: $(srcdir)/cvode.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode.c cvode_io.lo: $(srcdir)/cvode_io.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_io.c cvode_direct.lo: $(srcdir)/cvode_direct.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_direct.c cvode_dense.lo: $(srcdir)/cvode_dense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_dense.c cvode_band.lo: $(srcdir)/cvode_band.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_band.c cvode_diag.lo: $(srcdir)/cvode_diag.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_diag.c cvode_lapack.lo: $(srcdir)/cvode_lapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_lapack.c cvode_spils.lo: $(srcdir)/cvode_spils.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_spils.c cvode_spbcgs.lo: $(srcdir)/cvode_spbcgs.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_spbcgs.c cvode_spgmr.lo: $(srcdir)/cvode_spgmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_spgmr.c cvode_sptfqmr.lo: $(srcdir)/cvode_sptfqmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_sptfqmr.c cvode_bandpre.lo: $(srcdir)/cvode_bandpre.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_bandpre.c cvode_bbdpre.lo: $(srcdir)/cvode_bbdpre.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/cvode_bbdpre.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/cvode/cvode_band.c0000600000175000017500000002505111741421121020326 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 22:27:43 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVBAND linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvode_direct_impl.h" #include "cvode_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* CVBAND linit, lsetup, lsolve, and lfree routines */ static int cvBandInit(CVodeMem cv_mem); static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void cvBandFree(CVodeMem cv_mem); /* Readability Replacements */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define nfe (cv_mem->cv_nfe) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define jacDQ (cvdls_mem->d_jacDQ) #define jac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define mu (cvdls_mem->d_mu) #define ml (cvdls_mem->d_ml) #define smu (cvdls_mem->d_smu) #define lpivots (cvdls_mem->d_lpivots) #define savedJ (cvdls_mem->d_savedJ) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ----------------------------------------------------------------- * CVBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. CVBand first calls * the existing lfree routine if this is not NULL. It then sets the * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) * to be cvBandInit, cvBandSetup, cvBandSolve, and cvBandFree, * respectively. It allocates memory for a structure of type * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to be * TRUE, d_mu to be mupper, d_ml to be mlower, and the d_jac field to be * cvDlsBandDQJac. * Finally, it allocates memory for M, savedJ, and pivot. The CVBand * return value is SUCCESS = 0, LMEM_FAIL = -1, or LIN_ILL_INPUT = -2. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVBand(void *cvode_mem, long int N, long int mupper, long int mlower) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVBAND", "CVBand", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVBAND", "CVBand", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvBandInit; lsetup = cvBandSetup; lsolve = cvBandSolve; lfree = cvBandFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVBAND", "CVBand", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Initialize Jacobian-related data */ jacDQ = TRUE; jac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = N; /* Load half-bandwiths in cvdls_mem */ ml = mlower; mu = mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVBAND", "CVBand", MSGD_BAD_SIZES); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(N-1, mu + ml); /* Allocate memory for M, savedJ, and pivot arrays */ M = NULL; M = NewBandMat(N, mu, ml, smu); if (M == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVBAND", "CVBand", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NULL; savedJ = NewBandMat(N, mu, ml, mu); if (savedJ == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVBAND", "CVBand", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVBAND", "CVBand", MSGD_MEM_FAIL); DestroyMat(M); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * cvBandInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the band * linear solver. * ----------------------------------------------------------------- */ static int cvBandInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { jac = cvDlsBandDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandSetup * ----------------------------------------------------------------- * This routine does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the band LU * factorization routine. * ----------------------------------------------------------------- */ static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; long int ier; CVDlsMem cvdls_mem; int retval; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, M, mu, ml); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, mu, ml, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { CVProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVBAND", "cvBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } BandCopy(M, savedJ, mu, ml); } /* Scale and add I to get M = I - gamma*J */ BandScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = BandGBTRF(M, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) { last_flag = ier; return(1); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the band linear solver * by calling the band backsolve routine. The return value is 0. * ----------------------------------------------------------------- */ static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { CVDlsMem cvdls_mem; realtype *bd; cvdls_mem = (CVDlsMem) lmem; bd = N_VGetArrayPointer(b); BandGBTRS(M, lpivots, bd); /* If CV_BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { N_VScale(TWO/(ONE + gamrat), b, b); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandFree * ----------------------------------------------------------------- * This routine frees memory specific to the band linear solver. * ----------------------------------------------------------------- */ static void cvBandFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyMat(savedJ); DestroyArray(lpivots); free(cvdls_mem); cv_mem->cv_lmem = NULL; } sundials-2.5.0/src/cvode/cvode_bbdpre.c0000600000175000017500000004213511741421121020662 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer(s): Michael Wittman, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with CVODE, a CVSPILS linear * solver, and the parallel implementation of NVECTOR. * ----------------------------------------------------------------- */ #include #include #include "cvode_impl.h" #include "cvode_bbdpre_impl.h" #include "cvode_spils_impl.h" #include #include #include #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes of functions CVBBDPrecSetup and CVBBDPrecSolve */ static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int CVBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data, N_Vector tmp); /* Prototype for CVBBDPrecFree */ static void CVBBDPrecFree(CVodeMem cv_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int CVBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp); /* Redability replacements */ #define uround (cv_mem->cv_uround) #define vec_tmpl (cv_mem->cv_tempv) /* * ----------------------------------------------------------------- * User-Callable Functions: initialization, reinit and free * ----------------------------------------------------------------- */ int CVBBDPrecInit(void *cvode_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; long int muk, mlk, storage_mu; int flag; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } /* Allocate data memory */ pdata = NULL; pdata = (CVBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set pointers to gloc and cfn; load half-bandwidths */ pdata->cvode_mem = cvode_mem; pdata->gloc = gloc; pdata->cfn = cfn; pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); muk = MIN(Nlocal-1, MAX(0,mukeep)); mlk = MIN(Nlocal-1, MAX(0,mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Allocate memory for saved Jacobian */ pdata->savedJ = NewBandMat(Nlocal, muk, mlk, muk); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for preconditioner matrix */ storage_mu = MIN(Nlocal-1, muk + mlk); pdata->savedP = NULL; pdata->savedP = NewBandMat(Nlocal, muk, mlk, storage_mu); if (pdata->savedP == NULL) { DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for lpivots */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(Nlocal); if (pdata->lpivots == NULL) { DestroyMat(pdata->savedP); DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); /* Store Nlocal to be used in CVBBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge */ pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2); pdata->ipwsize = Nlocal; pdata->nge = 0; /* Overwrite the P_data field in the SPILS memory */ cvspils_mem->s_P_data = pdata; /* Attach the pfree function */ cvspils_mem->s_pfree = CVBBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, CVBBDPrecSetup, CVBBDPrecSolve); return(flag); } int CVBBDPrecReInit(void *cvode_mem, long int mudq, long int mldq, realtype dqrely) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; long int Nlocal; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the preconditioner data is non-NULL */ if (cvspils_mem->s_P_data == NULL) { CVProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; /* Load half-bandwidths */ Nlocal = pdata->n_local; pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); /* Re-initialize nge */ pdata->nge = 0; return(CVSPILS_SUCCESS); } int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { CVProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(CVSPILS_SUCCESS); } int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { CVProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; *ngevalsBBDP = pdata->nge; return(CVSPILS_SUCCESS); } /* Readability Replacements */ #define Nlocal (pdata->n_local) #define mudq (pdata->mudq) #define mldq (pdata->mldq) #define mukeep (pdata->mukeep) #define mlkeep (pdata->mlkeep) #define dqrely (pdata->dqrely) #define gloc (pdata->gloc) #define cfn (pdata->cfn) #define savedJ (pdata->savedJ) #define savedP (pdata->savedP) #define lpivots (pdata->lpivots) #define nge (pdata->nge) /* * ----------------------------------------------------------------- * Function : CVBBDPrecSetup * ----------------------------------------------------------------- * CVBBDPrecSetup generates and factors a banded block of the * preconditioner matrix on each processor, via calls to the * user-supplied gloc and cfn functions. It uses difference * quotient approximations to the Jacobian elements. * * CVBBDPrecSetup calculates a new J,if necessary, then calculates * P = I - gamma*J, and does an LU factorization of P. * * The parameters of CVBBDPrecSetup used here are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data from the * previous CVBBDPrecon call can be reused * (with the current value of gamma). * A CVBBDPrecon call with jok == TRUE should only occur * after a call with jok == FALSE. * * jcurPtr is a pointer to an output integer flag which is * set by CVBBDPrecon as follows: * *jcurPtr = TRUE if Jacobian data was recomputed. * *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * bbd_data is a pointer to the preconditioner data set by * CVBBDPrecInit * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for NVectors which are be used by CVBBDPrecSetup * as temporary storage or work space. * * Return value: * The value returned by this CVBBDPrecSetup function is the int * 0 if successful, * 1 for a recoverable error (step will be retried). * ----------------------------------------------------------------- */ static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int ier; CVBBDPrecData pdata; CVodeMem cv_mem; int retval; pdata = (CVBBDPrecData) bbd_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call CVBBDDQJac for new J value */ *jcurPtr = TRUE; SetToZero(savedJ); retval = CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); if (retval < 0) { CVProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of P in place */ ier = BandGBTRF(savedP, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * Function : CVBBDPrecSolve * ----------------------------------------------------------------- * CVBBDPrecSolve solves a linear system P z = r, with the * band-block-diagonal preconditioner matrix P generated and * factored by CVBBDPrecSetup. * * The parameters of CVBBDPrecSolve used here are as follows: * * r is the right-hand side vector of the linear system. * * bbd_data is a pointer to the preconditioner data set by * CVBBDPrecInit. * * z is the output vector computed by CVBBDPrecSolve. * * The value returned by the CVBBDPrecSolve function is always 0, * indicating success. * ----------------------------------------------------------------- */ static int CVBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data, N_Vector tmp) { CVBBDPrecData pdata; realtype *zd; pdata = (CVBBDPrecData) bbd_data; /* Copy r to z, then do backsolve and return */ N_VScale(ONE, r, z); zd = N_VGetArrayPointer(z); BandGBTRS(savedP, lpivots, zd); return(0); } static void CVBBDPrecFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cv_mem->cv_lmem == NULL) return; cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) return; pdata = (CVBBDPrecData) cvspils_mem->s_P_data; DestroyMat(savedJ); DestroyMat(savedP); DestroyArray(lpivots); free(pdata); pdata = NULL; } #define ewt (cv_mem->cv_ewt) #define h (cv_mem->cv_h) #define user_data (cv_mem->cv_user_data) /* * ----------------------------------------------------------------- * Function : CVBBDDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation * to the local block of the Jacobian of g(t,y). It assumes that a * band matrix of type DlsMat is stored columnwise, and that elements * within each column are contiguous. All matrix elements are generated * as difference quotients, by way of calls to the user routine gloc. * By virtue of the band structure, the number of these calls is * bandwidth + 1, where bandwidth = mldq + mudq + 1. * But the band matrix kept has bandwidth = mlkeep + mukeep + 1. * This routine also assumes that the local elements of a vector are * stored contiguously. * ----------------------------------------------------------------- */ static int CVBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp) { CVodeMem cv_mem; realtype gnorm, minInc, inc, inc_inv; long int group, i, j, width, ngroups, i1, i2; realtype *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Load ytemp with y = predicted solution vector */ N_VScale(ONE, y, ytemp); /* Call cfn and gloc to get base value of g(t,y) */ if (cfn != NULL) { retval = cfn(Nlocal, t, y, user_data); if (retval != 0) return(retval); } retval = gloc(Nlocal, t, ytemp, gy, user_data); nge++; if (retval != 0) return(retval); /* Obtain pointers to the data for various vectors */ y_data = N_VGetArrayPointer(y); gy_data = N_VGetArrayPointer(gy); ewt_data = N_VGetArrayPointer(ewt); ytemp_data = N_VGetArrayPointer(ytemp); gtemp_data = N_VGetArrayPointer(gtemp); /* Set minimum increment based on uround and norm of g */ gnorm = N_VWrmsNorm(gy, ewt); minInc = (gnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < Nlocal; j+=width) { inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate g with incremented y */ retval = gloc(Nlocal, t, ytemp, gtemp, user_data); nge++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < Nlocal; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtemp_data[i] - gy_data[i]); } } return(0); } sundials-2.5.0/src/cvode/cvode_spils_impl.h0000600000175000017500000001256011741421121021603 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:19:48 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the scaled, preconditioned * linear solver modules. * ----------------------------------------------------------------- */ #ifndef _CVSPILS_IMPL_H #define _CVSPILS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "cvode_impl.h" /* Types of iterative linear solvers */ #define SPILS_SPGMR 1 #define SPILS_SPBCG 2 #define SPILS_SPTFQMR 3 /* * ----------------------------------------------------------------- * Types : CVSpilsMemRec, CVSpilsMem * ----------------------------------------------------------------- * The type CVSpilsMem is pointer to a CVSpilsMemRec. * ----------------------------------------------------------------- */ typedef struct CVSpilsMemRec { int s_type; /* type of scaled preconditioned iterative LS */ int s_pretype; /* type of preconditioning */ int s_gstype; /* type of Gram-Schmidt orthogonalization */ realtype s_sqrtN; /* sqrt(N) */ realtype s_eplifac; /* eplifac = user specified or EPLIN_DEFAULT */ realtype s_deltar; /* deltar = delt * tq4 */ realtype s_delta; /* delta = deltar * sqrtN */ int s_maxl; /* maxl = maximum dimension of the Krylov space */ long int s_nstlpre; /* value of nst at the last pset call */ long int s_npe; /* npe = total number of pset calls */ long int s_nli; /* nli = total number of linear iterations */ long int s_nps; /* nps = total number of psolve calls */ long int s_ncfl; /* ncfl = total number of convergence failures */ long int s_njtimes; /* njtimes = total number of calls to jtimes */ long int s_nfes; /* nfeSG = total number of calls to f for difference quotient Jacobian-vector products */ N_Vector s_ytemp; /* temp vector passed to jtimes and psolve */ N_Vector s_x; /* temp vector used by CVSpilsSolve */ N_Vector s_ycur; /* CVODE current y vector in Newton Iteration */ N_Vector s_fcur; /* fcur = f(tn, ycur) */ void* s_spils_mem; /* memory used by the generic solver */ /* Preconditioner computation * (a) user-provided: * - P_data == user_data * - pfree == NULL (the user dealocates memory for user_data) * (b) internal preconditioner module * - P_data == cvode_mem * - pfree == set by the prec. module and called in CVodeFree */ CVSpilsPrecSetupFn s_pset; CVSpilsPrecSolveFn s_psolve; void (*s_pfree)(CVodeMem cv_mem); void *s_P_data; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - j_data == user_data * - jtimesDQ == FALSE * (b) internal jtimes * - j_data == cvode_mem * - jtimesDQ == TRUE */ booleantype s_jtimesDQ; CVSpilsJacTimesVecFn s_jtimes; void *s_j_data; long int s_last_flag; /* last error flag returned by any function */ } *CVSpilsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ /* Atimes and PSolve routines called by generic solver */ int CVSpilsAtimes(void *cv_mem, N_Vector v, N_Vector z); int CVSpilsPSolve(void *cv_mem, N_Vector r, N_Vector z, int lr); /* Difference quotient approximation for Jac times vector */ int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *data, N_Vector work); /* * ----------------------------------------------------------------- * Error Messages * ----------------------------------------------------------------- */ #define MSGS_CVMEM_NULL "Integrator memory is NULL." #define MSGS_MEM_FAIL "A memory request failed." #define MSGS_BAD_NVECTOR "A required vector operation is not implemented." #define MSGS_BAD_LSTYPE "Incompatible linear solver type." #define MSGS_BAD_PRETYPE "Illegal value for pretype. Legal values are PREC_NONE, PREC_LEFT, PREC_RIGHT, and PREC_BOTH." #define MSGS_PSOLVE_REQ "pretype != PREC_NONE, but PSOLVE = NULL is illegal." #define MSGS_LMEM_NULL "Linear solver memory is NULL." #define MSGS_BAD_GSTYPE "Illegal value for gstype. Legal values are MODIFIED_GS and CLASSICAL_GS." #define MSGS_BAD_EPLIN "eplifac < 0 illegal." #define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/cvode_spgmr.c0000600000175000017500000003407311741421121020556 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2011/03/23 22:27:43 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPGMR linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvode_spils_impl.h" #include "cvode_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPGMR linit, lsetup, lsolve, and lfree routines */ static int CVSpgmrInit(CVodeMem cv_mem); static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSpgmrFree(CVodeMem cv_mem); /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define mnewt (cv_mem->cv_mnewt) #define ropt (cv_mem->cv_ropt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * CVSpgmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Spgmr linear solver module. CVSpgmr first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSpgmrInit, CVSpgmrSetup, CVSpgmrSolve, and CVSpgmrFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSpgmr allocates memory for ytemp and x, and calls * SpgmrMalloc to allocate memory for the Spgmr solver. * ----------------------------------------------------------------- */ int CVSpgmr(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPGMR", "CVSpgmr", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if(vec_tmpl->ops->nvdotprod == NULL) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSpgmrInit; lsetup = CVSpgmrSetup; lsolve = CVSpgmrSolve; lfree = CVSpgmrFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPGMR; /* Set Spgmr parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Spgmr parameters */ cvspils_mem->s_gstype = MODIFIED_GS; cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); /* Call SpgmrMalloc to allocate workspace for Spgmr */ spgmr_mem = NULL; spgmr_mem = SpgmrMalloc(mxl, vec_tmpl); if (spgmr_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPGMR memory to spils memory structure */ spils_mem = (void *) spgmr_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability Replacements */ #define pretype (cvspils_mem->s_pretype) #define gstype (cvspils_mem->s_gstype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * CVSpgmrInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Spgmr * linear solver. * ----------------------------------------------------------------- */ static int CVSpgmrInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { CVProcessError(cv_mem, -1, "CVSPGMR", "CVSpgmrInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVSpgmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Spgmr linear solver. * It makes a decision as to whether or not to signal for re-evaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for re-evaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { CVProcessError(cv_mem, SPGMR_PSET_FAIL_UNREC, "CVSPGMR", "CVSpgmrSetup", MSGS_PSET_FAILED); last_flag = SPGMR_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPGMR_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPGMR_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * CVSpgmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SpgmrSolve * for the solution of the linear system Ax = b with the SPGMR method, * without restarts. The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SpgmrSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight, and no restarts are allowed. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SpgmrSolve. The success flag is * returned if SpgmrSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac * tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SpgmrSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SpgmrSolve and copy x to b */ retval = SpgmrSolve(spgmr_mem, cv_mem, x, b, pretype, gstype, delta, 0, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPGMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPGMR_SUCCESS: return(0); break; case SPGMR_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPGMR_CONV_FAIL: return(1); break; case SPGMR_QRFACT_FAIL: return(1); break; case SPGMR_PSOLVE_FAIL_REC: return(1); break; case SPGMR_ATIMES_FAIL_REC: return(1); break; case SPGMR_MEM_NULL: return(-1); break; case SPGMR_ATIMES_FAIL_UNREC: CVProcessError(cv_mem, SPGMR_ATIMES_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPGMR_PSOLVE_FAIL_UNREC: CVProcessError(cv_mem, SPGMR_PSOLVE_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; case SPGMR_GS_FAIL: return(-1); break; case SPGMR_QRSOL_FAIL: return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * CVSpgmrFree * ----------------------------------------------------------------- * This routine frees memory specific to the Spgmr linear solver. * ----------------------------------------------------------------- */ static void CVSpgmrFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); spgmr_mem = (SpgmrMem) spils_mem; SpgmrFree(spgmr_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; } sundials-2.5.0/src/cvode/cvode_impl.h0000600000175000017500000005742711741421121020404 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2007/11/26 16:19:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban * and Dan Shumaker @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the main CVODE integrator. * ----------------------------------------------------------------- */ #ifndef _CVODE_IMPL_H #define _CVODE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* Basic CVODE constants */ #define ADAMS_Q_MAX 12 /* max value of q for lmm == ADAMS */ #define BDF_Q_MAX 5 /* max value of q for lmm == BDF */ #define Q_MAX ADAMS_Q_MAX /* max value of q for either lmm */ #define L_MAX (Q_MAX+1) /* max value of L for either lmm */ #define NUM_TESTS 5 /* number of error test quantities */ #define HMIN_DEFAULT RCONST(0.0) /* hmin default value */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MXHNIL_DEFAULT 10 /* mxhnil default value */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* * ----------------------------------------------------------------- * Types : struct CVodeMemRec, CVodeMem * ----------------------------------------------------------------- * The type CVodeMem is type pointer to struct CVodeMemRec. * This structure contains fields to keep track of problem state. * ----------------------------------------------------------------- */ typedef struct CVodeMemRec { realtype cv_uround; /* machine unit roundoff */ /*-------------------------- Problem Specification Data --------------------------*/ CVRhsFn cv_f; /* y' = f(t,y(t)) */ void *cv_user_data; /* user pointer passed to f */ int cv_lmm; /* lmm = CV_ADAMS or CV_BDF */ int cv_iter; /* iter = CV_FUNCTIONAL or CV_NEWTON */ int cv_itol; /* itol = CV_SS, CV_SV, CV_WF, CV_NN */ realtype cv_reltol; /* relative tolerance */ realtype cv_Sabstol; /* scalar absolute tolerance */ N_Vector cv_Vabstol; /* vector absolute tolerance */ booleantype cv_user_efun; /* TRUE if user sets efun */ CVEwtFn cv_efun; /* function to set ewt */ void *cv_e_data; /* user pointer passed to efun */ /*----------------------- Nordsieck History Array -----------------------*/ N_Vector cv_zn[L_MAX]; /* Nordsieck array, of size N x (q+1). zn[j] is a vector of length N (j=0,...,q) zn[j] = [1/factorial(j)] * h^j * (jth derivative of the interpolating polynomial */ /*-------------------------- other vectors of length N -------------------------*/ N_Vector cv_ewt; /* error weight vector */ N_Vector cv_y; /* y is used as temporary storage by the solver The memory is provided by the user to CVode where the vector is named yout. */ N_Vector cv_acor; /* In the context of the solution of the nonlinear equation, acor = y_n(m) - y_n(0). On return, this vector is scaled to give the est. local err. */ N_Vector cv_tempv; /* temporary storage vector */ N_Vector cv_ftemp; /* temporary storage vector */ /*----------------- Tstop information -----------------*/ booleantype cv_tstopset; realtype cv_tstop; /*--------- Step Data ---------*/ int cv_q; /* current order */ int cv_qprime; /* order to be used on the next step = q-1, q, or q+1 */ int cv_next_q; /* order to be used on the next step */ int cv_qwait; /* number of internal steps to wait before considering a change in q */ int cv_L; /* L = q + 1 */ realtype cv_hin; /* initial step size */ realtype cv_h; /* current step size */ realtype cv_hprime; /* step size to be used on the next step */ realtype cv_next_h; /* step size to be used on the next step */ realtype cv_eta; /* eta = hprime / h */ realtype cv_hscale; /* value of h used in zn */ realtype cv_tn; /* current internal value of t */ realtype cv_tretlast; /* value of tret last returned by CVode */ realtype cv_tau[L_MAX+1]; /* array of previous q+1 successful step sizes indexed from 1 to q+1 */ realtype cv_tq[NUM_TESTS+1]; /* array of test quantities indexed from 1 to NUM_TESTS(=5) */ realtype cv_l[L_MAX]; /* coefficients of l(x) (degree q poly) */ realtype cv_rl1; /* the scalar 1/l[1] */ realtype cv_gamma; /* gamma = h * rl1 */ realtype cv_gammap; /* gamma at the last setup call */ realtype cv_gamrat; /* gamma / gammap */ realtype cv_crate; /* estimated corrector convergence rate */ realtype cv_acnrm; /* | acor | wrms */ realtype cv_nlscoef; /* coeficient in nonlinear convergence test */ int cv_mnewt; /* Newton iteration counter */ /*------ Limits ------*/ int cv_qmax; /* q <= qmax */ long int cv_mxstep; /* maximum number of internal steps for one user call */ int cv_maxcor; /* maximum number of corrector iterations for the solution of the nonlinear equation */ int cv_mxhnil; /* maximum number of warning messages issued to the user that t + h == t for the next internal step */ int cv_maxnef; /* maximum number of error test failures */ int cv_maxncf; /* maximum number of nonlinear convergence failures */ realtype cv_hmin; /* |h| >= hmin */ realtype cv_hmax_inv; /* |h| <= 1/hmax_inv */ realtype cv_etamax; /* eta <= etamax */ /*-------- Counters --------*/ long int cv_nst; /* number of internal steps taken */ long int cv_nfe; /* number of f calls */ long int cv_ncfn; /* number of corrector convergence failures */ long int cv_netf; /* number of error test failures */ long int cv_nni; /* number of Newton iterations performed */ long int cv_nsetups; /* number of setup calls */ int cv_nhnil; /* number of messages issued to the user that t + h == t for the next iternal step */ realtype cv_etaqm1; /* ratio of new to old h for order q-1 */ realtype cv_etaq; /* ratio of new to old h for order q */ realtype cv_etaqp1; /* ratio of new to old h for order q+1 */ /*---------------------------- Space requirements for CVODE ----------------------------*/ long int cv_lrw1; /* no. of realtype words in 1 N_Vector */ long int cv_liw1; /* no. of integer words in 1 N_Vector */ long int cv_lrw; /* no. of realtype words in CVODE work vectors */ long int cv_liw; /* no. of integer words in CVODE work vectors */ /*------------------ Linear Solver Data ------------------*/ /* Linear Solver functions to be called */ int (*cv_linit)(struct CVodeMemRec *cv_mem); int (*cv_lsetup)(struct CVodeMemRec *cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int (*cv_lsolve)(struct CVodeMemRec *cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); void (*cv_lfree)(struct CVodeMemRec *cv_mem); /* Linear Solver specific memory */ void *cv_lmem; /*------------ Saved Values ------------*/ int cv_qu; /* last successful q value used */ long int cv_nstlp; /* step number of last setup call */ realtype cv_h0u; /* actual initial stepsize */ realtype cv_hu; /* last successful h value used */ realtype cv_saved_tq5; /* saved value of tq[5] */ booleantype cv_jcur; /* is Jacobian info. for lin. solver current? */ realtype cv_tolsf; /* tolerance scale factor */ int cv_qmax_alloc; /* value of qmax used when allocating memory */ int cv_indx_acor; /* index of the zn vector with saved acor */ booleantype cv_setupNonNull; /* does setup do anything? */ booleantype cv_VabstolMallocDone; booleantype cv_MallocDone; /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ CVErrHandlerFn cv_ehfun; /* error messages are handled by ehfun */ void *cv_eh_data; /* data pointer passed to ehfun */ FILE *cv_errfp; /* CVODE error messages are sent to errfp */ /*------------------------- Stability Limit Detection -------------------------*/ booleantype cv_sldeton; /* is Stability Limit Detection on? */ realtype cv_ssdat[6][4]; /* scaled data array for STALD */ int cv_nscon; /* counter for STALD method */ long int cv_nor; /* counter for number of order reductions */ /*---------------- Rootfinding Data ----------------*/ CVRootFn cv_gfun; /* function g for roots sought */ int cv_nrtfn; /* number of components of g */ int *cv_iroots; /* array for root information */ int *cv_rootdir; /* array specifying direction of zero-crossing */ realtype cv_tlo; /* nearest endpoint of interval in root search */ realtype cv_thi; /* farthest endpoint of interval in root search */ realtype cv_trout; /* t value returned by rootfinding routine */ realtype *cv_glo; /* saved array of g values at t = tlo */ realtype *cv_ghi; /* saved array of g values at t = thi */ realtype *cv_grout; /* array of g values at t = trout */ realtype cv_toutc; /* copy of tout (if NORMAL mode) */ realtype cv_ttol; /* tolerance on root location */ int cv_taskc; /* copy of parameter itask */ int cv_irfnd; /* flag showing whether last step had a root */ long int cv_nge; /* counter for g evaluations */ booleantype *cv_gactive; /* array with active/inactive event functions */ int cv_mxgnull; /* number of warning messages about possible g==0 */ } *CVodeMem; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * Communication between CVODE and a CVODE Linear Solver * ----------------------------------------------------------------- * convfail (input to cv_lsetup) * * CV_NO_FAILURES : Either this is the first cv_setup call for this * step, or the local error test failed on the * previous attempt at this step (but the Newton * iteration converged). * * CV_FAIL_BAD_J : This value is passed to cv_lsetup if * * (a) The previous Newton corrector iteration * did not converge and the linear solver's * setup routine indicated that its Jacobian- * related data is not current * or * (b) During the previous Newton corrector * iteration, the linear solver's solve routine * failed in a recoverable manner and the * linear solver's setup routine indicated that * its Jacobian-related data is not current. * * CV_FAIL_OTHER : During the current internal step try, the * previous Newton iteration failed to converge * even though the linear solver was using current * Jacobian-related data. * ----------------------------------------------------------------- */ /* Constants for convfail (input to cv_lsetup) */ #define CV_NO_FAILURES 0 #define CV_FAIL_BAD_J 1 #define CV_FAIL_OTHER 2 /* * ----------------------------------------------------------------- * int (*cv_linit)(CVodeMem cv_mem); * ----------------------------------------------------------------- * The purpose of cv_linit is to complete initializations for a * specific linear solver, such as counters and statistics. * An LInitFn should return 0 if it has successfully initialized the * CVODE linear solver and a negative value otherwise. * If an error does occur, an appropriate message should be sent to * the error handler function. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsetup)(CVodeMem cv_mem, int convfail, N_Vector ypred, * N_Vector fpred, booleantype *jcurPtr, * N_Vector vtemp1, N_Vector vtemp2, * N_Vector vtemp3); * ----------------------------------------------------------------- * The job of cv_lsetup is to prepare the linear solver for * subsequent calls to cv_lsolve. It may recompute Jacobian- * related data is it deems necessary. Its parameters are as * follows: * * cv_mem - problem memory pointer of type CVodeMem. See the * typedef earlier in this file. * * convfail - a flag to indicate any problem that occurred during * the solution of the nonlinear equation on the * current time step for which the linear solver is * being used. This flag can be used to help decide * whether the Jacobian data kept by a CVODE linear * solver needs to be updated or not. * Its possible values have been documented above. * * ypred - the predicted y vector for the current CVODE internal * step. * * fpred - f(tn, ypred). * * jcurPtr - a pointer to a boolean to be filled in by cv_lsetup. * The function should set *jcurPtr=TRUE if its Jacobian * data is current after the call and should set * *jcurPtr=FALSE if its Jacobian data is not current. * Note: If cv_lsetup calls for re-evaluation of * Jacobian data (based on convfail and CVODE state * data), it should return *jcurPtr=TRUE always; * otherwise an infinite loop can result. * * vtemp1 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * The cv_lsetup routine should return 0 if successful, a positive * value for a recoverable error, and a negative value for an * unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsolve)(CVodeMem cv_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector fcur); * ----------------------------------------------------------------- * cv_lsolve must solve the linear equation P x = b, where * P is some approximation to (I - gamma J), J = (df/dy)(tn,ycur) * and the RHS vector b is input. The N-vector ycur contains * the solver's current approximation to y(tn) and the vector * fcur contains the N_Vector f(tn,ycur). The solution is to be * returned in the vector b. cv_lsolve returns a positive value * for a recoverable error and a negative value for an * unrecoverable error. Success is indicated by a 0 return value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * void (*cv_lfree)(CVodeMem cv_mem); * ----------------------------------------------------------------- * cv_lfree should free up any memory allocated by the linear * solver. This routine is called once a problem has been * completed and the linear solver is no longer needed. * ----------------------------------------------------------------- */ /* * ================================================================= * C V O D E I N T E R N A L F U N C T I O N S * ================================================================= */ /* Prototype of internal ewtSet function */ int CVEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void CVProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void CVErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* * ================================================================= * C V O D E E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg" #define MSG_TIME_H "t = %Lg and h = %Lg" #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg" #define MSG_TIME_H "t = %lg and h = %lg" #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g" #define MSG_TIME_H "t = %g and h = %g" #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* Initialization and I/O error messages */ #define MSGCV_NO_MEM "cvode_mem = NULL illegal." #define MSGCV_CVMEM_FAIL "Allocation of cvode_mem failed." #define MSGCV_MEM_FAIL "A memory request failed." #define MSGCV_BAD_LMM "Illegal value for lmm. The legal values are CV_ADAMS and CV_BDF." #define MSGCV_BAD_ITER "Illegal value for iter. The legal values are CV_FUNCTIONAL and CV_NEWTON." #define MSGCV_NO_MALLOC "Attempt to call before CVodeInit." #define MSGCV_NEG_MAXORD "maxord <= 0 illegal." #define MSGCV_BAD_MAXORD "Illegal attempt to increase maximum method order." #define MSGCV_SET_SLDET "Attempt to use stability limit detection with the CV_ADAMS method illegal." #define MSGCV_NEG_HMIN "hmin < 0 illegal." #define MSGCV_NEG_HMAX "hmax < 0 illegal." #define MSGCV_BAD_HMIN_HMAX "Inconsistent step size limits: hmin > hmax." #define MSGCV_BAD_RELTOL "reltol < 0 illegal." #define MSGCV_BAD_ABSTOL "abstol has negative component(s) (illegal)." #define MSGCV_NULL_ABSTOL "abstol = NULL illegal." #define MSGCV_NULL_Y0 "y0 = NULL illegal." #define MSGCV_NULL_F "f = NULL illegal." #define MSGCV_NULL_G "g = NULL illegal." #define MSGCV_BAD_NVECTOR "A required vector operation is not implemented." #define MSGCV_BAD_K "Illegal value for k." #define MSGCV_NULL_DKY "dky = NULL illegal." #define MSGCV_BAD_T "Illegal value for t." MSG_TIME_INT #define MSGCV_NO_ROOT "Rootfinding was not initialized." /* CVode Error Messages */ #define MSGCV_NO_TOLS "No integration tolerances have been specified." #define MSGCV_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSGCV_YOUT_NULL "yout = NULL illegal." #define MSGCV_TRET_NULL "tret = NULL illegal." #define MSGCV_BAD_EWT "Initial ewt has component(s) equal to zero (illegal)." #define MSGCV_EWT_NOW_BAD "At " MSG_TIME ", a component of ewt has become <= 0." #define MSGCV_BAD_ITASK "Illegal value for itask." #define MSGCV_BAD_H0 "h0 and tout - t0 inconsistent." #define MSGCV_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration" #define MSGCV_EWT_FAIL "The user-provide EwtSet function failed." #define MSGCV_EWT_NOW_FAIL "At " MSG_TIME ", the user-provide EwtSet function failed." #define MSGCV_LINIT_FAIL "The linear solver's init routine failed." #define MSGCV_HNIL_DONE "The above warning has been issued mxhnil times and will not be issued again for this problem." #define MSGCV_TOO_CLOSE "tout too close to t0 to start integration." #define MSGCV_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSGCV_TOO_MUCH_ACC "At " MSG_TIME ", too much accuracy requested." #define MSGCV_HNIL "Internal " MSG_TIME_H " are such that t + h = t on the next step. The solver will continue anyway." #define MSGCV_ERR_FAILS "At " MSG_TIME_H ", the error test failed repeatedly or with |h| = hmin." #define MSGCV_CONV_FAILS "At " MSG_TIME_H ", the corrector convergence test failed repeatedly or with |h| = hmin." #define MSGCV_SETUP_FAILED "At " MSG_TIME ", the setup routine failed in an unrecoverable manner." #define MSGCV_SOLVE_FAILED "At " MSG_TIME ", the solve routine failed in an unrecoverable manner." #define MSGCV_RHSFUNC_FAILED "At " MSG_TIME ", the right-hand side routine failed in an unrecoverable manner." #define MSGCV_RHSFUNC_UNREC "At " MSG_TIME ", the right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_RHSFUNC_REPTD "At " MSG_TIME " repeated recoverable right-hand side function errors." #define MSGCV_RHSFUNC_FIRST "The right-hand side routine failed at the first call." #define MSGCV_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSGCV_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSGCV_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME " in the direction of integration." #define MSGCV_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/cvode_bbdpre_impl.h0000600000175000017500000000446311741421121021712 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:19:48 $ * ----------------------------------------------------------------- * Programmer(s): Michael Wittman, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the CVBBDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVBBDPRE_IMPL_H #define _CVBBDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Type: CVBBDPrecData * ----------------------------------------------------------------- */ typedef struct CVBBDPrecDataRec { /* passed by user to CVBBDPrecAlloc and used by PrecSetup/PrecSolve */ long int mudq, mldq, mukeep, mlkeep; realtype dqrely; CVLocalFn gloc; CVCommFn cfn; /* set by CVBBDPrecSetup and used by CVBBDPrecSolve */ DlsMat savedJ; DlsMat savedP; long int *lpivots; /* set by CVBBDPrecAlloc and used by CVBBDPrecSetup */ long int n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to cvode_mem */ void *cvode_mem; } *CVBBDPrecData; /* * ----------------------------------------------------------------- * CVBBDPRE error messages * ----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. CVBBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/cvode_io.c0000600000175000017500000005463411741421121020042 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the CVODE solver. * ----------------------------------------------------------------- */ #include #include #include "cvode_impl.h" #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define lrw (cv_mem->cv_lrw) #define liw (cv_mem->cv_liw) #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) /* * ================================================================= * CVODE optional input functions * ================================================================= */ /* * CVodeSetErrHandlerFn * * Specifies the error handler function */ int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetErrHandlerFn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_ehfun = ehfun; cv_mem->cv_eh_data = eh_data; return(CV_SUCCESS); } /* * CVodeSetErrFile * * Specifies the FILE pointer for output (NULL means no messages) */ int CVodeSetErrFile(void *cvode_mem, FILE *errfp) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetErrFile", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errfp = errfp; return(CV_SUCCESS); } /* * CVodeSetIterType * * Specifies the iteration type (CV_FUNCTIONAL or CV_NEWTON) */ int CVodeSetIterType(void *cvode_mem, int iter) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetIterType", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetIterType", MSGCV_BAD_ITER); return (CV_ILL_INPUT); } cv_mem->cv_iter = iter; return(CV_SUCCESS); } /* * CVodeSetUserData * * Specifies the user data pointer for f */ int CVodeSetUserData(void *cvode_mem, void *user_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetUserData", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_user_data = user_data; return(CV_SUCCESS); } /* * CVodeSetMaxOrd * * Specifies the maximum method order */ int CVodeSetMaxOrd(void *cvode_mem, int maxord) { CVodeMem cv_mem; int qmax_alloc; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxOrd", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (maxord <= 0) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMaxOrd", MSGCV_NEG_MAXORD); return(CV_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ qmax_alloc = cv_mem->cv_qmax_alloc; if (maxord > qmax_alloc) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMaxOrd", MSGCV_BAD_MAXORD); return(CV_ILL_INPUT); } cv_mem->cv_qmax = maxord; return(CV_SUCCESS); } /* * CVodeSetMaxNumSteps * * Specifies the maximum number of integration steps */ int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) cv_mem->cv_mxstep = MXSTEP_DEFAULT; else cv_mem->cv_mxstep = mxsteps; return(CV_SUCCESS); } /* * CVodeSetMaxHnilWarns * * Specifies the maximum number of warnings for small h */ int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxHnilWarns", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxhnil = mxhnil; return(CV_SUCCESS); } /* *CVodeSetStabLimDet * * Turns on/off the stability limit detection algorithm */ int CVodeSetStabLimDet(void *cvode_mem, booleantype sldet) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetStabLimDet", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if( sldet && (cv_mem->cv_lmm != CV_BDF) ) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetStabLimDet", MSGCV_SET_SLDET); return(CV_ILL_INPUT); } cv_mem->cv_sldeton = sldet; return(CV_SUCCESS); } /* * CVodeSetInitStep * * Specifies the initial step size */ int CVodeSetInitStep(void *cvode_mem, realtype hin) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_hin = hin; return(CV_SUCCESS); } /* * CVodeSetMinStep * * Specifies the minimum step size */ int CVodeSetMinStep(void *cvode_mem, realtype hmin) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMinStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmin<0) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMinStep", MSGCV_NEG_HMIN); return(CV_ILL_INPUT); } /* Passing 0 sets hmin = zero */ if (hmin == ZERO) { cv_mem->cv_hmin = HMIN_DEFAULT; return(CV_SUCCESS); } if (hmin * cv_mem->cv_hmax_inv > ONE) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMinStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmin = hmin; return(CV_SUCCESS); } /* * CVodeSetMaxStep * * Specifies the maximum step size */ int CVodeSetMaxStep(void *cvode_mem, realtype hmax) { realtype hmax_inv; CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxStep", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmax < 0) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMaxStep", MSGCV_NEG_HMAX); return(CV_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; return(CV_SUCCESS); } hmax_inv = ONE/hmax; if (hmax_inv * cv_mem->cv_hmin > ONE) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetMaxStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmax_inv = hmax_inv; return(CV_SUCCESS); } /* * CVodeSetStopTime * * Specifies the time beyond which the integration is not to proceed. */ int CVodeSetStopTime(void *cvode_mem, realtype tstop) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetStopTime", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* If CVode was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If CVodeSetStopTime is called before the first call to CVode, * tstop will be checked in CVode. */ if (cv_mem->cv_nst > 0) { if ( (tstop - cv_mem->cv_tn) * cv_mem->cv_h < ZERO ) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSetStopTime", MSGCV_BAD_TSTOP, cv_mem->cv_tn); return(CV_ILL_INPUT); } } cv_mem->cv_tstop = tstop; cv_mem->cv_tstopset = TRUE; return(CV_SUCCESS); } /* * CVodeSetMaxErrTestFails * * Specifies the maximum number of error test failures during one * step try. */ int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxErrTestFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxnef = maxnef; return(CV_SUCCESS); } /* * CVodeSetMaxConvFails * * Specifies the maximum number of nonlinear convergence failures * during one step try. */ int CVodeSetMaxConvFails(void *cvode_mem, int maxncf) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxConvFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxncf = maxncf; return(CV_SUCCESS); } /* * CVodeSetMaxNonlinIters * * Specifies the maximum number of nonlinear iterations during * one solve. */ int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetMaxNonlinIters", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxcor = maxcor; return(CV_SUCCESS); } /* * CVodeSetNonlinConvCoef * * Specifies the coeficient in the nonlinear solver convergence * test */ int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetNonlinConvCoef", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_nlscoef = nlscoef; return(CV_SUCCESS); } /* * CVodeSetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int CVodeSetRootDirection(void *cvode_mem, int *rootdir) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetRootDirection", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; if (nrt==0) { CVProcessError(NULL, CV_ILL_INPUT, "CVODE", "CVodeSetRootDirection", MSGCV_NO_ROOT); return(CV_ILL_INPUT); } for(i=0; icv_rootdir[i] = rootdir[i]; return(CV_SUCCESS); } /* * CVodeSetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int CVodeSetNoInactiveRootWarn(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSetNoInactiveRootWarn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxgnull = 0; return(CV_SUCCESS); } /* * ================================================================= * CVODE optional output functions * ================================================================= */ /* * Readability constants */ #define nst (cv_mem->cv_nst) #define nfe (cv_mem->cv_nfe) #define ncfn (cv_mem->cv_ncfn) #define netf (cv_mem->cv_netf) #define nni (cv_mem->cv_nni) #define nsetups (cv_mem->cv_nsetups) #define qu (cv_mem->cv_qu) #define next_q (cv_mem->cv_next_q) #define ewt (cv_mem->cv_ewt) #define hu (cv_mem->cv_hu) #define next_h (cv_mem->cv_next_h) #define h0u (cv_mem->cv_h0u) #define tolsf (cv_mem->cv_tolsf) #define acor (cv_mem->cv_acor) #define lrw (cv_mem->cv_lrw) #define liw (cv_mem->cv_liw) #define nge (cv_mem->cv_nge) #define iroots (cv_mem->cv_iroots) #define nor (cv_mem->cv_nor) #define sldeton (cv_mem->cv_sldeton) #define tn (cv_mem->cv_tn) #define efun (cv_mem->cv_efun) /* * CVodeGetNumSteps * * Returns the current number of integration steps */ int CVodeGetNumSteps(void *cvode_mem, long int *nsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = nst; return(CV_SUCCESS); } /* * CVodeGetNumRhsEvals * * Returns the current number of calls to f */ int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nfevals = nfe; return(CV_SUCCESS); } /* * CVodeGetNumLinSolvSetups * * Returns the current number of calls to the linear solver setup routine */ int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumLinSolvSetups", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nlinsetups = nsetups; return(CV_SUCCESS); } /* * CVodeGetNumErrTestFails * * Returns the current number of error test failures */ int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *netfails = netf; return(CV_SUCCESS); } /* * CVodeGetLastOrder * * Returns the order on the last succesful step */ int CVodeGetLastOrder(void *cvode_mem, int *qlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetLastOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qlast = qu; return(CV_SUCCESS); } /* * CVodeGetCurrentOrder * * Returns the order to be attempted on the next step */ int CVodeGetCurrentOrder(void *cvode_mem, int *qcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetCurrentOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qcur = next_q; return(CV_SUCCESS); } /* * CVodeGetNumStabLimOrderReds * * Returns the number of order reductions triggered by the stability * limit detection algorithm */ int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumStabLimOrderReds", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sldeton==FALSE) *nslred = 0; else *nslred = nor; return(CV_SUCCESS); } /* * CVodeGetActualInitStep * * Returns the step size used on the first step */ int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetActualInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hinused = h0u; return(CV_SUCCESS); } /* * CVodeGetLastStep * * Returns the step size used on the last successful step */ int CVodeGetLastStep(void *cvode_mem, realtype *hlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetLastStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hlast = hu; return(CV_SUCCESS); } /* * CVodeGetCurrentStep * * Returns the step size to be attempted on the next step */ int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetCurrentStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hcur = next_h; return(CV_SUCCESS); } /* * CVodeGetCurrentTime * * Returns the current value of the independent variable */ int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetCurrentTime", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tcur = tn; return(CV_SUCCESS); } /* * CVodeGetTolScaleFactor * * Returns a suggested factor for scaling tolerances */ int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfact) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetTolScaleFactor", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tolsfact = tolsf; return(CV_SUCCESS); } /* * CVodeGetErrWeights * * This routine returns the current weight vector. */ int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, ewt, eweight); return(CV_SUCCESS); } /* * CVodeGetEstLocalErrors * * Returns an estimate of the local error */ int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetEstLocalErrors", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, acor, ele); return(CV_SUCCESS); } /* * CVodeGetWorkSpace * * Returns integrator work space requirements */ int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetWorkSpace", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *leniw = liw; *lenrw = lrw; return(CV_SUCCESS); } /* * CVodeGetIntegratorStats * * Returns integrator statistics */ int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetIntegratorStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = nst; *nfevals = nfe; *nlinsetups = nsetups; *netfails = netf; *qlast = qu; *qcur = next_q; *hinused = h0u; *hlast = hu; *hcur = next_h; *tcur = tn; return(CV_SUCCESS); } /* * CVodeGetNumGEvals * * Returns the current number of calls to g (for rootfinding) */ int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetNumGEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *ngevals = nge; return(CV_SUCCESS); } /* * CVodeGetRootInfo * * Returns pointer to array rootsfound showing roots found */ int CVodeGetRootInfo(void *cvode_mem, int *rootsfound) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetRootInfo", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; for (i=0; i #include #include #include "cvode_direct_impl.h" #include "cvode_impl.h" #include /* Constant */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* CVLAPACK DENSE linit, lsetup, lsolve, and lfree routines */ static int cvLapackDenseInit(CVodeMem cv_mem); static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC); static void cvLapackDenseFree(CVodeMem cv_mem); /* CVLAPACK BAND linit, lsetup, lsolve, and lfree routines */ static int cvLapackBandInit(CVodeMem cv_mem); static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC); static void cvLapackBandFree(CVodeMem cv_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define tempv (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define ml (cvdls_mem->d_ml) #define mu (cvdls_mem->d_mu) #define smu (cvdls_mem->d_smu) #define jacDQ (cvdls_mem->d_jacDQ) #define djac (cvdls_mem->d_djac) #define bjac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define savedJ (cvdls_mem->d_savedJ) #define pivots (cvdls_mem->d_pivots) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION * ================================================================= */ /* * ----------------------------------------------------------------- * CVLapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. CVLapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be cvLapackDenseInit, cvLapackDenseSetup, cvLapackDenseSolve, * and cvLapackDenseFree, respectively. It allocates memory for a * structure of type CVDlsMemRec and sets the cv_lmem field in * (*cvode_mem) to the address of this structure. It sets setupNonNull * in (*cvode_mem) to TRUE, and the d_jac field to the default * cvDlsDenseDQJac. Finally, it allocates memory for M, pivots, and * savedJ. * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVLapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int CVLapackDense(void *cvode_mem, int N) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVLAPACK", "CVLapackDense", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the LAPACK solver */ if (tempv->ops->nvgetarraypointer == NULL || tempv->ops->nvsetarraypointer == NULL) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVLAPACK", "CVLapackDense", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree !=NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvLapackDenseInit; lsetup = cvLapackDenseSetup; lsolve = cvLapackDenseSolve; lfree = cvLapackDenseFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackDense", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Initialize Jacobian-related data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for M, pivot array, and savedJ */ M = NULL; pivots = NULL; savedJ = NULL; M = NewDenseMat(n, n); if (M == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackDense", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackDense", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NewDenseMat(n, n); if (savedJ == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackDense", MSGD_MEM_FAIL); DestroyMat(M); DestroyArray(pivots); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * CVLapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) * to be cvLapackBandInit, cvLapackBandSetup, cvLapackBandSolve, * and cvLapackBandFree, respectively. It allocates memory for a * structure of type CVLapackBandMemRec and sets the cv_lmem field in * (*cvode_mem) to the address of this structure. It sets setupNonNull * in (*cvode_mem) to be TRUE, mu to be mupper, ml to be mlower, and * the jacE and jacI field to NULL. * Finally, it allocates memory for M, pivots, and savedJ. * The CVLapackBand return value is CVDLS_SUCCESS = 0, * CVDLS_MEM_FAIL = -1, or CVDLS_ILL_INPUT = -2. * * NOTE: The CVLAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVLapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVLAPACK", "CVLapackBand", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (tempv->ops->nvgetarraypointer == NULL) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVLAPACK", "CVLapackBand", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvLapackBandInit; lsetup = cvLapackBandSetup; lsolve = cvLapackBandSolve; lfree = cvLapackBandFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackBand", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Initialize Jacobian-related data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwiths in cvdls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVLAPACK", "CVLapackBand", MSGD_BAD_SIZES); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for M, pivot array, and savedJ */ M = NULL; pivots = NULL; savedJ = NULL; M = NewBandMat(n, mu, ml, smu); if (M == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackBand", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackBand", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NewBandMat(n, mu, ml, smu); if (savedJ == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVLAPACK", "CVLapackBand", MSGD_MEM_FAIL); DestroyMat(M); DestroyArray(pivots); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS * ================================================================= */ /* * cvLapackDenseInit does remaining initializations specific to the dense * linear solver. */ static int cvLapackDenseInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { djac = cvDlsDenseDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackDenseSetup does the setup operations for the dense linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J * updates counters, and calls the dense LU factorization routine. */ static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVDlsMem cvdls_mem; realtype dgamma, fact; booleantype jbad, jok; int ier, retval, one = 1; int intn, lenmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; lenmat = M->ldata ; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; dcopy_f77(&lenmat, savedJ->data, &one, M->data, &one); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = djac(n, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); if (retval == 0) { dcopy_f77(&lenmat, M->data, &one, savedJ->data, &one); } else if (retval < 0) { CVProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVLAPACK", "cvLapackDenseSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } } /* Scale J by - gamma */ fact = -gamma; dscal_f77(&lenmat, &fact, M->data, &one); /* Add identity to get M = I - gamma*J*/ AddIdentity(M); /* Do LU factorization of M */ dgetrf_f77(&intn, &intn, M->data, &intn, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * cvLapackDenseSolve handles the solve operation for the dense linear solver * by calling the dense backsolve routine. */ static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC) { CVDlsMem cvdls_mem; realtype *bd, fact; int ier, one = 1; int intn; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; bd = N_VGetArrayPointer(b); dgetrs_f77("N", &intn, &one, M->data, &intn, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { fact = TWO/(ONE + gamrat); dscal_f77(&intn, &fact, bd, &one); } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackDenseFree frees memory specific to the dense linear solver. */ static void cvLapackDenseFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyArray(pivots); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS * ================================================================= */ /* * cvLapackBandInit does remaining initializations specific to the band * linear solver. */ static int cvLapackBandInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { bjac = cvDlsBandDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackBandSetup does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J, * updates counters, and calls the band LU factorization routine. */ static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVDlsMem cvdls_mem; realtype dgamma, fact; booleantype jbad, jok; int ier, retval, one = 1; int intn, iml, imu, lenmat, ldmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; lenmat = M->ldata; ldmat = M->ldim; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; dcopy_f77(&lenmat, savedJ->data, &one, M->data, &one); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = bjac(n, mu, ml, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); if (retval == 0) { dcopy_f77(&lenmat, M->data, &one, savedJ->data, &one); } else if (retval < 0) { CVProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVLAPACK", "cvLapackBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } } /* Scale J by - gamma */ fact = -gamma; dscal_f77(&lenmat, &fact, M->data, &one); /* Add identity to get M = I - gamma*J*/ AddIdentity(M); /* Do LU factorization of M */ dgbtrf_f77(&intn, &intn, &iml, &imu, M->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * cvLapackBandSolve handles the solve operation for the band linear solver * by calling the band backsolve routine. */ static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC) { CVDlsMem cvdls_mem; realtype *bd, fact; int ier, one = 1; int intn, iml, imu, ldmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = M->ldim; bd = N_VGetArrayPointer(b); dgbtrs_f77("N", &intn, &iml, &imu, &one, M->data, &ldmat, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { fact = TWO/(ONE + gamrat); dscal_f77(&intn, &fact, bd, &one); } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackBandFree frees memory specific to the band linear solver. */ static void cvLapackBandFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyArray(pivots); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; } sundials-2.5.0/src/cvode/cvode.c0000600000175000017500000034514511741421121017353 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.24 $ * $Date: 2012/03/06 21:58:36 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Dan Shumaker @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the main CVODE integrator. * It is independent of the CVODE linear solver in use. * ----------------------------------------------------------------- */ /*=================================================================*/ /* Import Header Files */ /*=================================================================*/ #include #include #include #include #include "cvode_impl.h" #include #include /*=================================================================*/ /* Macros */ /*=================================================================*/ /* Macro: loop */ #define loop for(;;) /*=================================================================*/ /* CVODE Private Constants */ /*=================================================================*/ #define ZERO RCONST(0.0) /* real 0.0 */ #define TINY RCONST(1.0e-10) /* small number */ #define TENTH RCONST(0.1) /* real 0.1 */ #define POINT2 RCONST(0.2) /* real 0.2 */ #define FOURTH RCONST(0.25) /* real 0.25 */ #define HALF RCONST(0.5) /* real 0.5 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define THREE RCONST(3.0) /* real 3.0 */ #define FOUR RCONST(4.0) /* real 4.0 */ #define FIVE RCONST(5.0) /* real 5.0 */ #define TWELVE RCONST(12.0) /* real 12.0 */ #define HUN RCONST(100.0) /* real 100.0 */ /*=================================================================*/ /* CVODE Routine-Specific Constants */ /*=================================================================*/ /* * Control constants for lower-level functions used by CVStep * ---------------------------------------------------------- * * CVHin return values: * CV_SUCCESS * CV_RHSFUNC_FAIL * CV_TOO_CLOSE * * CVStep control constants: * DO_ERROR_TEST * PREDICT_AGAIN * * CVStep return values: * CV_SUCCESS, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, * CV_RHSFUNC_FAIL, CV_RTFUNC_FAIL * CV_CONV_FAILURE, CV_ERR_FAILURE, * CV_FIRST_RHSFUNC_ERR * * CVNls input nflag values: * FIRST_CALL * PREV_CONV_FAIL * PREV_ERR_FAIL * * CVNls return values: * CV_SUCCESS, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, CV_RHSFUNC_FAIL, * CONV_FAIL, RHSFUNC_RECVR * * CVNewtonIteration return values: * CV_SUCCESS, * CV_LSOLVE_FAIL, CV_RHSFUNC_FAIL * CONV_FAIL, RHSFUNC_RECVR, * TRY_AGAIN * */ #define DO_ERROR_TEST +2 #define PREDICT_AGAIN +3 #define CONV_FAIL +4 #define TRY_AGAIN +5 #define FIRST_CALL +6 #define PREV_CONV_FAIL +7 #define PREV_ERR_FAIL +8 #define RHSFUNC_RECVR +9 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- * * CVRcheck1 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * CVRcheck2 return values: * CV_SUCCESS * CV_RTFUNC_FAIL, * CLOSERT * RTFOUND * CVRcheck3 return values: * CV_SUCCESS * CV_RTFUNC_FAIL, * RTFOUND * CVRootfind return values: * CV_SUCCESS * CV_RTFUNC_FAIL, * RTFOUND */ #define RTFOUND +1 #define CLOSERT +3 /* * Control constants for tolerances * -------------------------------- */ #define CV_NN 0 #define CV_SS 1 #define CV_SV 2 #define CV_WF 3 /* * Algorithmic constants * --------------------- * * CVodeGetDky and CVStep * * FUZZ_FACTOR * * CVHin * * HLB_FACTOR * HUB_FACTOR * H_BIAS * MAX_ITERS * * CVodeCreate * * CORTES * * CVStep * * THRESH * ETAMX1 * ETAMX2 * ETAMX3 * ETAMXF * ETAMIN * ETACF * ADDON * BIAS1 * BIAS2 * BIAS3 * ONEPSM * * SMALL_NST nst > SMALL_NST => use ETAMX3 * MXNCF max no. of convergence failures during one step try * MXNEF max no. of error test failures during one step try * MXNEF1 max no. of error test failures before forcing a reduction of order * SMALL_NEF if an error failure occurs and SMALL_NEF <= nef <= MXNEF1, then * reset eta = MIN(eta, ETAMXF) * LONG_WAIT number of steps to wait before considering an order change when * q==1 and MXNEF1 error test failures have occurred * * CVNls * * NLS_MAXCOR maximum no. of corrector iterations for the nonlinear solver * CRDOWN constant used in the estimation of the convergence rate (crate) * of the iterates for the nonlinear equation * DGMAX iter == CV_NEWTON, |gamma/gammap-1| > DGMAX => call lsetup * RDIV declare divergence if ratio del/delp > RDIV * MSBP max no. of steps between lsetup calls * */ #define FUZZ_FACTOR RCONST(100.0) #define HLB_FACTOR RCONST(100.0) #define HUB_FACTOR RCONST(0.1) #define H_BIAS HALF #define MAX_ITERS 4 #define CORTES RCONST(0.1) #define THRESH RCONST(1.5) #define ETAMX1 RCONST(10000.0) #define ETAMX2 RCONST(10.0) #define ETAMX3 RCONST(10.0) #define ETAMXF RCONST(0.2) #define ETAMIN RCONST(0.1) #define ETACF RCONST(0.25) #define ADDON RCONST(0.000001) #define BIAS1 RCONST(6.0) #define BIAS2 RCONST(6.0) #define BIAS3 RCONST(10.0) #define ONEPSM RCONST(1.000001) #define SMALL_NST 10 #define MXNCF 10 #define MXNEF 7 #define MXNEF1 3 #define SMALL_NEF 2 #define LONG_WAIT 10 #define NLS_MAXCOR 3 #define CRDOWN RCONST(0.3) #define DGMAX RCONST(0.3) #define RDIV TWO #define MSBP 20 /*=================================================================*/ /* Private Helper Functions Prototypes */ /*=================================================================*/ static booleantype CVCheckNvector(N_Vector tmpl); static int CVInitialSetup(CVodeMem cv_mem); static booleantype CVAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void CVFreeVectors(CVodeMem cv_mem); static int CVEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int CVEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int CVHin(CVodeMem cv_mem, realtype tout); static realtype CVUpperBoundH0(CVodeMem cv_mem, realtype tdist); static int CVYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm); static int CVStep(CVodeMem cv_mem); static int CVsldet(CVodeMem cv_mem); static void CVAdjustParams(CVodeMem cv_mem); static void CVAdjustOrder(CVodeMem cv_mem, int deltaq); static void CVAdjustAdams(CVodeMem cv_mem, int deltaq); static void CVAdjustBDF(CVodeMem cv_mem, int deltaq); static void CVIncreaseBDF(CVodeMem cv_mem); static void CVDecreaseBDF(CVodeMem cv_mem); static void CVRescale(CVodeMem cv_mem); static void CVPredict(CVodeMem cv_mem); static void CVSet(CVodeMem cv_mem); static void CVSetAdams(CVodeMem cv_mem); static realtype CVAdamsStart(CVodeMem cv_mem, realtype m[]); static void CVAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum); static realtype CVAltSum(int iend, realtype a[], int k); static void CVSetBDF(CVodeMem cv_mem); static void CVSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv); static int CVNls(CVodeMem cv_mem, int nflag); static int CVNlsFunctional(CVodeMem cv_mem); static int CVNlsNewton(CVodeMem cv_mem, int nflag); static int CVNewtonIteration(CVodeMem cv_mem); static int CVHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr); static void CVRestore(CVodeMem cv_mem, realtype saved_t); static int CVDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *nefPtr, realtype *dsmPtr); static void CVCompleteStep(CVodeMem cv_mem); static void CVPrepareNextStep(CVodeMem cv_mem, realtype dsm); static void CVSetEta(CVodeMem cv_mem); static realtype CVComputeEtaqm1(CVodeMem cv_mem); static realtype CVComputeEtaqp1(CVodeMem cv_mem); static void CVChooseEta(CVodeMem cv_mem); static void CVBDFStab(CVodeMem cv_mem); static int CVHandleFailure(CVodeMem cv_mem,int flag); static int CVRcheck1(CVodeMem cv_mem); static int CVRcheck2(CVodeMem cv_mem); static int CVRcheck3(CVodeMem cv_mem); static int CVRootfind(CVodeMem cv_mem); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * CVodeCreate * * CVodeCreate creates an internal memory block for a problem to * be solved by CVODE. * If successful, CVodeCreate returns a pointer to the problem memory. * This pointer should be passed to CVodeInit. * If an initialization error occurs, CVodeCreate prints an error * message to standard err and returns NULL. */ void *CVodeCreate(int lmm, int iter) { int maxord; CVodeMem cv_mem; /* Test inputs */ if ((lmm != CV_ADAMS) && (lmm != CV_BDF)) { CVProcessError(NULL, 0, "CVODE", "CVodeCreate", MSGCV_BAD_LMM); return(NULL); } if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { CVProcessError(NULL, 0, "CVODE", "CVodeCreate", MSGCV_BAD_ITER); return(NULL); } cv_mem = NULL; cv_mem = (CVodeMem) malloc(sizeof(struct CVodeMemRec)); if (cv_mem == NULL) { CVProcessError(NULL, 0, "CVODE", "CVodeCreate", MSGCV_CVMEM_FAIL); return(NULL); } /* Zero out cv_mem */ memset(cv_mem, 0, sizeof(struct CVodeMemRec)); maxord = (lmm == CV_ADAMS) ? ADAMS_Q_MAX : BDF_Q_MAX; /* copy input parameters into cv_mem */ cv_mem->cv_lmm = lmm; cv_mem->cv_iter = iter; /* Set uround */ cv_mem->cv_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ cv_mem->cv_f = NULL; cv_mem->cv_user_data = NULL; cv_mem->cv_itol = CV_NN; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = NULL; cv_mem->cv_e_data = NULL; cv_mem->cv_ehfun = CVErrHandler; cv_mem->cv_eh_data = cv_mem; cv_mem->cv_errfp = stderr; cv_mem->cv_qmax = maxord; cv_mem->cv_mxstep = MXSTEP_DEFAULT; cv_mem->cv_mxhnil = MXHNIL_DEFAULT; cv_mem->cv_sldeton = FALSE; cv_mem->cv_hin = ZERO; cv_mem->cv_hmin = HMIN_DEFAULT; cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; cv_mem->cv_tstopset = FALSE; cv_mem->cv_maxcor = NLS_MAXCOR; cv_mem->cv_maxnef = MXNEF; cv_mem->cv_maxncf = MXNCF; cv_mem->cv_nlscoef = CORTES; /* Initialize root finding variables */ cv_mem->cv_glo = NULL; cv_mem->cv_ghi = NULL; cv_mem->cv_grout = NULL; cv_mem->cv_iroots = NULL; cv_mem->cv_rootdir = NULL; cv_mem->cv_gfun = NULL; cv_mem->cv_nrtfn = 0; cv_mem->cv_gactive = NULL; cv_mem->cv_mxgnull = 1; /* Set the saved value qmax_alloc */ cv_mem->cv_qmax_alloc = maxord; /* Initialize lrw and liw */ cv_mem->cv_lrw = 58 + 2*L_MAX + NUM_TESTS; cv_mem->cv_liw = 40; /* No mallocs have been done yet */ cv_mem->cv_VabstolMallocDone = FALSE; cv_mem->cv_MallocDone = FALSE; /* Return pointer to CVODE memory block */ return((void *)cv_mem); } /*-----------------------------------------------------------------*/ #define iter (cv_mem->cv_iter) #define lmm (cv_mem->cv_lmm) #define lrw (cv_mem->cv_lrw) #define liw (cv_mem->cv_liw) /*-----------------------------------------------------------------*/ /* * CVodeInit * * CVodeInit allocates and initializes memory for a problem. All * problem inputs are checked for errors. If any error occurs during * initialization, it is reported to the file whose file pointer is * errfp and an error flag is returned. Otherwise, it returns CV_SUCCESS */ int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0) { CVodeMem cv_mem; booleantype nvectorOK, allocOK; long int lrw1, liw1; int i,k; /* Check cvode_mem */ if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check for legal input parameters */ if (y0==NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } if (f == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeInit", MSGCV_NULL_F); return(CV_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = CVCheckNvector(y0); if(!nvectorOK) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeInit", MSGCV_BAD_NVECTOR); return(CV_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (y0->ops->nvspace != NULL) { N_VSpace(y0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } cv_mem->cv_lrw1 = lrw1; cv_mem->cv_liw1 = liw1; /* Allocate the vectors (using y0 as a template) */ allocOK = CVAllocVectors(cv_mem, y0); if (!allocOK) { CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* All error checking is complete at this point */ /* Copy the input parameters into CVODE state */ cv_mem->cv_f = f; cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Set the linear solver addresses to NULL. (We check != NULL later, in CVode, if using CV_NEWTON.) */ cv_mem->cv_linit = NULL; cv_mem->cv_lsetup = NULL; cv_mem->cv_lsolve = NULL; cv_mem->cv_lfree = NULL; cv_mem->cv_lmem = NULL; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ /* NOTE: We do this even if stab lim det was not turned on yet. This way, the user can turn it on at any time */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully initialized */ cv_mem->cv_MallocDone = TRUE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) /*-----------------------------------------------------------------*/ /* * CVodeReInit * * CVodeReInit re-initializes CVODE's memory for a problem, assuming * it has already been allocated in a prior CVodeInit call. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0) { CVodeMem cv_mem; int i,k; /* Check cvode_mem */ if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == FALSE) { CVProcessError(cv_mem, CV_NO_MALLOC, "CVODE", "CVodeReInit", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for legal input parameters */ if (y0 == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeReInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } /* Copy the input parameters into CVODE state */ cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully re-initialized */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to CVode. * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) * which will be called to set the error weight vector. */ int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { CVProcessError(cv_mem, CV_NO_MALLOC, "CVODE", "CVodeSStolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSStolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (abstol < ZERO) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSStolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_reltol = reltol; cv_mem->cv_Sabstol = abstol; cv_mem->cv_itol = CV_SS; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = CVEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { CVProcessError(cv_mem, CV_NO_MALLOC, "CVODE", "CVodeSVtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSVtolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeSVtolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(cv_mem->cv_VabstolMallocDone) ) { cv_mem->cv_Vabstol = N_VClone(cv_mem->cv_ewt); lrw += lrw1; liw += liw1; cv_mem->cv_VabstolMallocDone = TRUE; } cv_mem->cv_reltol = reltol; N_VScale(ONE, abstol, cv_mem->cv_Vabstol); cv_mem->cv_itol = CV_SV; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = CVEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun) { CVodeMem cv_mem; if (cvode_mem==NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeWFtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { CVProcessError(cv_mem, CV_NO_MALLOC, "CVODE", "CVodeWFtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } cv_mem->cv_itol = CV_WF; cv_mem->cv_user_efun = TRUE; cv_mem->cv_efun = efun; cv_mem->cv_e_data = NULL; /* will be set to user_data in InitialSetup */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define gfun (cv_mem->cv_gfun) #define glo (cv_mem->cv_glo) #define ghi (cv_mem->cv_ghi) #define grout (cv_mem->cv_grout) #define iroots (cv_mem->cv_iroots) #define rootdir (cv_mem->cv_rootdir) #define gactive (cv_mem->cv_gactive) /*-----------------------------------------------------------------*/ /* * CVodeRootInit * * CVodeRootInit initializes a rootfinding problem to be solved * during the integration of the ODE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is CV_SUCCESS = 0 if no errors * occurred, or a negative value otherwise. */ int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g) { CVodeMem cv_mem; int i, nrt; /* Check cvode_mem pointer */ if (cvode_mem == NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeRootInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning CVodeRootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != cv_mem->cv_nrtfn) && (cv_mem->cv_nrtfn > 0)) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; lrw -= 3 * (cv_mem->cv_nrtfn); liw -= 3 * (cv_mem->cv_nrtfn); } /* If CVodeRootInit() was called with nrtfn == 0, then set cv_nrtfn to zero and cv_gfun to NULL before returning */ if (nrt == 0) { cv_mem->cv_nrtfn = nrt; gfun = NULL; return(CV_SUCCESS); } /* If rerunning CVodeRootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == cv_mem->cv_nrtfn) { if (g != gfun) { if (g == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; lrw -= 3*nrt; liw -= 3*nrt; CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else { gfun = g; return(CV_SUCCESS); } } else return(CV_SUCCESS); } /* Set variable values in CVode memory block */ cv_mem->cv_nrtfn = nrt; if (g == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else gfun = g; /* Allocate necessary memory and return */ glo = NULL; glo = (realtype *) malloc(nrt*sizeof(realtype)); if (glo == NULL) { CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } ghi = NULL; ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (ghi == NULL) { free(glo); glo = NULL; CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } grout = NULL; grout = (realtype *) malloc(nrt*sizeof(realtype)); if (grout == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } iroots = NULL; iroots = (int *) malloc(nrt*sizeof(int)); if (iroots == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } rootdir = NULL; rootdir = (int *) malloc(nrt*sizeof(int)); if (rootdir == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; CVProcessError(cv_mem, CV_MEM_FAIL, "CVODE", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } gactive = NULL; gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (gactive == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; CVProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; icv_f) #define user_data (cv_mem->cv_user_data) #define efun (cv_mem->cv_efun) #define e_data (cv_mem->cv_e_data) #define qmax (cv_mem->cv_qmax) #define mxstep (cv_mem->cv_mxstep) #define mxhnil (cv_mem->cv_mxhnil) #define sldeton (cv_mem->cv_sldeton) #define hin (cv_mem->cv_hin) #define hmin (cv_mem->cv_hmin) #define hmax_inv (cv_mem->cv_hmax_inv) #define tstop (cv_mem->cv_tstop) #define tstopset (cv_mem->cv_tstopset) #define maxnef (cv_mem->cv_maxnef) #define maxncf (cv_mem->cv_maxncf) #define maxcor (cv_mem->cv_maxcor) #define nlscoef (cv_mem->cv_nlscoef) #define itol (cv_mem->cv_itol) #define reltol (cv_mem->cv_reltol) #define Sabstol (cv_mem->cv_Sabstol) #define Vabstol (cv_mem->cv_Vabstol) #define uround (cv_mem->cv_uround) #define zn (cv_mem->cv_zn) #define ewt (cv_mem->cv_ewt) #define y (cv_mem->cv_y) #define acor (cv_mem->cv_acor) #define tempv (cv_mem->cv_tempv) #define ftemp (cv_mem->cv_ftemp) #define q (cv_mem->cv_q) #define qprime (cv_mem->cv_qprime) #define next_q (cv_mem->cv_next_q) #define qwait (cv_mem->cv_qwait) #define L (cv_mem->cv_L) #define h (cv_mem->cv_h) #define hprime (cv_mem->cv_hprime) #define next_h (cv_mem->cv_next_h) #define eta (cv_mem->cv_eta) #define etaqm1 (cv_mem->cv_etaqm1) #define etaq (cv_mem->cv_etaq) #define etaqp1 (cv_mem->cv_etaqp1) #define nscon (cv_mem->cv_nscon) #define hscale (cv_mem->cv_hscale) #define tn (cv_mem->cv_tn) #define tau (cv_mem->cv_tau) #define tq (cv_mem->cv_tq) #define l (cv_mem->cv_l) #define rl1 (cv_mem->cv_rl1) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define crate (cv_mem->cv_crate) #define acnrm (cv_mem->cv_acnrm) #define mnewt (cv_mem->cv_mnewt) #define etamax (cv_mem->cv_etamax) #define nst (cv_mem->cv_nst) #define nfe (cv_mem->cv_nfe) #define ncfn (cv_mem->cv_ncfn) #define netf (cv_mem->cv_netf) #define nni (cv_mem->cv_nni) #define nsetups (cv_mem->cv_nsetups) #define nhnil (cv_mem->cv_nhnil) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define qu (cv_mem->cv_qu) #define nstlp (cv_mem->cv_nstlp) #define h0u (cv_mem->cv_h0u) #define hu (cv_mem->cv_hu) #define saved_tq5 (cv_mem->cv_saved_tq5) #define indx_acor (cv_mem->cv_indx_acor) #define jcur (cv_mem->cv_jcur) #define tolsf (cv_mem->cv_tolsf) #define setupNonNull (cv_mem->cv_setupNonNull) #define nor (cv_mem->cv_nor) #define ssdat (cv_mem->cv_ssdat) #define nrtfn (cv_mem->cv_nrtfn) #define tlo (cv_mem->cv_tlo) #define thi (cv_mem->cv_thi) #define tretlast (cv_mem->cv_tretlast) #define toutc (cv_mem->cv_toutc) #define trout (cv_mem->cv_trout) #define ttol (cv_mem->cv_ttol) #define taskc (cv_mem->cv_taskc) #define irfnd (cv_mem->cv_irfnd) #define nge (cv_mem->cv_nge) /*-----------------------------------------------------------------*/ /* * CVode * * This routine is the main driver of the CVODE package. * * It integrates over a time interval defined by the user, by calling * CVStep to do internal time steps. * * The first time that CVode is called for a successfully initialized * problem, it computes a tentative initial step size h. * * CVode supports two modes, specified by itask: CV_NORMAL, CV_ONE_STEP. * In the CV_NORMAL mode, the solver steps until it reaches or passes tout * and then interpolates to obtain y(tout). * In the CV_ONE_STEP mode, it takes one internal step and returns. */ int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask) { CVodeMem cv_mem; long int nstloc; int retval, hflag, kflag, istate, ir, ier, irfndp; int ewtsetOK; realtype troundoff, tout_hin, rh, nrm; booleantype inactive_roots; /* * ------------------------------------- * 1. Check and process inputs * ------------------------------------- */ /* Check if cvode_mem exists */ if (cvode_mem == NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVode", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == FALSE) { CVProcessError(cv_mem, CV_NO_MALLOC, "CVODE", "CVode", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for yout != NULL */ if ((y = yout) == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_YOUT_NULL); return(CV_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_TRET_NULL); return(CV_ILL_INPUT); } /* Check for valid itask */ if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_BAD_ITASK); return(CV_ILL_INPUT); } if (itask == CV_NORMAL) toutc = tout; taskc = itask; /* * ---------------------------------------- * 2. Initializations performed only at * the first step (nst=0): * - initial setup * - initialize Nordsieck history array * - compute initial step size * - check for approach to tstop * - check for approach to a root * ---------------------------------------- */ if (nst == 0) { ier = CVInitialSetup(cv_mem); if (ier!= CV_SUCCESS) return(ier); /* Call f at (t0,y0), set zn[1] = y'(t0), set initial h (from H0 or CVHin), and scale zn[1] by h. Also check for zeros of root function g at and near t0. */ retval = f(tn, zn[0], zn[1], user_data); nfe++; if (retval < 0) { CVProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODE", "CVode", MSGCV_RHSFUNC_FAILED, tn); return(CV_RHSFUNC_FAIL); } if (retval > 0) { CVProcessError(cv_mem, CV_FIRST_RHSFUNC_ERR, "CVODE", "CVode", MSGCV_RHSFUNC_FIRST); return(CV_FIRST_RHSFUNC_ERR); } /* Set initial h (from H0 or CVHin). */ h = hin; if ( (h != ZERO) && ((tout-tn)*h < ZERO) ) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_BAD_H0); return(CV_ILL_INPUT); } if (h == ZERO) { tout_hin = tout; if ( tstopset && (tout-tn)*(tout-tstop) > 0 ) tout_hin = tstop; hflag = CVHin(cv_mem, tout_hin); if (hflag != CV_SUCCESS) { istate = CVHandleFailure(cv_mem, hflag); return(istate); } } rh = ABS(h)*hmax_inv; if (rh > ONE) h /= rh; if (ABS(h) < hmin) h *= hmin/ABS(h); /* Check for approach to tstop */ if (tstopset) { if ( (tstop - tn)*h < ZERO ) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_BAD_TSTOP, tstop, tn); return(CV_ILL_INPUT); } if ( (tn + h - tstop)*h > ZERO ) h = (tstop - tn)*(ONE-FOUR*uround); } /* Scale zn[1] by h.*/ hscale = h; h0u = h; hprime = h; N_VScale(h, zn[1], zn[1]); /* Check for zeros of root function g at and near t0. */ if (nrtfn > 0) { retval = CVRcheck1(cv_mem); if (retval == CV_RTFUNC_FAIL) { CVProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODE", "CVRcheck1", MSGCV_RTFUNC_FAILED, tn); return(CV_RTFUNC_FAIL); } } } /* end of first call block */ /* * ------------------------------------------------------ * 3. At following steps, perform stop tests: * - check for root in last step * - check if we passed tstop * - check if we passed tout (NORMAL mode) * - check if current tn was returned (ONE_STEP mode) * - check if we are close to tstop * (adjust step size if needed) * ------------------------------------------------------- */ if (nst > 0) { /* Estimate an infinitesimal time interval to be used as a roundoff for time quantities (based on current time and step size) */ troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); /* First, check for a root in the last step taken, other than the last root found, if any. If itask = CV_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (nrtfn > 0) { irfndp = irfnd; retval = CVRcheck2(cv_mem); if (retval == CLOSERT) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVRcheck2", MSGCV_CLOSE_ROOTS, tlo); return(CV_ILL_INPUT); } else if (retval == CV_RTFUNC_FAIL) { CVProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODE", "CVRcheck2", MSGCV_RTFUNC_FAILED, tlo); return(CV_RTFUNC_FAIL); } else if (retval == RTFOUND) { tretlast = *tret = tlo; return(CV_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ if ( ABS(tn - tretlast) > troundoff ) { retval = CVRcheck3(cv_mem); if (retval == CV_SUCCESS) { /* no root found */ irfnd = 0; if ((irfndp == 1) && (itask == CV_ONE_STEP)) { tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); return(CV_SUCCESS); } } else if (retval == RTFOUND) { /* a new root was found */ irfnd = 1; tretlast = *tret = tlo; return(CV_ROOT_RETURN); } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ CVProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODE", "CVRcheck3", MSGCV_RTFUNC_FAILED, tlo); return(CV_RTFUNC_FAIL); } } } /* end of root stop check */ /* In CV_NORMAL mode, test if tout was reached */ if ( (itask == CV_NORMAL) && ((tn-tout)*h >= ZERO) ) { tretlast = *tret = tout; ier = CVodeGetDky(cv_mem, tout, 0, yout); if (ier != CV_SUCCESS) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_BAD_TOUT, tout); return(CV_ILL_INPUT); } return(CV_SUCCESS); } /* In CV_ONE_STEP mode, test if tn was returned */ if ( itask == CV_ONE_STEP && ABS(tn - tretlast) > troundoff ) { tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); return(CV_SUCCESS); } /* Test for tn at tstop or near tstop */ if ( tstopset ) { if ( ABS(tn - tstop) <= troundoff) { ier = CVodeGetDky(cv_mem, tstop, 0, yout); if (ier != CV_SUCCESS) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_BAD_TSTOP, tstop, tn); return(CV_ILL_INPUT); } tretlast = *tret = tstop; tstopset = FALSE; return(CV_TSTOP_RETURN); } /* If next step would overtake tstop, adjust stepsize */ if ( (tn + hprime - tstop)*h > ZERO ) { hprime = (tstop - tn)*(ONE-FOUR*uround); eta = hprime/h; } } } /* end stopping tests block */ /* * -------------------------------------------------- * 4. Looping point for internal steps * * 4.1. check for errors (too many steps, too much * accuracy requested, step size too small) * 4.2. take a new step (call CVStep) * 4.3. stop on error * 4.4. perform stop tests: * - check for root in last step * - check if tout was passed * - check if close to tstop * - check if in ONE_STEP mode (must return) * -------------------------------------------------- */ nstloc = 0; loop { next_h = h; next_q = q; /* Reset and check ewt */ if (nst > 0) { ewtsetOK = efun(zn[0], ewt, e_data); if (ewtsetOK != 0) { if (itol == CV_WF) CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_EWT_NOW_FAIL, tn); else CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVode", MSGCV_EWT_NOW_BAD, tn); istate = CV_ILL_INPUT; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } } /* Check for too many steps */ if ( (mxstep>0) && (nstloc >= mxstep) ) { CVProcessError(cv_mem, CV_TOO_MUCH_WORK, "CVODE", "CVode", MSGCV_MAX_STEPS, tn); istate = CV_TOO_MUCH_WORK; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } /* Check for too much accuracy requested */ nrm = N_VWrmsNorm(zn[0], ewt); tolsf = uround * nrm; if (tolsf > ONE) { CVProcessError(cv_mem, CV_TOO_MUCH_ACC, "CVODE", "CVode", MSGCV_TOO_MUCH_ACC, tn); istate = CV_TOO_MUCH_ACC; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); tolsf *= TWO; break; } else { tolsf = ONE; } /* Check for h below roundoff level in tn */ if (tn + h == tn) { nhnil++; if (nhnil <= mxhnil) CVProcessError(cv_mem, CV_WARNING, "CVODE", "CVode", MSGCV_HNIL, tn, h); if (nhnil == mxhnil) CVProcessError(cv_mem, CV_WARNING, "CVODE", "CVode", MSGCV_HNIL_DONE); } /* Call CVStep to take a step */ kflag = CVStep(cv_mem); /* Process failed step cases, and exit loop */ if (kflag != CV_SUCCESS) { istate = CVHandleFailure(cv_mem, kflag); tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } nstloc++; /* Check for root in last step taken. */ if (nrtfn > 0) { retval = CVRcheck3(cv_mem); if (retval == RTFOUND) { /* A new root was found */ irfnd = 1; istate = CV_ROOT_RETURN; tretlast = *tret = tlo; break; } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ CVProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODE", "CVRcheck3", MSGCV_RTFUNC_FAILED, tlo); istate = CV_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (nst==1) { inactive_roots = FALSE; for (ir=0; ircv_mxgnull > 0) && inactive_roots) { CVProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_INACTIVE_ROOTS); } } } /* In NORMAL mode, check if tout reached */ if ( (itask == CV_NORMAL) && (tn-tout)*h >= ZERO ) { istate = CV_SUCCESS; tretlast = *tret = tout; (void) CVodeGetDky(cv_mem, tout, 0, yout); next_q = qprime; next_h = hprime; break; } /* Check if tn is at tstop or near tstop */ if ( tstopset ) { troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); if ( ABS(tn - tstop) <= troundoff) { (void) CVodeGetDky(cv_mem, tstop, 0, yout); tretlast = *tret = tstop; tstopset = FALSE; istate = CV_TSTOP_RETURN; break; } if ( (tn + hprime - tstop)*h > ZERO ) { hprime = (tstop - tn)*(ONE-FOUR*uround); eta = hprime/h; } } /* In ONE_STEP mode, copy y and exit loop */ if (itask == CV_ONE_STEP) { istate = CV_SUCCESS; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); next_q = qprime; next_h = hprime; break; } } /* end looping for internal steps */ return(istate); } /*-----------------------------------------------------------------*/ /* * CVodeGetDky * * This routine computes the k-th derivative of the interpolating * polynomial at the time t and stores the result in the vector dky. * The formula is: * q * dky = SUM c(j,k) * (t - tn)^(j-k) * h^(-j) * zn[j] , * j=k * where c(j,k) = j*(j-1)*...*(j-k+1), q is the current order, and * zn[j] is the j-th column of the Nordsieck history array. * * This function is called by CVode with k = 0 and t = tout, but * may also be called directly by the user. */ int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky) { realtype s, c, r; realtype tfuzz, tp, tn1; int i, j; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { CVProcessError(NULL, CV_MEM_NULL, "CVODE", "CVodeGetDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dky == NULL) { CVProcessError(cv_mem, CV_BAD_DKY, "CVODE", "CVodeGetDky", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > q)) { CVProcessError(cv_mem, CV_BAD_K, "CVODE", "CVodeGetDky", MSGCV_BAD_K); return(CV_BAD_K); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); if (hu < ZERO) tfuzz = -tfuzz; tp = tn - hu - tfuzz; tn1 = tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { CVProcessError(cv_mem, CV_BAD_T, "CVODE", "CVodeGetDky", MSGCV_BAD_T, t, tn-hu, tn); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ s = (t - tn) / h; for (j=q; j >= k; j--) { c = ONE; for (i=j; i >= j-k+1; i--) c *= i; if (j == q) { N_VScale(c, zn[q], dky); } else { N_VLinearSum(c, zn[j], s, dky, dky); } } if (k == 0) return(CV_SUCCESS); r = RPowerI(h,-k); N_VScale(r, dky, dky); return(CV_SUCCESS); } /* * CVodeFree * * This routine frees the problem memory allocated by CVodeInit. * Such memory includes all the vectors allocated by CVAllocVectors, * and the memory lmem for the linear solver (deallocated by a call * to lfree). */ void CVodeFree(void **cvode_mem) { CVodeMem cv_mem; if (*cvode_mem == NULL) return; cv_mem = (CVodeMem) (*cvode_mem); CVFreeVectors(cv_mem); if (iter == CV_NEWTON && lfree != NULL) lfree(cv_mem); if (nrtfn > 0) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; } free(*cvode_mem); *cvode_mem = NULL; } /* * ================================================================= * Private Functions Implementation * ================================================================= */ /* * CVCheckNvector * This routine checks if all required vector operations are present. * If any of them is missing it returns FALSE. */ static booleantype CVCheckNvector(N_Vector tmpl) { if((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvdiv == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvmaxnorm == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(FALSE); else return(TRUE); } /* * CVAllocVectors * * This routine allocates the CVODE vectors ewt, acor, tempv, ftemp, and * zn[0], ..., zn[maxord]. * If all memory allocations are successful, CVAllocVectors returns TRUE. * Otherwise all allocated memory is freed and CVAllocVectors returns FALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype CVAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ewt, acor, tempv, ftemp */ ewt = N_VClone(tmpl); if (ewt == NULL) return(FALSE); acor = N_VClone(tmpl); if (acor == NULL) { N_VDestroy(ewt); return(FALSE); } tempv = N_VClone(tmpl); if (tempv == NULL) { N_VDestroy(ewt); N_VDestroy(acor); return(FALSE); } ftemp = N_VClone(tmpl); if (ftemp == NULL) { N_VDestroy(tempv); N_VDestroy(ewt); N_VDestroy(acor); return(FALSE); } /* Allocate zn[0] ... zn[qmax] */ for (j=0; j <= qmax; j++) { zn[j] = N_VClone(tmpl); if (zn[j] == NULL) { N_VDestroy(ewt); N_VDestroy(acor); N_VDestroy(tempv); N_VDestroy(ftemp); for (i=0; i < j; i++) N_VDestroy(zn[i]); return(FALSE); } } /* Update solver workspace lengths */ lrw += (qmax + 5)*lrw1; liw += (qmax + 5)*liw1; /* Store the value of qmax used here */ cv_mem->cv_qmax_alloc = qmax; return(TRUE); } /* * CVFreeVectors * * This routine frees the CVODE vectors allocated in CVAllocVectors. */ static void CVFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_alloc; N_VDestroy(ewt); N_VDestroy(acor); N_VDestroy(tempv); N_VDestroy(ftemp); for(j=0; j <= maxord; j++) N_VDestroy(zn[j]); lrw -= (maxord + 5)*lrw1; liw -= (maxord + 5)*liw1; if (cv_mem->cv_VabstolMallocDone) { N_VDestroy(Vabstol); lrw -= lrw1; liw -= liw1; } } /* * CVInitialSetup * * This routine performs input consistency checks at the first step. * If needed, it also checks the linear solver module and calls the * linear solver initialization routine. */ static int CVInitialSetup(CVodeMem cv_mem) { int ier; /* Did the user specify tolerances? */ if (itol == CV_NN) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVInitialSetup", MSGCV_NO_TOLS); return(CV_ILL_INPUT); } /* Set data for efun */ if (cv_mem->cv_user_efun) e_data = user_data; else e_data = cv_mem; /* Load initial error weights */ ier = efun(zn[0], ewt, e_data); if (ier != 0) { if (itol == CV_WF) CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVInitialSetup", MSGCV_EWT_FAIL); else CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVInitialSetup", MSGCV_BAD_EWT); return(CV_ILL_INPUT); } /* Check if lsolve function exists (if needed) and call linit function (if it exists) */ if (iter == CV_NEWTON) { if (lsolve == NULL) { CVProcessError(cv_mem, CV_ILL_INPUT, "CVODE", "CVInitialSetup", MSGCV_LSOLVE_NULL); return(CV_ILL_INPUT); } if (linit != NULL) { ier = linit(cv_mem); if (ier != 0) { CVProcessError(cv_mem, CV_LINIT_FAIL, "CVODE", "CVInitialSetup", MSGCV_LINIT_FAIL); return(CV_LINIT_FAIL); } } } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * PRIVATE FUNCTIONS FOR CVODE * ----------------------------------------------------------------- */ /* * CVHin * * This routine computes a tentative initial step size h0. * If tout is too close to tn (= t0), then CVHin returns CV_TOO_CLOSE * and h remains uninitialized. Note that here tout is either the value * passed to CVode at the first call or the value of tstop (if tstop is * enabled and it is closer to t0=tn than tout). * If the RHS function fails unrecoverably, CVHin returns CV_RHSFUNC_FAIL. * If the RHS function fails recoverably too many times and recovery is * not possible, CVHin returns CV_REPTD_RHSFUNC_ERR. * Otherwise, CVHin sets h to the chosen value h0 and returns CV_SUCCESS. * * The algorithm used seeks to find h0 as a solution of * (WRMS norm of (h0^2 ydd / 2)) = 1, * where ydd = estimated second derivative of y. * * We start with an initial estimate equal to the geometric mean of the * lower and upper bounds on the step size. * * Loop up to MAX_ITERS times to find h0. * Stop if new and previous values differ by a factor < 2. * Stop if hnew/hg > 2 after one iteration, as this probably means * that the ydd value is bad because of cancellation error. * * For each new proposed hg, we allow MAX_ITERS attempts to * resolve a possible recoverable failure from f() by reducing * the proposed stepsize by a factor of 0.2. If a legal stepsize * still cannot be found, fall back on a previous value if possible, * or else return CV_REPTD_RHSFUNC_ERR. * * Finally, we apply a bias (0.5) and verify that h0 is within bounds. */ static int CVHin(CVodeMem cv_mem, realtype tout) { int retval, sign, count1, count2; realtype tdiff, tdist, tround, hlb, hub; realtype hg, hgs, hs, hnew, hrat, h0, yddnrm; booleantype hgOK, hnewOK; /* If tout is too close to tn, give up */ if ((tdiff = tout-tn) == ZERO) return(CV_TOO_CLOSE); sign = (tdiff > ZERO) ? 1 : -1; tdist = ABS(tdiff); tround = uround * MAX(ABS(tn), ABS(tout)); if (tdist < TWO*tround) return(CV_TOO_CLOSE); /* Set lower and upper bounds on h0, and take geometric mean as first trial value. Exit with this value if the bounds cross each other. */ hlb = HLB_FACTOR * tround; hub = CVUpperBoundH0(cv_mem, tdist); hg = RSqrt(hlb*hub); if (hub < hlb) { if (sign == -1) h = -hg; else h = hg; return(CV_SUCCESS); } /* Outer loop */ hnewOK = FALSE; hs = hg; /* safeguard against 'uninitialized variable' warning */ for(count1 = 1; count1 <= MAX_ITERS; count1++) { /* Attempts to estimate ydd */ hgOK = FALSE; for (count2 = 1; count2 <= MAX_ITERS; count2++) { hgs = hg*sign; retval = CVYddNorm(cv_mem, hgs, &yddnrm); /* If f() failed unrecoverably, give up */ if (retval < 0) return(CV_RHSFUNC_FAIL); /* If successful, we can use ydd */ if (retval == CV_SUCCESS) {hgOK = TRUE; break;} /* f() failed recoverably; cut step size and test it again */ hg *= POINT2; } /* If f() failed recoverably MAX_ITERS times */ if (!hgOK) { /* Exit if this is the first or second pass. No recovery possible */ if (count1 <= 2) return(CV_REPTD_RHSFUNC_ERR); /* We have a fall-back option. The value hs is a previous hnew which passed through f(). Use it and break */ hnew = hs; break; } /* The proposed step size is feasible. Save it. */ hs = hg; /* If the stopping criteria was met, or if this is the last pass, stop */ if ( (hnewOK) || (count1 == MAX_ITERS)) {hnew = hg; break;} /* Propose new step size */ hnew = (yddnrm*hub*hub > TWO) ? RSqrt(TWO/yddnrm) : RSqrt(hg*hub); hrat = hnew/hg; /* Accept hnew if it does not differ from hg by more than a factor of 2 */ if ((hrat > HALF) && (hrat < TWO)) { hnewOK = TRUE; } /* After one pass, if ydd seems to be bad, use fall-back value. */ if ((count1 > 1) && (hrat > TWO)) { hnew = hg; hnewOK = TRUE; } /* Send this value back through f() */ hg = hnew; } /* Apply bounds, bias factor, and attach sign */ h0 = H_BIAS*hnew; if (h0 < hlb) h0 = hlb; if (h0 > hub) h0 = hub; if (sign == -1) h0 = -h0; h = h0; return(CV_SUCCESS); } /* * CVUpperBoundH0 * * This routine sets an upper bound on abs(h0) based on * tdist = tn - t0 and the values of y[i]/y'[i]. */ static realtype CVUpperBoundH0(CVodeMem cv_mem, realtype tdist) { realtype hub_inv, hub; N_Vector temp1, temp2; /* * Bound based on |y0|/|y0'| -- allow at most an increase of * HUB_FACTOR in y0 (based on a forward Euler step). The weight * factor is used as a safeguard against zero components in y0. */ temp1 = tempv; temp2 = acor; N_VAbs(zn[0], temp2); efun(zn[0], temp1, e_data); N_VInv(temp1, temp1); N_VLinearSum(HUB_FACTOR, temp2, ONE, temp1, temp1); N_VAbs(zn[1], temp2); N_VDiv(temp2, temp1, temp1); hub_inv = N_VMaxNorm(temp1); /* * bound based on tdist -- allow at most a step of magnitude * HUB_FACTOR * tdist */ hub = HUB_FACTOR*tdist; /* Use the smaler of the two */ if (hub*hub_inv > ONE) hub = ONE/hub_inv; return(hub); } /* * CVYddNorm * * This routine computes an estimate of the second derivative of y * using a difference quotient, and returns its WRMS norm. */ static int CVYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm) { int retval; N_VLinearSum(hg, zn[1], ONE, zn[0], y); retval = f(tn+hg, y, tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); N_VLinearSum(ONE, tempv, -ONE, zn[1], tempv); N_VScale(ONE/hg, tempv, tempv); *yddnrm = N_VWrmsNorm(tempv, ewt); return(CV_SUCCESS); } /* * CVStep * * This routine performs one internal cvode step, from tn to tn + h. * It calls other routines to do all the work. * * The main operations done here are as follows: * - preliminary adjustments if a new step size was chosen; * - prediction of the Nordsieck history array zn at tn + h; * - setting of multistep method coefficients and test quantities; * - solution of the nonlinear system; * - testing the local error; * - updating zn and other state data if successful; * - resetting stepsize and order for the next step. * - if SLDET is on, check for stability, reduce order if necessary. * On a failure in the nonlinear system solution or error test, the * step may be reattempted, depending on the nature of the failure. */ static int CVStep(CVodeMem cv_mem) { realtype saved_t, dsm; int ncf, nef; int nflag, kflag, eflag; saved_t = tn; ncf = nef = 0; nflag = FIRST_CALL; if ((nst > 0) && (hprime != h)) CVAdjustParams(cv_mem); /* Looping point for attempts to take a step */ loop { CVPredict(cv_mem); CVSet(cv_mem); nflag = CVNls(cv_mem, nflag); kflag = CVHandleNFlag(cv_mem, &nflag, saved_t, &ncf); /* Go back in loop if we need to predict again (nflag=PREV_CONV_FAIL)*/ if (kflag == PREDICT_AGAIN) continue; /* Return if nonlinear solve failed and recovery not possible. */ if (kflag != DO_ERROR_TEST) return(kflag); /* Perform error test (nflag=CV_SUCCESS) */ eflag = CVDoErrorTest(cv_mem, &nflag, saved_t, &nef, &dsm); /* Go back in loop if we need to predict again (nflag=PREV_ERR_FAIL) */ if (eflag == TRY_AGAIN) continue; /* Return if error test failed and recovery not possible. */ if (eflag != CV_SUCCESS) return(eflag); /* Error test passed (eflag=CV_SUCCESS), break from loop */ break; } /* Nonlinear system solve and error test were both successful. Update data, and consider change of step and/or order. */ CVCompleteStep(cv_mem); CVPrepareNextStep(cv_mem, dsm); /* If Stablilty Limit Detection is turned on, call stability limit detection routine for possible order reduction. */ if (sldeton) CVBDFStab(cv_mem); etamax = (nst <= SMALL_NST) ? ETAMX2 : ETAMX3; /* Finally, we rescale the acor array to be the estimated local error vector. */ N_VScale(tq[2], acor, acor); return(CV_SUCCESS); } /* * CVAdjustParams * * This routine is called when a change in step size was decided upon, * and it handles the required adjustments to the history array zn. * If there is to be a change in order, we call CVAdjustOrder and reset * q, L = q+1, and qwait. Then in any case, we call CVRescale, which * resets h and rescales the Nordsieck array. */ static void CVAdjustParams(CVodeMem cv_mem) { if (qprime != q) { CVAdjustOrder(cv_mem, qprime-q); q = qprime; L = q+1; qwait = L; } CVRescale(cv_mem); } /* * CVAdjustOrder * * This routine is a high level routine which handles an order * change by an amount deltaq (= +1 or -1). If a decrease in order * is requested and q==2, then the routine returns immediately. * Otherwise CVAdjustAdams or CVAdjustBDF is called to handle the * order change (depending on the value of lmm). */ static void CVAdjustOrder(CVodeMem cv_mem, int deltaq) { if ((q==2) && (deltaq != 1)) return; switch(lmm){ case CV_ADAMS: CVAdjustAdams(cv_mem, deltaq); break; case CV_BDF: CVAdjustBDF(cv_mem, deltaq); break; } } /* * CVAdjustAdams * * This routine adjusts the history array on a change of order q by * deltaq, in the case that lmm == CV_ADAMS. */ static void CVAdjustAdams(CVodeMem cv_mem, int deltaq) { int i, j; realtype xi, hsum; /* On an order increase, set new column of zn to zero and return */ if (deltaq==1) { N_VConst(ZERO, zn[L]); return; } /* * On an order decrease, each zn[j] is adjusted by a multiple of zn[q]. * The coeffs. in the adjustment are the coeffs. of the polynomial: * x * q * INT { u * ( u + xi_1 ) * ... * ( u + xi_{q-2} ) } du * 0 * where xi_j = [t_n - t_(n-j)]/h => xi_0 = 0 */ for (i=0; i <= qmax; i++) l[i] = ZERO; l[1] = ONE; hsum = ZERO; for (j=1; j <= q-2; j++) { hsum += tau[j]; xi = hsum / hscale; for (i=j+1; i >= 1; i--) l[i] = l[i]*xi + l[i-1]; } for (j=1; j <= q-2; j++) l[j+1] = q * (l[j] / (j+1)); for (j=2; j < q; j++) N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); } /* * CVAdjustBDF * * This is a high level routine which handles adjustments to the * history array on a change of order by deltaq in the case that * lmm == CV_BDF. CVAdjustBDF calls CVIncreaseBDF if deltaq = +1 and * CVDecreaseBDF if deltaq = -1 to do the actual work. */ static void CVAdjustBDF(CVodeMem cv_mem, int deltaq) { switch(deltaq) { case 1 : CVIncreaseBDF(cv_mem); return; case -1: CVDecreaseBDF(cv_mem); return; } } /* * CVIncreaseBDF * * This routine adjusts the history array on an increase in the * order q in the case that lmm == CV_BDF. * A new column zn[q+1] is set equal to a multiple of the saved * vector (= acor) in zn[indx_acor]. Then each zn[j] is adjusted by * a multiple of zn[q+1]. The coefficients in the adjustment are the * coefficients of the polynomial x*x*(x+xi_1)*...*(x+xi_j), * where xi_j = [t_n - t_(n-j)]/h. */ static void CVIncreaseBDF(CVodeMem cv_mem) { realtype alpha0, alpha1, prod, xi, xiold, hsum, A1; int i, j; for (i=0; i <= qmax; i++) l[i] = ZERO; l[2] = alpha1 = prod = xiold = ONE; alpha0 = -ONE; hsum = hscale; if (q > 1) { for (j=1; j < q; j++) { hsum += tau[j+1]; xi = hsum / hscale; prod *= xi; alpha0 -= ONE / (j+1); alpha1 += ONE / xi; for (i=j+2; i >= 2; i--) l[i] = l[i]*xiold + l[i-1]; xiold = xi; } } A1 = (-alpha0 - alpha1) / prod; N_VScale(A1, zn[indx_acor], zn[L]); for (j=2; j <= q; j++) { N_VLinearSum(l[j], zn[L], ONE, zn[j], zn[j]); } } /* * CVDecreaseBDF * * This routine adjusts the history array on a decrease in the * order q in the case that lmm == CV_BDF. * Each zn[j] is adjusted by a multiple of zn[q]. The coefficients * in the adjustment are the coefficients of the polynomial * x*x*(x+xi_1)*...*(x+xi_j), where xi_j = [t_n - t_(n-j)]/h. */ static void CVDecreaseBDF(CVodeMem cv_mem) { realtype hsum, xi; int i, j; for (i=0; i <= qmax; i++) l[i] = ZERO; l[2] = ONE; hsum = ZERO; for(j=1; j <= q-2; j++) { hsum += tau[j]; xi = hsum /hscale; for (i=j+2; i >= 2; i--) l[i] = l[i]*xi + l[i-1]; } for(j=2; j < q; j++) N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); } /* * CVRescale * * This routine rescales the Nordsieck array by multiplying the * jth column zn[j] by eta^j, j = 1, ..., q. Then the value of * h is rescaled by eta, and hscale is reset to h. */ static void CVRescale(CVodeMem cv_mem) { int j; realtype factor; factor = eta; for (j=1; j <= q; j++) { N_VScale(factor, zn[j], zn[j]); factor *= eta; } h = hscale * eta; next_h = h; hscale = h; nscon = 0; } /* * CVPredict * * This routine advances tn by the tentative step size h, and computes * the predicted array z_n(0), which is overwritten on zn. The * prediction of zn is done by repeated additions. * If tstop is enabled, it is possible for tn + h to be past tstop by roundoff, * and in that case, we reset tn (after incrementing by h) to tstop. */ static void CVPredict(CVodeMem cv_mem) { int j, k; tn += h; if (tstopset) { if ((tn - tstop)*h > ZERO) tn = tstop; } for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, zn[j-1], ONE, zn[j], zn[j-1]); } /* * CVSet * * This routine is a high level routine which calls CVSetAdams or * CVSetBDF to set the polynomial l, the test quantity array tq, * and the related variables rl1, gamma, and gamrat. * * The array tq is loaded with constants used in the control of estimated * local errors and in the nonlinear convergence test. Specifically, while * running at order q, the components of tq are as follows: * tq[1] = a coefficient used to get the est. local error at order q-1 * tq[2] = a coefficient used to get the est. local error at order q * tq[3] = a coefficient used to get the est. local error at order q+1 * tq[4] = constant used in nonlinear iteration convergence test * tq[5] = coefficient used to get the order q+2 derivative vector used in * the est. local error at order q+1 */ static void CVSet(CVodeMem cv_mem) { switch(lmm) { case CV_ADAMS: CVSetAdams(cv_mem); break; case CV_BDF: CVSetBDF(cv_mem); break; } rl1 = ONE / l[1]; gamma = h * rl1; if (nst == 0) gammap = gamma; gamrat = (nst > 0) ? gamma / gammap : ONE; /* protect x / x != 1.0 */ } /* * CVSetAdams * * This routine handles the computation of l and tq for the * case lmm == CV_ADAMS. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * (d/dx) Lambda(x) = c * PRODUCT (1 + x / xi_i) , where * i=1 * Lambda(-1) = 0, Lambda(0) = 1, and c is a normalization factor. * Here xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void CVSetAdams(CVodeMem cv_mem) { realtype m[L_MAX], M[3], hsum; if (q == 1) { l[0] = l[1] = tq[1] = tq[5] = ONE; tq[2] = HALF; tq[3] = ONE/TWELVE; tq[4] = nlscoef / tq[2]; /* = 0.1 / tq[2] */ return; } hsum = CVAdamsStart(cv_mem, m); M[0] = CVAltSum(q-1, m, 1); M[1] = CVAltSum(q-1, m, 2); CVAdamsFinish(cv_mem, m, M, hsum); } /* * CVAdamsStart * * This routine generates in m[] the coefficients of the product * polynomial needed for the Adams l and tq coefficients for q > 1. */ static realtype CVAdamsStart(CVodeMem cv_mem, realtype m[]) { realtype hsum, xi_inv, sum; int i, j; hsum = h; m[0] = ONE; for (i=1; i <= q; i++) m[i] = ZERO; for (j=1; j < q; j++) { if ((j==q-1) && (qwait == 1)) { sum = CVAltSum(q-2, m, 2); tq[1] = q * sum / m[q-2]; } xi_inv = h / hsum; for (i=j; i >= 1; i--) m[i] += m[i-1] * xi_inv; hsum += tau[j]; /* The m[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } return(hsum); } /* * CVAdamsFinish * * This routine completes the calculation of the Adams l and tq. */ static void CVAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum) { int i; realtype M0_inv, xi, xi_inv; M0_inv = ONE / M[0]; l[0] = ONE; for (i=1; i <= q; i++) l[i] = M0_inv * (m[i-1] / i); xi = hsum / h; xi_inv = ONE / xi; tq[2] = M[1] * M0_inv / xi; tq[5] = xi / l[q]; if (qwait == 1) { for (i=q; i >= 1; i--) m[i] += m[i-1] * xi_inv; M[2] = CVAltSum(q, m, 2); tq[3] = M[2] * M0_inv / L; } tq[4] = nlscoef / tq[2]; } /* * CVAltSum * * CVAltSum returns the value of the alternating sum * sum (i= 0 ... iend) [ (-1)^i * (a[i] / (i + k)) ]. * If iend < 0 then CVAltSum returns 0. * This operation is needed to compute the integral, from -1 to 0, * of a polynomial x^(k-1) M(x) given the coefficients of M(x). */ static realtype CVAltSum(int iend, realtype a[], int k) { int i, sign; realtype sum; if (iend < 0) return(ZERO); sum = ZERO; sign = 1; for (i=0; i <= iend; i++) { sum += sign * (a[i] / (i+k)); sign = -sign; } return(sum); } /* * CVSetBDF * * This routine computes the coefficients l and tq in the case * lmm == CV_BDF. CVSetBDF calls CVSetTqBDF to set the test * quantity array tq. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * Lambda(x) = (1 + x / xi*_q) * PRODUCT (1 + x / xi_i) , where * i=1 * xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void CVSetBDF(CVodeMem cv_mem) { realtype alpha0, alpha0_hat, xi_inv, xistar_inv, hsum; int i,j; l[0] = l[1] = xi_inv = xistar_inv = ONE; for (i=2; i <= q; i++) l[i] = ZERO; alpha0 = alpha0_hat = -ONE; hsum = h; if (q > 1) { for (j=2; j < q; j++) { hsum += tau[j-1]; xi_inv = h / hsum; alpha0 -= ONE / j; for(i=j; i >= 1; i--) l[i] += l[i-1]*xi_inv; /* The l[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } /* j = q */ alpha0 -= ONE / q; xistar_inv = -l[1] - alpha0; hsum += tau[q-1]; xi_inv = h / hsum; alpha0_hat = -l[1] - xi_inv; for (i=q; i >= 1; i--) l[i] += l[i-1]*xistar_inv; } CVSetTqBDF(cv_mem, hsum, alpha0, alpha0_hat, xi_inv, xistar_inv); } /* * CVSetTqBDF * * This routine sets the test quantity array tq in the case * lmm == CV_BDF. */ static void CVSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv) { realtype A1, A2, A3, A4, A5, A6; realtype C, Cpinv, Cppinv; A1 = ONE - alpha0_hat + alpha0; A2 = ONE + q * A1; tq[2] = ABS(A1 / (alpha0 * A2)); tq[5] = ABS(A2 * xistar_inv / (l[q] * xi_inv)); if (qwait == 1) { if (q > 1) { C = xistar_inv / l[q]; A3 = alpha0 + ONE / q; A4 = alpha0_hat + xi_inv; Cpinv = (ONE - A4 + A3) / A3; tq[1] = ABS(C * Cpinv); } else tq[1] = ONE; hsum += tau[q]; xi_inv = h / hsum; A5 = alpha0 - (ONE / (q+1)); A6 = alpha0_hat - xi_inv; Cppinv = (ONE - A6 + A5) / A2; tq[3] = ABS(Cppinv / (xi_inv * (q+2) * A5)); } tq[4] = nlscoef / tq[2]; } /* * CVNls * * This routine attempts to solve the nonlinear system associated * with a single implicit step of the linear multistep method. * Depending on iter, it calls CVNlsFunctional or CVNlsNewton * to do the work. */ static int CVNls(CVodeMem cv_mem, int nflag) { int flag = CV_SUCCESS; switch(iter) { case CV_FUNCTIONAL: flag = CVNlsFunctional(cv_mem); break; case CV_NEWTON: flag = CVNlsNewton(cv_mem, nflag); break; } return(flag); } /* * CVNlsFunctional * * This routine attempts to solve the nonlinear system using * functional iteration (no matrices involved). * * Possible return values are: * * CV_SUCCESS ---> continue with error test * * CV_RHSFUNC_FAIL ---> halt the integration * * CONV_FAIL -+ * RHSFUNC_RECVR -+-> predict again or stop if too many * */ static int CVNlsFunctional(CVodeMem cv_mem) { int retval, m; realtype del, delp, dcon; /* Initialize counter and evaluate f at predicted y */ crate = ONE; m = 0; retval = f(tn, zn[0], tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); N_VConst(ZERO, acor); /* Initialize delp to avoid compiler warning message */ del = delp = ZERO; /* Loop until convergence; accumulate corrections in acor */ loop { nni++; /* Correct y directly from the last f value */ N_VLinearSum(h, tempv, -ONE, zn[1], tempv); N_VScale(rl1, tempv, tempv); N_VLinearSum(ONE, zn[0], ONE, tempv, y); /* Get WRMS norm of current correction to use in convergence test */ N_VLinearSum(ONE, tempv, -ONE, acor, acor); del = N_VWrmsNorm(acor, ewt); N_VScale(ONE, tempv, acor); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. */ if (m > 0) crate = MAX(CRDOWN * crate, del / delp); dcon = del * MIN(ONE, crate) / tq[4]; if (dcon <= ONE) { acnrm = (m == 0) ? del : N_VWrmsNorm(acor, ewt); return(CV_SUCCESS); /* Convergence achieved */ } /* Stop at maxcor iterations or if iter. seems to be diverging */ m++; if ((m==maxcor) || ((m >= 2) && (del > RDIV * delp))) return(CONV_FAIL); /* Save norm of correction, evaluate f, and loop again */ delp = del; retval = f(tn, y, tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); } } /* * CVNlsNewton * * This routine handles the Newton iteration. It calls lsetup if * indicated, calls CVNewtonIteration to perform the iteration, and * retries a failed attempt at Newton iteration if that is indicated. * * Possible return values: * * CV_SUCCESS ---> continue with error test * * CV_RHSFUNC_FAIL -+ * CV_LSETUP_FAIL |-> halt the integration * CV_LSOLVE_FAIL -+ * * CONV_FAIL -+ * RHSFUNC_RECVR -+-> predict again or stop if too many * */ static int CVNlsNewton(CVodeMem cv_mem, int nflag) { N_Vector vtemp1, vtemp2, vtemp3; int convfail, retval, ier; booleantype callSetup; vtemp1 = acor; /* rename acor as vtemp1 for readability */ vtemp2 = y; /* rename y as vtemp2 for readability */ vtemp3 = tempv; /* rename tempv as vtemp3 for readability */ /* Set flag convfail, input to lsetup for its evaluation decision */ convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? CV_NO_FAILURES : CV_FAIL_OTHER; /* Decide whether or not to call setup routine (if one exists) */ if (setupNonNull) { callSetup = (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || (nst == 0) || (nst >= nstlp + MSBP) || (ABS(gamrat-ONE) > DGMAX); } else { crate = ONE; callSetup = FALSE; } /* Looping point for the solution of the nonlinear system. Evaluate f at the predicted y, call lsetup if indicated, and call CVNewtonIteration for the Newton iteration itself. */ loop { retval = f(tn, zn[0], ftemp, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); if (callSetup) { ier = lsetup(cv_mem, convfail, zn[0], ftemp, &jcur, vtemp1, vtemp2, vtemp3); nsetups++; callSetup = FALSE; gamrat = crate = ONE; gammap = gamma; nstlp = nst; /* Return if lsetup failed */ if (ier < 0) return(CV_LSETUP_FAIL); if (ier > 0) return(CONV_FAIL); } /* Set acor to zero and load prediction into y vector */ N_VConst(ZERO, acor); N_VScale(ONE, zn[0], y); /* Do the Newton iteration */ ier = CVNewtonIteration(cv_mem); /* If there is a convergence failure and the Jacobian-related data appears not to be current, loop again with a call to lsetup in which convfail=CV_FAIL_BAD_J. Otherwise return. */ if (ier != TRY_AGAIN) return(ier); callSetup = TRUE; convfail = CV_FAIL_BAD_J; } } /* * CVNewtonIteration * * This routine performs the Newton iteration. If the iteration succeeds, * it returns the value CV_SUCCESS. If not, it may signal the CVNlsNewton * routine to call lsetup again and reattempt the iteration, by * returning the value TRY_AGAIN. (In this case, CVNlsNewton must set * convfail to CV_FAIL_BAD_J before calling setup again). * Otherwise, this routine returns one of the appropriate values * CV_LSOLVE_FAIL, CV_RHSFUNC_FAIL, CONV_FAIL, or RHSFUNC_RECVR back * to CVNlsNewton. */ static int CVNewtonIteration(CVodeMem cv_mem) { int m, retval; realtype del, delp, dcon; N_Vector b; mnewt = m = 0; /* Initialize delp to avoid compiler warning message */ del = delp = ZERO; /* Looping point for Newton iteration */ loop { /* Evaluate the residual of the nonlinear system*/ N_VLinearSum(rl1, zn[1], ONE, acor, tempv); N_VLinearSum(gamma, ftemp, -ONE, tempv, tempv); /* Call the lsolve function */ b = tempv; retval = lsolve(cv_mem, b, ewt, y, ftemp); nni++; if (retval < 0) return(CV_LSOLVE_FAIL); /* If lsolve had a recoverable failure and Jacobian data is not current, signal to try the solution again */ if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Get WRMS norm of correction; add correction to acor and y */ del = N_VWrmsNorm(b, ewt); N_VLinearSum(ONE, acor, ONE, b, acor); N_VLinearSum(ONE, zn[0], ONE, acor, y); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. */ if (m > 0) { crate = MAX(CRDOWN * crate, del/delp); } dcon = del * MIN(ONE, crate) / tq[4]; if (dcon <= ONE) { acnrm = (m==0) ? del : N_VWrmsNorm(acor, ewt); jcur = FALSE; return(CV_SUCCESS); /* Nonlinear system was solved successfully */ } mnewt = ++m; /* Stop at maxcor iterations or if iter. seems to be diverging. If still not converged and Jacobian data is not current, signal to try the solution again */ if ((m == maxcor) || ((m >= 2) && (del > RDIV*delp))) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Save norm of correction, evaluate f, and loop again */ delp = del; retval = f(tn, y, ftemp, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(RHSFUNC_RECVR); } } /* end loop */ } /* * CVHandleFlag * * This routine takes action on the return value nflag = *nflagPtr * returned by CVNls, as follows: * * If CVNls succeeded in solving the nonlinear system, then * CVHandleNFlag returns the constant DO_ERROR_TEST, which tells CVStep * to perform the error test. * * If the nonlinear system was not solved successfully, then ncfn and * ncf = *ncfPtr are incremented and Nordsieck array zn is restored. * * If the solution of the nonlinear system failed due to an * unrecoverable failure by setup, we return the value CV_LSETUP_FAIL. * * If it failed due to an unrecoverable failure in solve, then we return * the value CV_LSOLVE_FAIL. * * If it failed due to an unrecoverable failure in rhs, then we return * the value CV_RHSFUNC_FAIL. * * Otherwise, a recoverable failure occurred when solving the * nonlinear system (CVNls returned nflag == CONV_FAIL or RHSFUNC_RECVR). * In this case, if ncf is now equal to maxncf or |h| = hmin, * we return the value CV_CONV_FAILURE (if nflag=CONV_FAIL) or * CV_REPTD_RHSFUNC_ERR (if nflag=RHSFUNC_RECVR). * If not, we set *nflagPtr = PREV_CONV_FAIL and return the value * PREDICT_AGAIN, telling CVStep to reattempt the step. * */ static int CVHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr) { int nflag; nflag = *nflagPtr; if (nflag == CV_SUCCESS) return(DO_ERROR_TEST); /* The nonlinear soln. failed; increment ncfn and restore zn */ ncfn++; CVRestore(cv_mem, saved_t); /* Return if lsetup, lsolve, or rhs failed unrecoverably */ if (nflag == CV_LSETUP_FAIL) return(CV_LSETUP_FAIL); if (nflag == CV_LSOLVE_FAIL) return(CV_LSOLVE_FAIL); if (nflag == CV_RHSFUNC_FAIL) return(CV_RHSFUNC_FAIL); /* At this point, nflag = CONV_FAIL or RHSFUNC_RECVR; increment ncf */ (*ncfPtr)++; etamax = ONE; /* If we had maxncf failures or |h| = hmin, return CV_CONV_FAILURE or CV_REPTD_RHSFUNC_ERR. */ if ((ABS(h) <= hmin*ONEPSM) || (*ncfPtr == maxncf)) { if (nflag == CONV_FAIL) return(CV_CONV_FAILURE); if (nflag == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); } /* Reduce step size; return to reattempt the step */ eta = MAX(ETACF, hmin / ABS(h)); *nflagPtr = PREV_CONV_FAIL; CVRescale(cv_mem); return(PREDICT_AGAIN); } /* * CVRestore * * This routine restores the value of tn to saved_t and undoes the * prediction. After execution of CVRestore, the Nordsieck array zn has * the same values as before the call to CVPredict. */ static void CVRestore(CVodeMem cv_mem, realtype saved_t) { int j, k; tn = saved_t; for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, zn[j-1], -ONE, zn[j], zn[j-1]); } /* * CVDoErrorTest * * This routine performs the local error test. * The weighted local error norm dsm is loaded into *dsmPtr, and * the test dsm ?<= 1 is made. * * If the test passes, CVDoErrorTest returns CV_SUCCESS. * * If the test fails, we undo the step just taken (call CVRestore) and * * - if maxnef error test failures have occurred or if ABS(h) = hmin, * we return CV_ERR_FAILURE. * * - if more than MXNEF1 error test failures have occurred, an order * reduction is forced. If already at order 1, restart by reloading * zn from scratch. If f() fails we return either CV_RHSFUNC_FAIL * or CV_UNREC_RHSFUNC_ERR (no recovery is possible at this stage). * * - otherwise, set *nflagPtr to PREV_ERR_FAIL, and return TRY_AGAIN. * */ static booleantype CVDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *nefPtr, realtype *dsmPtr) { realtype dsm; int retval; dsm = acnrm * tq[2]; /* If est. local error norm dsm passes test, return CV_SUCCESS */ *dsmPtr = dsm; if (dsm <= ONE) return(CV_SUCCESS); /* Test failed; increment counters, set nflag, and restore zn array */ (*nefPtr)++; netf++; *nflagPtr = PREV_ERR_FAIL; CVRestore(cv_mem, saved_t); /* At maxnef failures or |h| = hmin, return CV_ERR_FAILURE */ if ((ABS(h) <= hmin*ONEPSM) || (*nefPtr == maxnef)) return(CV_ERR_FAILURE); /* Set etamax = 1 to prevent step size increase at end of this step */ etamax = ONE; /* Set h ratio eta from dsm, rescale, and return for retry of step */ if (*nefPtr <= MXNEF1) { eta = ONE / (RPowerR(BIAS2*dsm,ONE/L) + ADDON); eta = MAX(ETAMIN, MAX(eta, hmin / ABS(h))); if (*nefPtr >= SMALL_NEF) eta = MIN(eta, ETAMXF); CVRescale(cv_mem); return(TRY_AGAIN); } /* After MXNEF1 failures, force an order reduction and retry step */ if (q > 1) { eta = MAX(ETAMIN, hmin / ABS(h)); CVAdjustOrder(cv_mem,-1); L = q; q--; qwait = L; CVRescale(cv_mem); return(TRY_AGAIN); } /* If already at order 1, restart: reload zn from scratch */ eta = MAX(ETAMIN, hmin / ABS(h)); h *= eta; next_h = h; hscale = h; qwait = LONG_WAIT; nscon = 0; retval = f(tn, zn[0], tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_RHSFUNC_ERR); N_VScale(h, tempv, zn[1]); return(TRY_AGAIN); } /* * ================================================================= * Private Functions Implementation after succesful step * ================================================================= */ /* * CVCompleteStep * * This routine performs various update operations when the solution * to the nonlinear system has passed the local error test. * We increment the step counter nst, record the values hu and qu, * update the tau array, and apply the corrections to the zn array. * The tau[i] are the last q values of h, with tau[1] the most recent. * The counter qwait is decremented, and if qwait == 1 (and q < qmax) * we save acor and tq[5] for a possible order increase. */ static void CVCompleteStep(CVodeMem cv_mem) { int i, j; nst++; nscon++; hu = h; qu = q; for (i=q; i >= 2; i--) tau[i] = tau[i-1]; if ((q==1) && (nst > 1)) tau[2] = tau[1]; tau[1] = h; for (j=0; j <= q; j++) N_VLinearSum(l[j], acor, ONE, zn[j], zn[j]); qwait--; if ((qwait == 1) && (q != qmax)) { N_VScale(ONE, acor, zn[qmax]); saved_tq5 = tq[5]; indx_acor = qmax; } } /* * CVprepareNextStep * * This routine handles the setting of stepsize and order for the * next step -- hprime and qprime. Along with hprime, it sets the * ratio eta = hprime/h. It also updates other state variables * related to a change of step size or order. */ static void CVPrepareNextStep(CVodeMem cv_mem, realtype dsm) { /* If etamax = 1, defer step size or order changes */ if (etamax == ONE) { qwait = MAX(qwait, 2); qprime = q; hprime = h; eta = ONE; return; } /* etaq is the ratio of new to old h at the current order */ etaq = ONE /(RPowerR(BIAS2*dsm,ONE/L) + ADDON); /* If no order change, adjust eta and acor in CVSetEta and return */ if (qwait != 0) { eta = etaq; qprime = q; CVSetEta(cv_mem); return; } /* If qwait = 0, consider an order change. etaqm1 and etaqp1 are the ratios of new to old h at orders q-1 and q+1, respectively. CVChooseEta selects the largest; CVSetEta adjusts eta and acor */ qwait = 2; etaqm1 = CVComputeEtaqm1(cv_mem); etaqp1 = CVComputeEtaqp1(cv_mem); CVChooseEta(cv_mem); CVSetEta(cv_mem); } /* * CVsetEta * * This routine adjusts the value of eta according to the various * heuristic limits and the optional input hmax. It also resets * etamax to be the estimated local error vector. */ static void CVSetEta(CVodeMem cv_mem) { /* If eta below the threshhold THRESH, reject a change of step size */ if (eta < THRESH) { eta = ONE; hprime = h; } else { /* Limit eta by etamax and hmax, then set hprime */ eta = MIN(eta, etamax); eta /= MAX(ONE, ABS(h)*hmax_inv*eta); hprime = h * eta; if (qprime < q) nscon = 0; } /* Reset etamax for the next step size change, and scale acor */ } /* * CVComputeEtaqm1 * * This routine computes and returns the value of etaqm1 for a * possible decrease in order by 1. */ static realtype CVComputeEtaqm1(CVodeMem cv_mem) { realtype ddn; etaqm1 = ZERO; if (q > 1) { ddn = N_VWrmsNorm(zn[q], ewt) * tq[1]; etaqm1 = ONE/(RPowerR(BIAS1*ddn, ONE/q) + ADDON); } return(etaqm1); } /* * CVComputeEtaqp1 * * This routine computes and returns the value of etaqp1 for a * possible increase in order by 1. */ static realtype CVComputeEtaqp1(CVodeMem cv_mem) { realtype dup, cquot; etaqp1 = ZERO; if (q != qmax) { if (saved_tq5 == ZERO) return(etaqp1); cquot = (tq[5] / saved_tq5) * RPowerI(h/tau[2], L); N_VLinearSum(-cquot, zn[qmax], ONE, acor, tempv); dup = N_VWrmsNorm(tempv, ewt) * tq[3]; etaqp1 = ONE / (RPowerR(BIAS3*dup, ONE/(L+1)) + ADDON); } return(etaqp1); } /* * CVChooseEta * Given etaqm1, etaq, etaqp1 (the values of eta for qprime = * q - 1, q, or q + 1, respectively), this routine chooses the * maximum eta value, sets eta to that value, and sets qprime to the * corresponding value of q. If there is a tie, the preference * order is to (1) keep the same order, then (2) decrease the order, * and finally (3) increase the order. If the maximum eta value * is below the threshhold THRESH, the order is kept unchanged and * eta is set to 1. */ static void CVChooseEta(CVodeMem cv_mem) { realtype etam; etam = MAX(etaqm1, MAX(etaq, etaqp1)); if (etam < THRESH) { eta = ONE; qprime = q; return; } if (etam == etaq) { eta = etaq; qprime = q; } else if (etam == etaqm1) { eta = etaqm1; qprime = q - 1; } else { eta = etaqp1; qprime = q + 1; if (lmm == CV_BDF) { /* * Store Delta_n in zn[qmax] to be used in order increase * * This happens at the last step of order q before an increase * to order q+1, so it represents Delta_n in the ELTE at q+1 */ N_VScale(ONE, acor, zn[qmax]); } } } /* * CVHandleFailure * * This routine prints error messages for all cases of failure by * CVHin and CVStep. It returns to CVode the value that CVode is * to return to the user. */ static int CVHandleFailure(CVodeMem cv_mem, int flag) { /* Set vector of absolute weighted local errors */ /* N_VProd(acor, ewt, tempv); N_VAbs(tempv, tempv); */ /* Depending on flag, print error message and return error flag */ switch (flag) { case CV_ERR_FAILURE: CVProcessError(cv_mem, CV_ERR_FAILURE, "CVODE", "CVode", MSGCV_ERR_FAILS, tn, h); break; case CV_CONV_FAILURE: CVProcessError(cv_mem, CV_CONV_FAILURE, "CVODE", "CVode", MSGCV_CONV_FAILS, tn, h); break; case CV_LSETUP_FAIL: CVProcessError(cv_mem, CV_LSETUP_FAIL, "CVODE", "CVode", MSGCV_SETUP_FAILED, tn); break; case CV_LSOLVE_FAIL: CVProcessError(cv_mem, CV_LSOLVE_FAIL, "CVODE", "CVode", MSGCV_SOLVE_FAILED, tn); break; case CV_RHSFUNC_FAIL: CVProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODE", "CVode", MSGCV_RHSFUNC_FAILED, tn); break; case CV_UNREC_RHSFUNC_ERR: CVProcessError(cv_mem, CV_UNREC_RHSFUNC_ERR, "CVODE", "CVode", MSGCV_RHSFUNC_UNREC, tn); break; case CV_REPTD_RHSFUNC_ERR: CVProcessError(cv_mem, CV_REPTD_RHSFUNC_ERR, "CVODE", "CVode", MSGCV_RHSFUNC_REPTD, tn); break; case CV_RTFUNC_FAIL: CVProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODE", "CVode", MSGCV_RTFUNC_FAILED, tn); break; case CV_TOO_CLOSE: CVProcessError(cv_mem, CV_TOO_CLOSE, "CVODE", "CVode", MSGCV_TOO_CLOSE); break; default: return(CV_SUCCESS); } return(flag); } /* * ================================================================= * BDF Stability Limit Detection * ================================================================= */ /* * CVBDFStab * * This routine handles the BDF Stability Limit Detection Algorithm * STALD. It is called if lmm = CV_BDF and the SLDET option is on. * If the order is 3 or more, the required norm data is saved. * If a decision to reduce order has not already been made, and * enough data has been saved, CVsldet is called. If it signals * a stability limit violation, the order is reduced, and the step * size is reset accordingly. */ void CVBDFStab(CVodeMem cv_mem) { int i,k, ldflag, factorial; realtype sq, sqm1, sqm2; /* If order is 3 or greater, then save scaled derivative data, push old data down in i, then add current values to top. */ if (q >= 3) { for (k = 1; k <= 3; k++) { for (i = 5; i >= 2; i--) ssdat[i][k] = ssdat[i-1][k]; } factorial = 1; for (i = 1; i <= q-1; i++) factorial *= i; sq = factorial*q*(q+1)*acnrm/MAX(tq[5],TINY); sqm1 = factorial*q*N_VWrmsNorm(zn[q], ewt); sqm2 = factorial*N_VWrmsNorm(zn[q-1], ewt); ssdat[1][1] = sqm2*sqm2; ssdat[1][2] = sqm1*sqm1; ssdat[1][3] = sq*sq; } if (qprime >= q) { /* If order is 3 or greater, and enough ssdat has been saved, nscon >= q+5, then call stability limit detection routine. */ if ( (q >= 3) && (nscon >= q+5) ) { ldflag = CVsldet(cv_mem); if (ldflag > 3) { /* A stability limit violation is indicated by a return flag of 4, 5, or 6. Reduce new order. */ qprime = q-1; eta = etaqm1; eta = MIN(eta,etamax); eta = eta/MAX(ONE,ABS(h)*hmax_inv*eta); hprime = h*eta; nor = nor + 1; } } } else { /* Otherwise, let order increase happen, and reset stability limit counter, nscon. */ nscon = 0; } } /* * CVsldet * * This routine detects stability limitation using stored scaled * derivatives data. CVsldet returns the magnitude of the * dominate characteristic root, rr. The presents of a stability * limit is indicated by rr > "something a little less then 1.0", * and a positive kflag. This routine should only be called if * order is greater than or equal to 3, and data has been collected * for 5 time steps. * * Returned values: * kflag = 1 -> Found stable characteristic root, normal matrix case * kflag = 2 -> Found stable characteristic root, quartic solution * kflag = 3 -> Found stable characteristic root, quartic solution, * with Newton correction * kflag = 4 -> Found stability violation, normal matrix case * kflag = 5 -> Found stability violation, quartic solution * kflag = 6 -> Found stability violation, quartic solution, * with Newton correction * * kflag < 0 -> No stability limitation, * or could not compute limitation. * * kflag = -1 -> Min/max ratio of ssdat too small. * kflag = -2 -> For normal matrix case, vmax > vrrt2*vrrt2 * kflag = -3 -> For normal matrix case, The three ratios * are inconsistent. * kflag = -4 -> Small coefficient prevents elimination of quartics. * kflag = -5 -> R value from quartics not consistent. * kflag = -6 -> No corrected root passes test on qk values * kflag = -7 -> Trouble solving for sigsq. * kflag = -8 -> Trouble solving for B, or R via B. * kflag = -9 -> R via sigsq[k] disagrees with R from data. */ static int CVsldet(CVodeMem cv_mem) { int i, k, j, it, kmin, kflag = 0; realtype rat[5][4], rav[4], qkr[4], sigsq[4], smax[4], ssmax[4]; realtype drr[4], rrc[4],sqmx[4], qjk[4][4], vrat[5], qc[6][4], qco[6][4]; realtype rr, rrcut, vrrtol, vrrt2, sqtol, rrtol; realtype smink, smaxk, sumrat, sumrsq, vmin, vmax, drrmax, adrr; realtype tem, sqmax, saqk, qp, s, sqmaxk, saqj, sqmin; realtype rsa, rsb, rsc, rsd, rd1a, rd1b, rd1c; realtype rd2a, rd2b, rd3a, cest1, corr1; realtype ratp, ratm, qfac1, qfac2, bb, rrb; /* The following are cutoffs and tolerances used by this routine */ rrcut = RCONST(0.98); vrrtol = RCONST(1.0e-4); vrrt2 = RCONST(5.0e-4); sqtol = RCONST(1.0e-3); rrtol = RCONST(1.0e-2); rr = ZERO; /* Index k corresponds to the degree of the interpolating polynomial. */ /* k = 1 -> q-1 */ /* k = 2 -> q */ /* k = 3 -> q+1 */ /* Index i is a backward-in-time index, i = 1 -> current time, */ /* i = 2 -> previous step, etc */ /* get maxima, minima, and variances, and form quartic coefficients */ for (k=1; k<=3; k++) { smink = ssdat[1][k]; smaxk = ZERO; for (i=1; i<=5; i++) { smink = MIN(smink,ssdat[i][k]); smaxk = MAX(smaxk,ssdat[i][k]); } if (smink < TINY*smaxk) { kflag = -1; return(kflag); } smax[k] = smaxk; ssmax[k] = smaxk*smaxk; sumrat = ZERO; sumrsq = ZERO; for (i=1; i<=4; i++) { rat[i][k] = ssdat[i][k]/ssdat[i+1][k]; sumrat = sumrat + rat[i][k]; sumrsq = sumrsq + rat[i][k]*rat[i][k]; } rav[k] = FOURTH*sumrat; vrat[k] = ABS(FOURTH*sumrsq - rav[k]*rav[k]); qc[5][k] = ssdat[1][k]*ssdat[3][k] - ssdat[2][k]*ssdat[2][k]; qc[4][k] = ssdat[2][k]*ssdat[3][k] - ssdat[1][k]*ssdat[4][k]; qc[3][k] = ZERO; qc[2][k] = ssdat[2][k]*ssdat[5][k] - ssdat[3][k]*ssdat[4][k]; qc[1][k] = ssdat[4][k]*ssdat[4][k] - ssdat[3][k]*ssdat[5][k]; for (i=1; i<=5; i++) { qco[i][k] = qc[i][k]; } } /* End of k loop */ /* Isolate normal or nearly-normal matrix case. Three quartic will have common or nearly-common roots in this case. Return a kflag = 1 if this procedure works. If three root differ more than vrrt2, return error kflag = -3. */ vmin = MIN(vrat[1],MIN(vrat[2],vrat[3])); vmax = MAX(vrat[1],MAX(vrat[2],vrat[3])); if(vmin < vrrtol*vrrtol) { if (vmax > vrrt2*vrrt2) { kflag = -2; return(kflag); } else { rr = (rav[1] + rav[2] + rav[3])/THREE; drrmax = ZERO; for(k = 1;k<=3;k++) { adrr = ABS(rav[k] - rr); drrmax = MAX(drrmax, adrr); } if (drrmax > vrrt2) { kflag = -3; } kflag = 1; /* can compute charactistic root, drop to next section */ } } else { /* use the quartics to get rr. */ if (ABS(qco[1][1]) < TINY*ssmax[1]) { kflag = -4; return(kflag); } tem = qco[1][2]/qco[1][1]; for(i=2; i<=5; i++) { qco[i][2] = qco[i][2] - tem*qco[i][1]; } qco[1][2] = ZERO; tem = qco[1][3]/qco[1][1]; for(i=2; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][1]; } qco[1][3] = ZERO; if (ABS(qco[2][2]) < TINY*ssmax[2]) { kflag = -4; return(kflag); } tem = qco[2][3]/qco[2][2]; for(i=3; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][2]; } if (ABS(qco[4][3]) < TINY*ssmax[3]) { kflag = -4; return(kflag); } rr = -qco[5][3]/qco[4][3]; if (rr < TINY || rr > HUN) { kflag = -5; return(kflag); } for(k=1; k<=3; k++) { qkr[k] = qc[5][k] + rr*(qc[4][k] + rr*rr*(qc[2][k] + rr*qc[1][k])); } sqmax = ZERO; for(k=1; k<=3; k++) { saqk = ABS(qkr[k])/ssmax[k]; if (saqk > sqmax) sqmax = saqk; } if (sqmax < sqtol) { kflag = 2; /* can compute charactistic root, drop to "given rr,etc" */ } else { /* do Newton corrections to improve rr. */ for(it=1; it<=3; it++) { for(k=1; k<=3; k++) { qp = qc[4][k] + rr*rr*(THREE*qc[2][k] + rr*FOUR*qc[1][k]); drr[k] = ZERO; if (ABS(qp) > TINY*ssmax[k]) drr[k] = -qkr[k]/qp; rrc[k] = rr + drr[k]; } for(k=1; k<=3; k++) { s = rrc[k]; sqmaxk = ZERO; for(j=1; j<=3; j++) { qjk[j][k] = qc[5][j] + s*(qc[4][j] + s*s*(qc[2][j] + s*qc[1][j])); saqj = ABS(qjk[j][k])/ssmax[j]; if (saqj > sqmaxk) sqmaxk = saqj; } sqmx[k] = sqmaxk; } sqmin = sqmx[1]; kmin = 1; for(k=2; k<=3; k++) { if (sqmx[k] < sqmin) { kmin = k; sqmin = sqmx[k]; } } rr = rrc[kmin]; if (sqmin < sqtol) { kflag = 3; /* can compute charactistic root */ /* break out of Newton correction loop and drop to "given rr,etc" */ break; } else { for(j=1; j<=3; j++) { qkr[j] = qjk[j][kmin]; } } } /* end of Newton correction loop */ if (sqmin > sqtol) { kflag = -6; return(kflag); } } /* end of if (sqmax < sqtol) else */ } /* end of if(vmin < vrrtol*vrrtol) else, quartics to get rr. */ /* given rr, find sigsq[k] and verify rr. */ /* All positive kflag drop to this section */ for(k=1; k<=3; k++) { rsa = ssdat[1][k]; rsb = ssdat[2][k]*rr; rsc = ssdat[3][k]*rr*rr; rsd = ssdat[4][k]*rr*rr*rr; rd1a = rsa - rsb; rd1b = rsb - rsc; rd1c = rsc - rsd; rd2a = rd1a - rd1b; rd2b = rd1b - rd1c; rd3a = rd2a - rd2b; if (ABS(rd1b) < TINY*smax[k]) { kflag = -7; return(kflag); } cest1 = -rd3a/rd1b; if (cest1 < TINY || cest1 > FOUR) { kflag = -7; return(kflag); } corr1 = (rd2b/cest1)/(rr*rr); sigsq[k] = ssdat[3][k] + corr1; } if (sigsq[2] < TINY) { kflag = -8; return(kflag); } ratp = sigsq[3]/sigsq[2]; ratm = sigsq[1]/sigsq[2]; qfac1 = FOURTH*(q*q - ONE); qfac2 = TWO/(q - ONE); bb = ratp*ratm - ONE - qfac1*ratp; tem = ONE - qfac2*bb; if (ABS(tem) < TINY) { kflag = -8; return(kflag); } rrb = ONE/tem; if (ABS(rrb - rr) > rrtol) { kflag = -9; return(kflag); } /* Check to see if rr is above cutoff rrcut */ if (rr > rrcut) { if (kflag == 1) kflag = 4; if (kflag == 2) kflag = 5; if (kflag == 3) kflag = 6; } /* All positive kflag returned at this point */ return(kflag); } /* * ================================================================= * Root finding * ================================================================= */ /*-----------------------------------------------------------------*/ /* * CVRcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * CV_SUCCESS = 0 otherwise. */ static int CVRcheck1(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < nrtfn; i++) iroots[i] = 0; tlo = tn; ttol = (ABS(tn) + ABS(h))*uround*HUN; /* Evaluate g at initial t and check for zero values. */ retval = gfun(tlo, zn[0], glo, user_data); nge = 1; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(glo[i]) == ZERO) { zroot = TRUE; gactive[i] = FALSE; } } if (!zroot) return(CV_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = MAX(ttol/ABS(h), TENTH); smallh = hratio*h; tplus = tlo + smallh; N_VLinearSum(ONE, zn[0], hratio, zn[1], y); retval = gfun(tplus, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < nrtfn; i++) { if (!gactive[i] && ABS(ghi[i]) != ZERO) { gactive[i] = TRUE; glo[i] = ghi[i]; } } return(CV_SUCCESS); } /* * CVRcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * CVode. This may be the previous tn, the previous tout value, or * the last root location. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * CLOSERT = 3 if a close pair of zeros was found, or * RTFOUND = 1 if a new zero of g was found near tlo, or * CV_SUCCESS = 0 otherwise. */ static int CVRcheck2(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (irfnd == 0) return(CV_SUCCESS); (void) CVodeGetDky(cv_mem, tlo, 0, y); retval = gfun(tlo, y, glo, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) iroots[i] = 0; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(glo[i]) == ZERO) { zroot = TRUE; iroots[i] = 1; } } if (!zroot) return(CV_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ ttol = (ABS(tn) + ABS(h))*uround*HUN; smallh = (h > ZERO) ? ttol : -ttol; tplus = tlo + smallh; if ( (tplus - tn)*h >= ZERO) { hratio = smallh/h; N_VLinearSum(ONE, y, hratio, zn[1], y); } else { (void) CVodeGetDky(cv_mem, tplus, 0, y); } retval = gfun(tplus, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(ghi[i]) == ZERO) { if (!gactive[i]) continue; if (iroots[i] == 1) return(CLOSERT); zroot = TRUE; iroots[i] = 1; } else { if (iroots[i] == 1) glo[i] = ghi[i]; } } if (zroot) return(RTFOUND); return(CV_SUCCESS); } /* * CVRcheck3 * * This routine interfaces to CVRootfind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int CVRcheck3(CVodeMem cv_mem) { int i, retval, ier; /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ if (taskc == CV_ONE_STEP) { thi = tn; N_VScale(ONE, zn[0], y); } if (taskc == CV_NORMAL) { if ( (toutc - tn)*h >= ZERO) { thi = tn; N_VScale(ONE, zn[0], y); } else { thi = toutc; (void) CVodeGetDky(cv_mem, thi, 0, y); } } /* Set ghi = g(thi) and call CVRootfind to search (tlo,thi) for roots. */ retval = gfun(thi, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); ttol = (ABS(tn) + ABS(h))*uround*HUN; ier = CVRootfind(cv_mem); if (ier == CV_RTFUNC_FAIL) return(CV_RTFUNC_FAIL); for(i=0; i 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to TRUE for all i=0,...,nrtfn-1, but it may be * reset to FALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on TRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (ABS(tlo), ABS(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, and must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int CVRootfind(CVodeMem cv_mem) { realtype alpha, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return CV_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { trout = thi; for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; if (!zroot) return(CV_SUCCESS); for (i = 0; i < nrtfn; i++) { iroots[i] = 0; if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alpha to avoid compiler warning */ alpha = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; loop { /* Looping point */ /* Set weight alpha. On the first two passes, set alpha = 1. Thereafter, reset alpha according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alpha = 1. If the sides were the same, then double alpha (if high side), or halve alpha (if low side). The next guess tmid is the secant method value if alpha = 1, but is closer to tlo if alpha < 1, and closer to thi if alpha > 1. */ if (sideprev == side) { alpha = (side == 2) ? alpha*TWO : alpha*HALF; } else { alpha = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alpha*glo[imax]); if (ABS(tmid - tlo) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; tmid = tlo + fracsub*(thi - tlo); } if (ABS(thi - tmid) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; tmid = thi - fracsub*(thi - tlo); } (void) CVodeGetDky(cv_mem, tmid, 0, y); retval = gfun(tmid, y, grout, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; sideprev = side; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(grout[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(grout[i]/(grout[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (ABS(thi - tlo) <= ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ tlo = tmid; for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (ABS(thi - tlo) <= ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ trout = thi; for (i = 0; i < nrtfn; i++) { grout[i] = ghi[i]; iroots[i] = 0; if(!gactive[i]) continue; if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ================================================================= * Internal EWT function * ================================================================= */ /* * CVEwtSet * * This routine is responsible for setting the error weight vector ewt, * according to tol_type, as follows: * * (1) ewt[i] = 1 / (reltol * ABS(ycur[i]) + *abstol), i=0,...,neq-1 * if tol_type = CV_SS * (2) ewt[i] = 1 / (reltol * ABS(ycur[i]) + abstol[i]), i=0,...,neq-1 * if tol_type = CV_SV * * CVEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines CVEwtSetSS, CVEwtSetSV. */ int CVEwtSet(N_Vector ycur, N_Vector weight, void *data) { CVodeMem cv_mem; int flag = 0; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; switch(itol) { case CV_SS: flag = CVEwtSetSS(cv_mem, ycur, weight); break; case CV_SV: flag = CVEwtSetSV(cv_mem, ycur, weight); break; } return(flag); } /* * CVEwtSetSS * * This routine sets ewt as decribed above in the case tol_type = CV_SS. * It tests for non-positive components before inverting. CVEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int CVEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv); N_VScale(reltol, tempv, tempv); N_VAddConst(tempv, Sabstol, tempv); if (N_VMin(tempv) <= ZERO) return(-1); N_VInv(tempv, weight); return(0); } /* * CVEwtSetSV * * This routine sets ewt as decribed above in the case tol_type = CV_SV. * It tests for non-positive components before inverting. CVEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int CVEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv); N_VLinearSum(reltol, tempv, ONE, Vabstol, tempv); if (N_VMin(tempv) <= ZERO) return(-1); N_VInv(tempv, weight); return(0); } /* * ================================================================= * CVODE Error Handling function * ================================================================= */ /* * CVProcessError is a high level error handling function * - if cv_mem==NULL it prints the error message to stderr * - otherwise, it sets-up and calls the error hadling function * pointed to by cv_ehfun */ #define ehfun (cv_mem->cv_ehfun) #define eh_data (cv_mem->cv_eh_data) void CVProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to CVProcessError) */ va_start(ap, msgfmt); if (cv_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, msgfmt); fprintf(stderr, "\n\n"); #endif } else { /* We can call ehfun */ /* Compose the message */ vsprintf(msg, msgfmt, ap); /* Call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* CVErrHandler is the default error handling function. It sends the error message to the stream pointed to by cv_errfp */ #define errfp (cv_mem->cv_errfp) void CVErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { CVodeMem cv_mem; char err_type[10]; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; if (error_code == CV_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (errfp!=NULL) { fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(errfp," %s\n\n",msg); } #endif return; } sundials-2.5.0/src/cvode/cvode_spils.c0000600000175000017500000004541011741421121020555 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2011/06/23 00:19:54 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPILS linear solvers. * ----------------------------------------------------------------- */ #include #include #include "cvode_impl.h" #include "cvode_spils_impl.h" /* Private constants */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define ONE RCONST(1.0) /* Algorithmic constants */ #define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ /* Readability Replacements */ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) #define tq (cv_mem->cv_tq) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define nfe (cv_mem->cv_nfe) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define lmem (cv_mem->cv_lmem) #define ils_type (cvspils_mem->s_type) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * CVSpilsSetPrecType * ----------------------------------------------------------------- */ int CVSpilsSetPrecType(void *cvode_mem, int pretype) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPrecType", MSGS_BAD_PRETYPE); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_pretype = pretype; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetGSType * ----------------------------------------------------------------- */ int CVSpilsSetGSType(void *cvode_mem, int gstype) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (ils_type != SPILS_SPGMR) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_LSTYPE); return(CVSPILS_ILL_INPUT); } /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_GSTYPE); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_gstype = gstype; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : CVSpilsSetMaxl * ----------------------------------------------------------------- */ int CVSpilsSetMaxl(void *cvode_mem, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(NULL, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (ils_type == SPILS_SPGMR) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetMaxl", MSGS_BAD_LSTYPE); return(CVSPILS_ILL_INPUT); } mxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; cvspils_mem->s_maxl = mxl; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetEpsLin * ----------------------------------------------------------------- */ int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; /* Check for legal eplifac */ if(eplifac < ZERO) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetEpsLin", MSGS_BAD_EPLIN); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_eplifac = (eplifac == ZERO) ? CVSPILS_EPLIN : eplifac; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetPrecSetupFn * ----------------------------------------------------------------- */ int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; cvspils_mem->s_pset = pset; cvspils_mem->s_psolve = psolve; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetJacTimesVecFn * ----------------------------------------------------------------- */ int CVSpilsSetJacTimesVecFn(void *cvode_mem, CVSpilsJacTimesVecFn jtv) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (jtv != NULL) { jtimesDQ = FALSE; jtimes = jtv; } else { jtimesDQ = TRUE; } return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetWorkSpace * ----------------------------------------------------------------- */ int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int maxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: maxl = cvspils_mem->s_maxl; *lenrwLS = lrw1*(maxl + 5) + maxl*(maxl + 4) + 1; *leniwLS = liw1*(maxl + 5); break; case SPILS_SPBCG: *lenrwLS = lrw1 * 9; *leniwLS = liw1 * 9; break; case SPILS_SPTFQMR: *lenrwLS = lrw1*11; *leniwLS = liw1*11; break; } return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumPrecEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *npevals = npe; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumPrecSolves * ----------------------------------------------------------------- */ int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *npsolves = nps; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumLinIters * ----------------------------------------------------------------- */ int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nliters = nli; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumConvFails * ----------------------------------------------------------------- */ int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nlcfails = ncfl; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumJtimesEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *njvevals = njtimes; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumRhsEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nfevalsLS = nfes; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetLastFlag * ----------------------------------------------------------------- */ int CVSpilsGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *flag = last_flag; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetReturnFlagName * ----------------------------------------------------------------- */ char *CVSpilsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVSPILS_SUCCESS: sprintf(name,"CVSPILS_SUCCESS"); break; case CVSPILS_MEM_NULL: sprintf(name,"CVSPILS_MEM_NULL"); break; case CVSPILS_LMEM_NULL: sprintf(name,"CVSPILS_LMEM_NULL"); break; case CVSPILS_ILL_INPUT: sprintf(name,"CVSPILS_ILL_INPUT"); break; case CVSPILS_MEM_FAIL: sprintf(name,"CVSPILS_MEM_FAIL"); break; case CVSPILS_PMEM_NULL: sprintf(name,"CVSPILS_PMEM_NULL"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * CVSPILS private functions * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * CVSpilsAtimes * ----------------------------------------------------------------- * This routine generates the matrix-vector product z = Mv, where * M = I - gamma*J. The product J*v is obtained by calling the jtimes * routine. It is then scaled by -gamma and added to v to obtain M*v. * The return value is the same as the value returned by jtimes -- * 0 if successful, nonzero otherwise. * ----------------------------------------------------------------- */ int CVSpilsAtimes(void *cvode_mem, N_Vector v, N_Vector z) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int jtflag; cv_mem = (CVodeMem) cvode_mem; cvspils_mem = (CVSpilsMem) lmem; jtflag = jtimes(v, z, tn, ycur, fcur, j_data, ytemp); njtimes++; if (jtflag != 0) return(jtflag); N_VLinearSum(ONE, v, -gamma, z, z); return(0); } /* * ----------------------------------------------------------------- * CVSpilsPSolve * ----------------------------------------------------------------- * This routine interfaces between the generic Sp***Solve routine * (within the SPGMR, SPBCG, or SPTFQMR solver) and the * user's psolve routine. It passes to psolve all required state * information from cvode_mem. Its return value is the same as that * returned by psolve. Note that the generic SP*** solver guarantees * that CVSpilsPSolve will not be called in the case in which * preconditioning is not done. This is the only case in which the * user's psolve routine is allowed to be NULL. * ----------------------------------------------------------------- */ int CVSpilsPSolve(void *cvode_mem, N_Vector r, N_Vector z, int lr) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int retval; cv_mem = (CVodeMem) cvode_mem; cvspils_mem = (CVSpilsMem)lmem; /* This call is counted in nps within the CVSp***Solve routine */ retval = psolve(tn, ycur, fcur, r, z, gamma, delta, lr, P_data, ytemp); return(retval); } /* * ----------------------------------------------------------------- * CVSpilsDQJtimes * ----------------------------------------------------------------- * This routine generates a difference quotient approximation to * the Jacobian times vector f_y(t,y) * v. The approximation is * Jv = vnrm[f(y + v/vnrm) - f(y)], where vnrm = (WRMS norm of v) is * input, i.e. the WRMS norm of v/vnrm is 1. * ----------------------------------------------------------------- */ int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *data, N_Vector work) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; realtype sig, siginv; int iter, retval; /* data is cvode_mem */ cv_mem = (CVodeMem) data; cvspils_mem = (CVSpilsMem) lmem; /* Initialize perturbation to 1/||v|| */ sig = ONE/N_VWrmsNorm(v, ewt); for (iter=0; iter 0) return(+1); /* Replace Jv by (Jv - fy)/sig */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, fy, Jv); return(0); } sundials-2.5.0/src/cvode/cvode_diag_impl.h0000600000175000017500000000433411741421121021355 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:19:48 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the diagonal linear solver, CVDIAG. * ----------------------------------------------------------------- */ #ifndef _CVDIAG_IMPL_H #define _CVDIAG_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: CVDiagMemRec, CVDiagMem * ----------------------------------------------------------------- * The type CVDiagMem is pointer to a CVDiagMemRec. * This structure contains CVDiag solver-specific data. * ----------------------------------------------------------------- */ typedef struct { realtype di_gammasv; /* gammasv = gamma at the last call to setup */ /* or solve */ N_Vector di_M; /* M = (I - gamma J)^{-1} , gamma = h / l1 */ N_Vector di_bit; /* temporary storage vector */ N_Vector di_bitcomp; /* temporary storage vector */ long int di_nfeDI; /* no. of calls to f due to difference quotient diagonal Jacobian approximation */ long int di_last_flag; /* last error return flag */ } CVDiagMemRec, *CVDiagMem; /* Error Messages */ #define MSGDG_CVMEM_NULL "Integrator memory is NULL." #define MSGDG_BAD_NVECTOR "A required vector operation is not implemented." #define MSGDG_MEM_FAIL "A memory request failed." #define MSGDG_LMEM_NULL "CVDIAG memory is NULL." #define MSGDG_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/cvode_direct.c0000600000175000017500000003110711741421121020673 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVDLS linear solvers * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "cvode_impl.h" #include "cvode_direct_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ /* Constant for DQ Jacobian approximation */ #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define uround (cv_mem->cv_uround) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define lmem (cv_mem->cv_lmem) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define ml (cvdls_mem->d_ml) #define mu (cvdls_mem->d_mu) #define smu (cvdls_mem->d_smu) #define jacDQ (cvdls_mem->d_jacDQ) #define djac (cvdls_mem->d_djac) #define bjac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define last_flag (cvdls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS * ================================================================= */ /* * CVDlsSetDenseJacFn specifies the dense Jacobian function. */ int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; djac = jac; } else { jacDQ = TRUE; } return(CVDLS_SUCCESS); } /* * CVDlsSetBandJacFn specifies the band Jacobian function. */ int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; bjac = jac; } else { jacDQ = TRUE; } return(CVDLS_SUCCESS); } /* * CVDlsGetWorkSpace returns the length of workspace allocated for the * CVDLS linear solver. */ int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsGetWorkSpace", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsGetWorkSpace", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (mtype == SUNDIALS_DENSE) { *lenrwLS = 2*n*n; *leniwLS = n; } else if (mtype == SUNDIALS_BAND) { *lenrwLS = n*(smu + mu + 2*ml + 2); *leniwLS = n; } return(CVDLS_SUCCESS); } /* * CVDlsGetNumJacEvals returns the number of Jacobian evaluations. */ int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsGetNumJacEvals", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsGetNumJacEvals", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *njevals = nje; return(CVDLS_SUCCESS); } /* * CVDlsGetNumRhsEvals returns the number of calls to the ODE function * needed for the DQ Jacobian approximation. */ int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsGetNumRhsEvals", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsGetNumRhsEvals", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *nfevalsLS = nfeDQ; return(CVDLS_SUCCESS); } /* * CVDlsGetReturnFlagName returns the name associated with a CVDLS * return value. */ char *CVDlsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVDLS_SUCCESS: sprintf(name,"CVDLS_SUCCESS"); break; case CVDLS_MEM_NULL: sprintf(name,"CVDLS_MEM_NULL"); break; case CVDLS_LMEM_NULL: sprintf(name,"CVDLS_LMEM_NULL"); break; case CVDLS_ILL_INPUT: sprintf(name,"CVDLS_ILL_INPUT"); break; case CVDLS_MEM_FAIL: sprintf(name,"CVDLS_MEM_FAIL"); break; case CVDLS_JACFUNC_UNRECVR: sprintf(name,"CVDLS_JACFUNC_UNRECVR"); break; case CVDLS_JACFUNC_RECVR: sprintf(name,"CVDLS_JACFUNC_RECVR"); break; default: sprintf(name,"NONE"); } return(name); } /* * CVDlsGetLastFlag returns the last flag set in a CVDLS function. */ int CVDlsGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsGetLastFlag", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsGetLastFlag", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *flag = last_flag; return(CVDLS_SUCCESS); } /* * ================================================================= * DQ JACOBIAN APPROXIMATIONS * ================================================================= */ /* * ----------------------------------------------------------------- * cvDlsDenseDQJac * ----------------------------------------------------------------- * This routine generates a dense difference quotient approximation to * the Jacobian of f(t,y). It assumes that a dense matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of J is obtained via * the macro DENSE_COL and this pointer is associated with an N_Vector * using the N_VGetArrayPointer/N_VSetArrayPointer functions. * Finally, the actual computation of the jth column of the Jacobian is * done with a call to N_VLinearSum. * ----------------------------------------------------------------- */ int cvDlsDenseDQJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; realtype *tmp2_data, *y_data, *ewt_data; N_Vector ftemp, jthCol; long int j; int retval = 0; CVodeMem cv_mem; CVDlsMem cvdls_mem; /* data points to cvode_mem */ cv_mem = (CVodeMem) data; cvdls_mem = (CVDlsMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for ewt, y */ ewt_data = N_VGetArrayPointer(ewt); y_data = N_VGetArrayPointer(y); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; for (j = 0; j < N; j++) { /* Generate the jth col of J(tn,y) */ N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); yjsaved = y_data[j]; inc = MAX(srur*ABS(yjsaved), minInc/ewt_data[j]); y_data[j] += inc; retval = f(t, y, ftemp, user_data); nfeDQ++; if (retval != 0) break; y_data[j] = yjsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /* * ----------------------------------------------------------------- * cvDlsBandDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation to * the Jacobian of f(t,y). It assumes that a band matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. This makes it possible to get the address of a column * of J via the macro BAND_COL and to write a simple for loop to set * each of the elements of a column in succession. * ----------------------------------------------------------------- */ int cvDlsBandDQJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { N_Vector ftemp, ytemp; realtype fnorm, minInc, inc, inc_inv, srur; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; long int group, i, j, width, ngroups, i1, i2; int retval = 0; CVodeMem cv_mem; CVDlsMem cvdls_mem; /* data points to cvode_mem */ cv_mem = (CVodeMem) data; cvdls_mem = (CVDlsMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = tmp1; ytemp = tmp2; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < N; j+=width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y */ retval = f(tn, ytemp, ftemp, user_data); nfeDQ++; if (retval != 0) break; /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(Jac,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mupper); i2 = MIN(j+mlower, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(retval); } sundials-2.5.0/src/cvode/LICENSE0000600000175000017500000000553111741421121017104 0ustar sylvestresylvestreCopyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by Scott Cohen, Alan Hindmarsh, Radu Serban, Dan Shumaker. UCRL-CODE-155951 All rights reserved. This file is part of CVODE. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/src/cvode/cvode_bandpre.c0000600000175000017500000003543211741421121021041 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of the banded difference * quotient Jacobian-based preconditioner and solver routines for * use with the CVSPILS linear solvers.. * ----------------------------------------------------------------- */ #include #include #include "cvode_impl.h" #include "cvode_bandpre_impl.h" #include "cvode_spils_impl.h" #include #include #include #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes of CVBandPrecSetup and CVBandPrecSolve */ static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int CVBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data, N_Vector tmp); /* Prototype for CVBandPrecFree */ static void CVBandPrecFree(CVodeMem cv_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int CVBandPDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp); /* Redability replacements */ #define vec_tmpl (cv_mem->cv_tempv) /* * ----------------------------------------------------------------- * Initialization, Free, and Get Functions * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVBandPrecInit will * first test for a compatible N_Vector internal representation * by checking that the function N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVBandPrecInit(void *cvode_mem, long int N, long int mu, long int ml) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; long int mup, mlp, storagemu; int flag; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the NVECTOR package is compatible with the BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInit", MSGBP_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } pdata = NULL; pdata = (CVBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */ if (pdata == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Load pointers and bandwidths into pdata block. */ pdata->cvode_mem = cvode_mem; pdata->N = N; pdata->mu = mup = MIN(N-1, MAX(0,mu)); pdata->ml = mlp = MIN(N-1, MAX(0,ml)); /* Initialize nfeBP counter */ pdata->nfeBP = 0; /* Allocate memory for saved banded Jacobian approximation. */ pdata->savedJ = NULL; pdata->savedJ = NewBandMat(N, mup, mlp, mup); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for banded preconditioner. */ storagemu = MIN(N-1, mup+mlp); pdata->savedP = NULL; pdata->savedP = NewBandMat(N, mup, mlp, storagemu); if (pdata->savedP == NULL) { DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for pivot array. */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(N); if (pdata->lpivots == NULL) { DestroyMat(pdata->savedP); DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Overwrite the P_data field in the SPILS memory */ cvspils_mem->s_P_data = pdata; /* Attach the pfree function */ cvspils_mem->s_pfree = CVBandPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, CVBandPrecSetup, CVBandPrecSolve); return(flag); } int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwBP, long int *leniwBP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; long int N, ml, mu, smu; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { CVProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBandPrecData) cvspils_mem->s_P_data; N = pdata->N; mu = pdata->mu; ml = pdata->ml; smu = MIN( N-1, mu + ml); *leniwBP = pdata->N; *lenrwBP = N * ( 2*ml + smu + mu + 2 ); return(CVSPILS_SUCCESS); } int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { CVProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { CVProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBandPrecData) cvspils_mem->s_P_data; *nfevalsBP = pdata->nfeBP; return(CVSPILS_SUCCESS); } /* Readability Replacements */ #define N (pdata->N) #define mu (pdata->mu) #define ml (pdata->ml) #define lpivots (pdata->lpivots) #define savedJ (pdata->savedJ) #define savedP (pdata->savedP) #define nfeBP (pdata->nfeBP) /* * ----------------------------------------------------------------- * CVBandPrecSetup * ----------------------------------------------------------------- * Together CVBandPrecSetup and CVBandPrecSolve use a banded * difference quotient Jacobian to create a preconditioner. * CVBandPrecSetup calculates a new J, if necessary, then * calculates P = I - gamma*J, and does an LU factorization of P. * * The parameters of CVBandPrecSetup are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data from the * previous PrecSetup call will be reused * (with the current value of gamma). * A CVBandPrecSetup call with jok == TRUE should only * occur after a call with jok == FALSE. * * *jcurPtr is a pointer to an output integer flag which is * set by CVBandPrecond as follows: * *jcurPtr = TRUE if Jacobian data was recomputed. * *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for vectors of length N for work space. This * routine uses only tmp1 and tmp2. * * The value to be returned by the CVBandPrecSetup function is * 0 if successful, or * 1 if the band factorization failed. * ----------------------------------------------------------------- */ static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVBandPrecData pdata; CVodeMem cv_mem; int retval; long int ier; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mu, ml); } else { /* If jok = FALSE, call CVBandPDQJac for new J value. */ *jcurPtr = TRUE; SetToZero(savedJ); retval = CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { CVProcessError(cv_mem, -1, "CVBANDPRE", "CVBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mu, ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of matrix. */ ier = BandGBTRF(savedP, lpivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * CVBandPrecSolve * ----------------------------------------------------------------- * CVBandPrecSolve solves a linear system P z = r, where P is the * matrix computed by CVBandPrecond. * * The parameters of CVBandPrecSolve used here are as follows: * * r is the right-hand side vector of the linear system. * * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) * * z is the output vector computed by CVBandPrecSolve. * * The value returned by the CVBandPrecSolve function is always 0, * indicating success. * ----------------------------------------------------------------- */ static int CVBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data, N_Vector tmp) { CVBandPrecData pdata; realtype *zd; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; /* Copy r to z. */ N_VScale(ONE, r, z); /* Do band backsolve on the vector z. */ zd = N_VGetArrayPointer(z); BandGBTRS(savedP, lpivots, zd); return(0); } static void CVBandPrecFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; CVBandPrecData pdata; if (cv_mem->cv_lmem == NULL) return; cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) return; pdata = (CVBandPrecData) cvspils_mem->s_P_data; DestroyMat(savedJ); DestroyMat(savedP); DestroyArray(lpivots); free(pdata); pdata = NULL; } #define ewt (cv_mem->cv_ewt) #define uround (cv_mem->cv_uround) #define h (cv_mem->cv_h) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) /* * ----------------------------------------------------------------- * CVBandPDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation to * the Jacobian of f(t,y). It assumes that a band matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. This makes it possible to get the address of a column * of J via the macro BAND_COL and to write a simple for loop to set * each of the elements of a column in succession. * ----------------------------------------------------------------- */ static int CVBandPDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp) { CVodeMem cv_mem; realtype fnorm, minInc, inc, inc_inv, srur; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector. */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f. */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing. */ width = ml + mu + 1; ngroups = MIN(width, N); for (group = 1; group <= ngroups; group++) { /* Increment all y_j in group. */ for(j = group-1; j < N; j += width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y. */ retval = f(t, ytemp, ftemp, user_data); nfeBP++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients. */ for (j = group-1; j < N; j += width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mu); i2 = MIN(j+ml, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(0); } sundials-2.5.0/src/cvode/fcmix/0000755000175000017500000000000011767174700017231 5ustar sylvestresylvestresundials-2.5.0/src/cvode/fcmix/fcvband.c0000600000175000017500000000706511741421121020760 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE/CVBAND, for the case of * a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /******************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_BJAC(long int*, long int*, long int*, long int*, /* N,MU,ML,EBAND */ realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, /* BJAC */ realtype*, /* H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, realtype*, /* V1, V2, V3 */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_BANDSETJAC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVDlsSetBandJacFn(CV_cvodemem, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVDlsSetBandJacFn(CV_cvodemem, FCVBandJac); } } /***************************************************************************/ /* C function CVBandJac interfaces between CVODE and a Fortran subroutine FCVBJAC for solution of a linear system with band Jacobian approximation. Addresses of arguments are passed to FCVBJAC, using the macro BAND_COL from BAND and the routine N_VGetArrayPointer from NVECTOR. The address passed for J is that of the element in column 0 with row index -mupper. An extended bandwith equal to (J->smu) + mlower + 1 is passed as the column dimension of the corresponding array. Auxiliary data is assumed to be communicated by Common. */ int FCVBandJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int ier; realtype *ydata, *fydata, *jacdata, *v1data, *v2data, *v3data; realtype h; long int eband; FCVUserData CV_userdata; CVodeGetLastStep(CV_cvodemem, &h); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; CV_userdata = (FCVUserData) user_data; FCV_BJAC(&N, &mupper, &mlower, &eband, &t, ydata, fydata, jacdata, &h, CV_userdata->ipar, CV_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvpreco.c0000600000175000017500000001154611741421121021163 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:28:59 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The C function FCVPSet is to interface between the CVSP* * module and the user-supplied preconditioner setup routine FCVPSET. * Note the use of the generic name FCV_PSET below. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /*********************************************************************/ /* Prototype of the Fortran routines */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_PSET(realtype*, realtype*, realtype*, /* T, Y, FY */ booleantype*, booleantype*, /* JOK, JCUR */ realtype*, realtype*, /* GAMMA, H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, realtype*, /* W1, W2, W3 */ int*); /* IER */ extern void FCV_PSOL(realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, realtype*, /* R, Z */ realtype*, realtype*, /* GAMMA, DELTA */ int*, /* LR */ long int*, realtype*, /* IPAR, RPAR */ realtype*, /* WRK */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_SPILSSETPREC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVSpilsSetPreconditioner(CV_cvodemem, NULL, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVSpilsSetPreconditioner(CV_cvodemem, FCVPSet, FCVPSol); } } /***************************************************************************/ /* C function FCVPSet to interface between CVODE and a Fortran subroutine FCVPSET for setup of a Krylov preconditioner. Addresses of t, y, fy, jok, gamma, h, vtemp1, vtemp2, vtemp3, and the address jcurPtr are passed to FCVPSET, using the routine N_VGetArrayPointer from NVECTOR. A return flag ier from FCVPSET is returned by FCVPSet. Auxiliary data is assumed to be communicated by common blocks. */ int FCVPSet(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int ier = 0; realtype *ydata, *fydata, *v1data, *v2data, *v3data; realtype h; FCVUserData CV_userdata; CVodeGetLastStep(CV_cvodemem, &h); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); CV_userdata = (FCVUserData) user_data; FCV_PSET(&t, ydata, fydata, &jok, jcurPtr, &gamma, &h, CV_userdata->ipar, CV_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } /***************************************************************************/ /* C function FCVPSol to interface between CVODE and a Fortran subroutine FCVPSOL for solution of a Krylov preconditioner. Addresses of t, y, fy, gamma, delta, lr, vtemp, r, and z are passed to FCVPSOL, using the routine N_VGetArrayPointer from NVECTOR. A return flag ier from FCVPSOL is returned by FCVPSol. Auxiliary data is assumed to be communicated by Common blocks. */ int FCVPSol(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { int ier = 0; realtype *ydata, *fydata, *vtdata, *rdata, *zdata; FCVUserData CV_userdata; ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); vtdata = N_VGetArrayPointer(vtemp); rdata = N_VGetArrayPointer(r); zdata = N_VGetArrayPointer(z); CV_userdata = (FCVUserData) user_data; FCV_PSOL(&t, ydata, fydata, rdata, zdata, &gamma, &delta, &lr, CV_userdata->ipar, CV_userdata->rpar, vtdata, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvroot.c0000600000175000017500000000477111741421121021040 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:28:59 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The FCVROOT module contains the routines necessary to use * the rootfinding feature of the CVODE module and to interface * with the user-supplied Fortran subroutine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global variables */ #include "fcvroot.h" /* prototypes of interfaces to CVODE */ #include "cvode_impl.h" /* definition of CVodeMem type */ /***************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_ROOTFN(realtype *, realtype*, realtype*, /* T, Y, G */ long int*, realtype*, /* IPAR, RPAR */ int *ier); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_ROOTINIT(int *nrtfn, int *ier) { CVodeMem cv_mem; cv_mem = (CVodeMem) CV_cvodemem; *ier = CVodeRootInit(CV_cvodemem, *nrtfn, (CVRootFn) FCVrootfunc); CV_nrtfn = *nrtfn; return; } /***************************************************************************/ void FCV_ROOTINFO(int *nrtfn, int *info, int *ier) { *ier = CVodeGetRootInfo(CV_cvodemem, info); return; } /***************************************************************************/ void FCV_ROOTFREE(void) { CVodeRootInit(CV_cvodemem, 0, NULL); return; } /***************************************************************************/ int FCVrootfunc(realtype t, N_Vector y, realtype *gout, void *user_data) { int ier; realtype *ydata; FCVUserData CV_userdata; ydata = N_VGetArrayPointer(y); CV_userdata = (FCVUserData) user_data; FCV_ROOTFN(&t, ydata, gout, CV_userdata->ipar, CV_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvode.c0000600000175000017500000004334211741421121020621 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/09 19:36:24 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the Fortran interface to * the CVODE package. See fcvode.h for usage. * NOTE: some routines are necessarily stored elsewhere to avoid * linking problems. Therefore, see also fcvpreco.c, fcvpsol.c, * and fcvjtimes.c for all the options available. * ----------------------------------------------------------------- */ #include #include #include #include "fcvode.h" /* actual function names, prototypes, global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /* prototypes for CVBAND interface routines */ #include /* prototypes for CVDENSE interface routines */ #include /* prototypes for CVDIAG interface routines */ #include /* prototypes for CVSPGMR interface routines */ #include /* prototypes for CVSPBCG interface routines */ #include /* prototypes for CVSPTFQMR interface routines */ /***************************************************************************/ /* Definitions for global variables shared amongst various routines */ void *CV_cvodemem; long int *CV_iout; realtype *CV_rout; int CV_nrtfn; int CV_ls; /***************************************************************************/ /* private constant(s) */ #define ZERO RCONST(0.0) /***************************************************************************/ /* Prototypes of the Fortran routines */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_FUN(realtype*, /* T */ realtype*, /* Y */ realtype*, /* YDOT */ long int*, /* IPAR */ realtype*, /* RPAR */ int*); /* IER */ #ifdef __cplusplus } #endif /**************************************************************************/ void FCV_MALLOC(realtype *t0, realtype *y0, int *meth, int *itmeth, int *iatol, realtype *rtol, realtype *atol, long int *iout, realtype *rout, long int *ipar, realtype *rpar, int *ier) { int lmm, iter; N_Vector Vatol; FCVUserData CV_userdata; *ier = 0; /* Check for required vector operations */ if(F2C_CVODE_vec->ops->nvgetarraypointer == NULL || F2C_CVODE_vec->ops->nvsetarraypointer == NULL) { *ier = -1; printf("A required vector operation is not implemented.\n\n"); return; } /* Initialize all pointers to NULL */ CV_cvodemem = NULL; Vatol = NULL; /* Create CVODE object */ lmm = (*meth == 1) ? CV_ADAMS : CV_BDF; iter = (*itmeth == 1) ? CV_FUNCTIONAL : CV_NEWTON; CV_cvodemem = CVodeCreate(lmm, iter); if (CV_cvodemem == NULL) { *ier = -1; return; } /* Set and attach user data */ CV_userdata = NULL; CV_userdata = (FCVUserData) malloc(sizeof *CV_userdata); if (CV_userdata == NULL) { *ier = -1; return; } CV_userdata->rpar = rpar; CV_userdata->ipar = ipar; *ier = CVodeSetUserData(CV_cvodemem, CV_userdata); if(*ier != CV_SUCCESS) { free(CV_userdata); CV_userdata = NULL; *ier = -1; return; } /* Set data in F2C_CVODE_vec to y0 */ N_VSetArrayPointer(y0, F2C_CVODE_vec); /* Call CVodeInit */ *ier = CVodeInit(CV_cvodemem, FCVf, *t0, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_CVODE_vec); /* On failure, exit */ if(*ier != CV_SUCCESS) { free(CV_userdata); CV_userdata = NULL; *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = CVodeSStolerances(CV_cvodemem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol = N_VCloneEmpty(F2C_CVODE_vec); if (Vatol == NULL) { free(CV_userdata); CV_userdata = NULL; *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = CVodeSVtolerances(CV_cvodemem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if(*ier != CV_SUCCESS) { free(CV_userdata); CV_userdata = NULL; *ier = -1; return; } /* Grab optional output arrays and store them in global variables */ CV_iout = iout; CV_rout = rout; /* Store the unit roundoff in rout for user access */ CV_rout[5] = UNIT_ROUNDOFF; return; } /***************************************************************************/ void FCV_REINIT(realtype *t0, realtype *y0, int *iatol, realtype *rtol, realtype *atol, int *ier) { N_Vector Vatol; *ier = 0; /* Initialize all pointers to NULL */ Vatol = NULL; /* Set data in F2C_CVODE_vec to y0 */ N_VSetArrayPointer(y0, F2C_CVODE_vec); /* Call CVReInit */ *ier = CVodeReInit(CV_cvodemem, *t0, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_CVODE_vec); /* On failure, exit */ if (*ier != CV_SUCCESS) { *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = CVodeSStolerances(CV_cvodemem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol = N_VCloneEmpty(F2C_CVODE_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = CVodeSVtolerances(CV_cvodemem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if (*ier != CV_SUCCESS) { *ier = -1; return; } return; } /***************************************************************************/ void FCV_SETIIN(char key_name[], long int *ival, int *ier, int key_len) { if (!strncmp(key_name,"MAX_ORD", (size_t)key_len)) *ier = CVodeSetMaxOrd(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"MAX_NSTEPS", (size_t)key_len)) *ier = CVodeSetMaxNumSteps(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"MAX_ERRFAIL", (size_t)key_len)) *ier = CVodeSetMaxErrTestFails(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"MAX_NITERS", (size_t)key_len)) *ier = CVodeSetMaxNonlinIters(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"MAX_CONVFAIL", (size_t)key_len)) *ier = CVodeSetMaxConvFails(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"HNIL_WARNS", (size_t)key_len)) *ier = CVodeSetMaxHnilWarns(CV_cvodemem, (int) *ival); else if (!strncmp(key_name,"STAB_LIM", (size_t)key_len)) *ier = CVodeSetStabLimDet(CV_cvodemem, (int) *ival); else { *ier = -99; printf("FCVSETIIN: Unrecognized key.\n\n"); } } /***************************************************************************/ void FCV_SETRIN(char key_name[], realtype *rval, int *ier, int key_len) { if (!strncmp(key_name,"INIT_STEP", (size_t)key_len)) *ier = CVodeSetInitStep(CV_cvodemem, *rval); else if (!strncmp(key_name,"MAX_STEP", (size_t)key_len)) *ier = CVodeSetMaxStep(CV_cvodemem, *rval); else if (!strncmp(key_name,"MIN_STEP", (size_t)key_len)) *ier = CVodeSetMinStep(CV_cvodemem, *rval); else if (!strncmp(key_name,"STOP_TIME", (size_t)key_len)) *ier = CVodeSetStopTime(CV_cvodemem, *rval); else if (!strncmp(key_name,"NLCONV_COEF", (size_t)key_len)) *ier = CVodeSetNonlinConvCoef(CV_cvodemem, *rval); else { *ier = -99; printf("FCVSETRIN: Unrecognized key.\n\n"); } } /***************************************************************************/ void FCV_DENSE(long int *neq, int *ier) { /* neq is the problem size */ *ier = CVDense(CV_cvodemem, *neq); CV_ls = CV_LS_DENSE; } /***************************************************************************/ void FCV_BAND(long int *neq, long int *mupper, long int *mlower, int *ier) { /* neq is the problem size mupper is the upper bandwidth mlower is the lower bandwidth */ *ier = CVBand(CV_cvodemem, *neq, *mupper, *mlower); CV_ls = CV_LS_BAND; } /***************************************************************************/ void FCV_DIAG(int *ier) { *ier = CVDiag(CV_cvodemem); CV_ls = CV_LS_DIAG; } /***************************************************************************/ void FCV_SPGMR(int *pretype, int *gstype, int *maxl, realtype *delt, int *ier) { /* pretype the preconditioner type maxl the maximum Krylov dimension gstype the Gram-Schmidt process type delt the linear convergence tolerance factor */ *ier = CVSpgmr(CV_cvodemem, *pretype, *maxl); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetGSType(CV_cvodemem, *gstype); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPGMR; } /***************************************************************************/ void FCV_SPBCG(int *pretype, int *maxl, realtype *delt, int *ier) { /* pretype the preconditioner type maxl the maximum Krylov dimension delt the linear convergence tolerance factor */ *ier = CVSpbcg(CV_cvodemem, *pretype, *maxl); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPBCG; } /***************************************************************************/ void FCV_SPTFQMR(int *pretype, int *maxl, realtype *delt, int *ier) { /* pretype the preconditioner type maxl the maximum Krylov dimension delt the linear convergence tolerance factor */ *ier = CVSptfqmr(CV_cvodemem, *pretype, *maxl); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPTFQMR; } /***************************************************************************/ void FCV_SPGMRREINIT(int *pretype, int *gstype, realtype *delt, int *ier) { /* pretype the preconditioner type gstype the Gram-Schmidt process type delt the linear convergence tolerance factor */ *ier = CVSpilsSetPrecType(CV_cvodemem, *pretype); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetGSType(CV_cvodemem, *gstype); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPGMR; } /***************************************************************************/ void FCV_SPBCGREINIT(int *pretype, int *maxl, realtype *delt, int *ier) { /* pretype the preconditioner type maxl the maximum Krylov subspace dimension delt the linear convergence tolerance factor */ *ier = CVSpilsSetPrecType(CV_cvodemem, *pretype); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetMaxl(CV_cvodemem, *maxl); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPBCG; } /***************************************************************************/ void FCV_SPTFQMRREINIT(int *pretype, int *maxl, realtype *delt, int *ier) { /* pretype the preconditioner type maxl the maximum Krylov subspace dimension delt the linear convergence tolerance factor */ *ier = CVSpilsSetPrecType(CV_cvodemem, *pretype); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetMaxl(CV_cvodemem, *maxl); if (*ier != CVSPILS_SUCCESS) return; *ier = CVSpilsSetEpsLin(CV_cvodemem, *delt); if (*ier != CVSPILS_SUCCESS) return; CV_ls = CV_LS_SPTFQMR; } /***************************************************************************/ void FCV_CVODE(realtype *tout, realtype *t, realtype *y, int *itask, int *ier) { /* tout is the t value where output is desired F2C_CVODE_vec is the N_Vector containing the solution on return t is the returned independent variable value itask is the task indicator (1 = CV_NORMAL, 2 = CV_ONE_STEP, 3 = CV_NORMAL_TSTOP, 4 = CV_ONE_STEP_TSTOP) */ int qu, qcur; N_VSetArrayPointer(y, F2C_CVODE_vec); *ier = CVode(CV_cvodemem, *tout, F2C_CVODE_vec, t, *itask); N_VSetArrayPointer(NULL, F2C_CVODE_vec); /* Load optional outputs in iout & rout */ CVodeGetWorkSpace(CV_cvodemem, &CV_iout[0], /* LENRW */ &CV_iout[1]); /* LENIW */ CVodeGetIntegratorStats(CV_cvodemem, &CV_iout[2], /* NST */ &CV_iout[3], /* NFE */ &CV_iout[7], /* NSETUPS */ &CV_iout[4], /* NETF */ &qu, /* QU */ &qcur, /* QCUR */ &CV_rout[0], /* H0U */ &CV_rout[1], /* HU */ &CV_rout[2], /* HCUR */ &CV_rout[3]); /* TCUR */ CV_iout[8] = (long int) qu; CV_iout[9] = (long int) qcur; CVodeGetTolScaleFactor(CV_cvodemem, &CV_rout[4]); /* TOLSFAC */ CVodeGetNonlinSolvStats(CV_cvodemem, &CV_iout[6], /* NNI */ &CV_iout[5]); /* NCFN */ CVodeGetNumStabLimOrderReds(CV_cvodemem, &CV_iout[10]); /* NOR */ /* Root finding is on */ if (CV_nrtfn != 0) CVodeGetNumGEvals(CV_cvodemem, &CV_iout[11]); /* NGE */ switch(CV_ls) { case CV_LS_DENSE: case CV_LS_BAND: case CV_LS_LAPACKDENSE: case CV_LS_LAPACKBAND: CVDlsGetWorkSpace(CV_cvodemem, &CV_iout[12], &CV_iout[13]); /* LENRWLS,LENIWLS */ CVDlsGetLastFlag(CV_cvodemem, &CV_iout[14]); /* LSTF */ CVDlsGetNumRhsEvals(CV_cvodemem, &CV_iout[15]); /* NFELS */ CVDlsGetNumJacEvals(CV_cvodemem, &CV_iout[16]); /* NJE */ break; case CV_LS_DIAG: CVDiagGetWorkSpace(CV_cvodemem, &CV_iout[12], &CV_iout[13]); /* LENRWLS,LENIWLS */ CVDiagGetLastFlag(CV_cvodemem, &CV_iout[14]); /* LSTF */ CVDiagGetNumRhsEvals(CV_cvodemem, &CV_iout[15]); /* NFELS */ break; case CV_LS_SPGMR: case CV_LS_SPBCG: case CV_LS_SPTFQMR: CVSpilsGetWorkSpace(CV_cvodemem, &CV_iout[12], &CV_iout[13]); /* LENRWLS,LENIWLS */ CVSpilsGetLastFlag(CV_cvodemem, &CV_iout[14]); /* LSTF */ CVSpilsGetNumRhsEvals(CV_cvodemem, &CV_iout[15]); /* NFELS */ CVSpilsGetNumJtimesEvals(CV_cvodemem, &CV_iout[16]); /* NJTV */ CVSpilsGetNumPrecEvals(CV_cvodemem, &CV_iout[17]); /* NPE */ CVSpilsGetNumPrecSolves(CV_cvodemem, &CV_iout[18]); /* NPS */ CVSpilsGetNumLinIters(CV_cvodemem, &CV_iout[19]); /* NLI */ CVSpilsGetNumConvFails(CV_cvodemem, &CV_iout[20]); /* NCFL */ } } /***************************************************************************/ void FCV_DKY (realtype *t, int *k, realtype *dky, int *ier) { /* t is the t value where output is desired k is the derivative order F2C_CVODE_vec is the N_Vector containing the solution derivative on return */ N_VSetArrayPointer(dky, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetDky(CV_cvodemem, *t, *k, F2C_CVODE_vec); N_VSetArrayPointer(NULL, F2C_CVODE_vec); } /*************************************************/ void FCV_GETERRWEIGHTS(realtype *eweight, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(eweight, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetErrWeights(CV_cvodemem, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_CVODE_vec); return; } /*************************************************/ void FCV_GETESTLOCALERR(realtype *ele, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(ele, F2C_CVODE_vec); *ier = 0; *ier = CVodeGetEstLocalErrors(CV_cvodemem, F2C_CVODE_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_CVODE_vec); return; } /***************************************************************************/ void FCV_FREE () { CVodeMem cv_mem; cv_mem = (CVodeMem) CV_cvodemem; free(cv_mem->cv_user_data); cv_mem->cv_user_data = NULL; CVodeFree(&CV_cvodemem); N_VSetArrayPointer(NULL, F2C_CVODE_vec); N_VDestroy(F2C_CVODE_vec); } /***************************************************************************/ /* * C function CVf to interface between CVODE and a Fortran subroutine FCVFUN. * Addresses of t, y, and ydot are passed to CVFUN, using the * routine N_VGetArrayPointer from the NVECTOR module. * Auxiliary data is assumed to be communicated by Common. */ int FCVf(realtype t, N_Vector y, N_Vector ydot, void *user_data) { int ier; realtype *ydata, *dydata; FCVUserData CV_userdata; ydata = N_VGetArrayPointer(y); dydata = N_VGetArrayPointer(ydot); CV_userdata = (FCVUserData) user_data; FCV_FUN(&t, ydata, dydata, CV_userdata->ipar, CV_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/CMakeLists.txt0000600000175000017500000000236411741421121021746 0ustar sylvestresylvestre# CMakeLists.txt file for the FCVODE library # Add variable fcvode_SOURCES with the sources for the FCVODE library SET(fcvode_SOURCES fcvband.c fcvbbd.c fcvbp.c fcvdense.c fcvewt.c fcvjtimes.c fcvode.c fcvpreco.c fcvroot.c ) IF(LAPACK_FOUND) SET(fcvode_BL_SOURCES fcvlapack.c fcvlapband.c fcvlapdense.c) ELSE(LAPACK_FOUND) SET(fcvode_BL_SOURCES "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files (both for fcvode and cvode) INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(..) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Only build STATIC libraries (we cannot build shared libraries # for the FCMIX interfaces due to unresolved symbol errors # coming from inexistent user-provided functions) # Add the build target for the FCVODE library ADD_LIBRARY(sundials_fcvode_static STATIC ${fcvode_SOURCES} ${fcvode_BL_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_fcvode_static PROPERTIES OUTPUT_NAME sundials_fcvode CLEAN_DIRECT_OUTPUT 1) # Install the FCVODE library INSTALL(TARGETS sundials_fcvode_static DESTINATION lib) # MESSAGE(STATUS "Added CVODE FCMIX module") sundials-2.5.0/src/cvode/fcmix/Makefile.in0000600000175000017500000001104111741421121021243 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FCVODE module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../../.. INCLUDES = -I$(top_srcdir)/include -I$(top_srcdir)/src/cvode -I$(top_builddir)/include LIB_REVISION = 0:1:0 FCVODE_LIB = libsundials_fcvode.la FCVODE_SRC_FILES = fcvode.c fcvband.c fcvdense.c fcvjtimes.c fcvpreco.c fcvbbd.c fcvbp.c fcvroot.c fcvewt.c FCVODE_BL_SRC_FILES = fcvlapack.c fcvlapband.c fcvlapdense.c FCVODE_OBJ_FILES = $(FCVODE_SRC_FILES:.c=.o) FCVODE_BL_OBJ_FILES = $(FCVODE_BL_SRC_FILES:.c=.o) FCVODE_LIB_FILES = $(FCVODE_SRC_FILES:.c=.lo) FCVODE_BL_LIB_FILES = $(FCVODE_BL_SRC_FILES:.c=.lo) mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(FCVODE_LIB) $(FCVODE_LIB): $(FCVODE_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: $(FCVODE_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FCVODE_LIB) $(FCVODE_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) lib_with_bl: $(FCVODE_LIB_FILES) $(FCVODE_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FCVODE_LIB) $(FCVODE_LIB_FILES) $(FCVODE_BL_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) install: $(FCVODE_LIB) $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(FCVODE_LIB) $(libdir) uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(FCVODE_LIB) clean: $(LIBTOOL) --mode=clean rm -f $(FCVODE_LIB) rm -f $(FCVODE_LIB_FILES) rm -f $(FCVODE_BL_LIB_FILES) rm -f $(FCVODE_OBJ_FILES) rm -f $(FCVODE_BL_OBJ_FILES) distclean: clean rm -f Makefile fcvode.lo: $(srcdir)/fcvode.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvode.c fcvewt.lo: $(srcdir)/fcvewt.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvewt.c fcvband.lo: $(srcdir)/fcvband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvband.c fcvdense.lo: $(srcdir)/fcvdense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvdense.c fcvlapack.lo: $(srcdir)/fcvlapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvlapack.c fcvlapband.lo: $(srcdir)/fcvlapband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvlapband.c fcvlapdense.lo: $(srcdir)/fcvlapdense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvlapdense.c fcvjtimes.lo: $(srcdir)/fcvjtimes.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvjtimes.c fcvpreco.lo: $(srcdir)/fcvpreco.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvpreco.c fcvbbd.lo: $(srcdir)/fcvbbd.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvbbd.c fcvbp.lo: $(srcdir)/fcvbp.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvbp.c fcvroot.lo: $(srcdir)/fcvroot.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fcvroot.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/cvode/fcmix/fcvewt.c0000600000175000017500000000416511741421121020651 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:28:59 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE, for the case of a * user-supplied error weight calculation routine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars. */ #include "cvode_impl.h" /* definition of CVodeMem type */ /***************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_EWT(realtype*, realtype*, /* Y, EWT */ long int*, realtype*, /* IPAR, RPAR */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ /* * User-callable function to interface to CVodeSetEwtFn. */ void FCV_EWTSET(int *flag, int *ier) { CVodeMem cv_mem; if (*flag != 0) { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVodeWFtolerances(CV_cvodemem, FCVEwtSet); } } /***************************************************************************/ /* * C function to interface between CVODE and a Fortran subroutine FCVEWT. */ int FCVEwtSet(N_Vector y, N_Vector ewt, void *user_data) { int ier = 0; realtype *ydata, *ewtdata; FCVUserData CV_userdata; ydata = N_VGetArrayPointer(y); ewtdata = N_VGetArrayPointer(ewt); CV_userdata = (FCVUserData) user_data; FCV_EWT(ydata, ewtdata, CV_userdata->ipar, CV_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvroot.h0000600000175000017500000001160211741421121021034 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the rootfinding * feature of CVODE. * ----------------------------------------------------------------- */ /* * ============================================================================== * * FCVROOT Interface Package * * The FCVROOT interface package allows programs written in FORTRAN to * use the rootfinding feature of the CVODE solver module. * * The user-callable functions constituting the FCVROOT package are the * following: FCVROOTINIT, FCVROOTINFO, and FCVROOTFREE. The corresponding * CVODE subroutine called by each interface function is given below. * * ----------------- ----------------------- * | FCVROOT routine | | CVODE function called | * ----------------- ----------------------- * FCVROOTINIT -> CVodeRootInit * FCVROOTINFO -> CVodeGetRootInfo * FCVROOTFREE -> CVodeRootInit * * FCVROOTFN is a user-supplied subroutine defining the functions whose * roots are sought. * * ============================================================================== * * Usage of the FCVROOT Interface Package * * 1. In order to use the rootfinding feature of the CVODE package the user must * define the following subroutine: * * SUBROUTINE FCVROOTFN (T, Y, G, IPAR, RPAR, IER) * DIMENSION Y(*), G(*), IPAR(*), RPAR(*) * * The arguments are: * T = independent variable value t [input] * Y = dependent variable vector y [input] * G = function values g(t,y) [output] * IPAR, RPAR = user (integer and real) data [input/output] * IER = return flag (0 for success, a non-zero value if an error occurred.) * * 2. After calling FCVMALLOC but prior to calling FCVODE, the user must * allocate and initialize memory for the FCVROOT module by making the * following call: * * CALL FCVROOTINIT (NRTFN, IER) * * The arguments are: * NRTFN = total number of root functions [input] * IER = return completion flag (0 = success, -1 = CVODE memory NULL and * -11 memory allocation error) [output] * * 3. After calling FCVODE, to see whether a root was found, test the FCVODE * return flag IER. The value IER = 2 means one or more roots were found. * * 4. If a root was found, and if NRTFN > 1, then to determine which root * functions G(*) were found to have a root, make the following call: * CALL FCVROOTINFO (NRTFN, INFO, IER) * The arguments are: * NRTFN = total number of root functions [input] * INFO = integer array of length NRTFN, with values 0 or 1 [output] * For i = 1,...,NRTFN, G(i) was found to have a root if INFO(i) = 1. * IER = completion flag (0 = success, negative = failure) * * 5. The total number of calls made to the root function (FCVROOTFN), NGE, * can be obtained from IOUT(12). * * If the FCVODE/CVODE memory block is reinitialized to solve a different * problem via a call to FCVREINIT, then the counter variable NGE is cleared * (reset to zero). * * 6. To free the memory resources allocated by a prior call to FCVROOTINIT make * the following call: * CALL FCVROOTFREE * See the CVODE documentation for additional information. * * ============================================================================== */ #ifndef _FCVROOT_H #define _FCVROOT_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* header files */ #include /* definition of type N_Vector */ #include /* definition of SUNDIALS type realtype */ /* Definitions of interface function names */ #if defined(SUNDIALS_F77_FUNC) #define FCV_ROOTINIT SUNDIALS_F77_FUNC(fcvrootinit, FCVROOTINIT) #define FCV_ROOTINFO SUNDIALS_F77_FUNC(fcvrootinfo, FCVROOTINFO) #define FCV_ROOTFREE SUNDIALS_F77_FUNC(fcvrootfree, FCVROOTFREE) #define FCV_ROOTFN SUNDIALS_F77_FUNC(fcvrootfn, FCVROOTFN) #else #define FCV_ROOTINIT fcvrootinit_ #define FCV_ROOTINFO fcvrootinfo_ #define FCV_ROOTFREE fcvrootfree_ #define FCV_ROOTFN fcvrootfn_ #endif /* Prototypes of exported function */ void FCV_ROOTINIT(int *nrtfn, int *ier); void FCV_ROOTINFO(int *nrtfn, int *info, int *ier); void FCV_ROOTFREE(void); /* Prototype of function called by CVODE module */ int FCVrootfunc(realtype t, N_Vector y, realtype *gout, void *user_data); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/fcmix/fcvbp.c0000600000175000017500000000422511741421121020450 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/09/30 20:51:36 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This module contains the routines necessary to interface with the * CVBANDPRE module and user-supplied Fortran routines. * The routines here call the generically named routines and provide * a standard interface to the C code of the CVBANDPRE package. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "fcvbp.h" /* prototypes of interfaces to CVBANDPRE */ #include /* prototypes of CVBANDPRE functions and macros */ #include /* prototypes of CVSPTFQMR interface routines */ #include /* prototypes of CVSPBCG interface routines */ #include /* prototypes of CVSPGMR interface routines */ /***************************************************************************/ void FCV_BPINIT(long int *N, long int *mu, long int *ml, int *ier) { /* Call CVBandPrecInit to initialize the CVBANDPRE module: N is the vector size mu, ml are the half-bandwidths of the retained preconditioner blocks */ *ier = CVBandPrecInit(CV_cvodemem, *N, *mu, *ml); return; } /***************************************************************************/ /* C function FCVBPOPT to access optional outputs from CVBANDPRE_Data */ void FCV_BPOPT(long int *lenrwbp, long int *leniwbp, long int *nfebp) { CVBandPrecGetWorkSpace(CV_cvodemem, lenrwbp, leniwbp); CVBandPrecGetNumRhsEvals(CV_cvodemem, nfebp); } sundials-2.5.0/src/cvode/fcmix/fcvode.h0000600000175000017500000010603611741421121020626 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for FCVODE, the Fortran interface to * the CVODE package. * ----------------------------------------------------------------- */ /* * ============================================================================= * * FCVODE Interface Package * * The FCVODE Interface Package is a package of C functions which support * the use of the CVODE solver, for the solution of ODE systems * dy/dt = f(t,y), in a mixed Fortran/C setting. While CVODE is written * in C, it is assumed here that the user's calling program and * user-supplied problem-defining routines are written in Fortran. * This package provides the necessary interface to CVODE for both the * serial and the parallel NVECTOR implementations. * * The user-callable functions, with the corresponding CVODE functions, * are as follows: * * FNVINITS and FNVINITP interface to N_VNew_Serial and * N_VNew_Parallel, respectively * * FCVMALLOC interfaces to CVodeCreate, CVodeSetUserData, and CVodeInit * * FCVREINIT interfaces to CVReInit * * FCVSETIIN and FCVSETRIN interface to CVodeSet* * * FCVEWTSET interfaces to CVodeWFtolerances * * FCVDIAG interfaces to CVDiag * * FCVDENSE interfaces to CVDense * FCVDENSESETJAC interfaces to CVDenseSetJacFn * * FCVBAND interfaces to CVBand * FCVBANDSETJAC interfaces to CVBandSetJacFn * * FCVLAPACKDENSE interfaces to CVLapackDense * FCVLAPACKBAND interfaces to CVLapackBand * FCVLAPACKDENSESETJAC interfaces to CVLapackSetJacFn * FCVLAPACKBANDSETJAC interfaces to CVLapackSetJacFn * * FCVSPGMR and FCVSPGMRREINIT interface to CVSpgmr and CVSpilsSet* * FCVSPBCG, FCVSPBCGREINIT interface to CVSpbcg and CVSpilsSet* * FCVSPTFQMR, FCVSPTFQMRREINIT interface to CVSptfqmr and CVSpilsSet* * * FCVSPILSSETJAC interfaces to CVSpilsSetJacTimesVecFn * FCVSPILSSETPREC interfaces to CVSpilsSetPreconditioner * * FCVODE interfaces to CVode, CVodeGet*, and CV*Get* * * FCVDKY interfaces to CVodeGetDky * * FCVGETERRWEIGHTS interfaces to CVodeGetErrWeights * * FCVGETESTLOCALERR interfaces to CVodeGetEstLocalErrors * * FCVFREE interfaces to CVodeFree * * The user-supplied functions, each listed with the corresponding interface * function which calls it (and its type within CVODE), are as follows: * FCVFUN is called by the interface function FCVf of type CVRhsFn * FCVDJAC is called by the interface fn. FCVDenseJac of type CVDenseJacFn * FCVBJAC is called by the interface fn. FCVBandJac of type CVBandJacFn * FCVLDJAC is called by the interface fn. FCVLapackDenseJac of type CVLapackJacFn * FCVLBJAC is called by the interface fn. FCVLapackBandJac of type CVLapackJacFn * FCVPSOL is called by the interface fn. FCVPSol of type CVSpilsPrecSolveFn * FCVPSET is called by the interface fn. FCVPSet of type CVSpilsPrecSetupFn * FCVJTIMES is called by interface fn. FCVJtimes of type CVSpilsJacTimesVecFn * FCVEWT is called by interface fn. FCVEwtSet of type CVEwtFn * In contrast to the case of direct use of CVODE, and of most Fortran ODE * solvers, the names of all user-supplied routines here are fixed, in * order to maximize portability for the resulting mixed-language program. * * Important note on portability. * In this package, the names of the interface functions, and the names of * the Fortran user routines called by them, appear as dummy names * which are mapped to actual values by a series of definitions, in this * and other header files. * * ============================================================================= * * Usage of the FCVODE Interface Package * * The usage of FCVODE requires calls to five or more interface * functions, depending on the method options selected, and one or more * user-supplied routines which define the problem to be solved. These * function calls and user routines are summarized separately below. * * Some details are omitted, and the user is referred to the user documents * on CVODE for more complete documentation. Information on the * arguments of any given user-callable interface routine, or of a given * user-supplied function called by an interface function, can be found in * the documentation on the corresponding function in the CVODE package. * * The number labels on the instructions below end with s for instructions * that apply to the serial version of CVODE only, and end with p for * those that apply to the parallel version only. * * ----------------------------------------------------------------------------- * * (1) User-supplied right-hand side routine: FCVFUN * The user must in all cases supply the following Fortran routine * SUBROUTINE FCVFUN (T, Y, YDOT, IPAR, RPAR, IER) * DIMENSION Y(*), YDOT(*), IPAR(*), RPAR(*) * It must set the YDOT array to f(t,y), the right-hand side of the ODE * system, as function of T = t and the array Y = y. Here Y and YDOT * are distributed vectors. IPAR and RPAR are arrays of integer and real user * data, respectively as passed to FCVMALLOC. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * (2s) Optional user-supplied dense Jacobian approximation routine: FCVDJAC * As an option when using the DENSE linear solver, the user may supply a * routine that computes a dense approximation of the system Jacobian * J = df/dy. If supplied, it must have the following form: * SUBROUTINE FCVDJAC (NEQ, T, Y, FY, DJAC, H, IPAR, RPAR, WK1, WK2, WK3, IER) * DIMENSION Y(*), FY(*), DJAC(NEQ,*), IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) * Typically this routine will use only NEQ, T, Y, and DJAC. It must compute * the Jacobian and store it columnwise in DJAC. * IPAR and RPAR are user (integer and real) arrays passed to FCVMALLOC. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * (3s) Optional user-supplied band Jacobian approximation routine: FCVBJAC * As an option when using the BAND linear solver, the user may supply a * routine that computes a band approximation of the system Jacobian * J = df/dy. If supplied, it must have the following form: * SUBROUTINE FCVBJAC (NEQ, MU, ML, MDIM, T, Y, FY, BJAC, H, * 1 IPAR, RPAR, WK1, WK2, WK3, IER) * DIMENSION Y(*), FY(*), BJAC(MDIM,*), IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) * Typically this routine will use only NEQ, MU, ML, T, Y, and BJAC. * It must load the MDIM by N array BJAC with the Jacobian matrix at the * current (t,y) in band form. Store in BJAC(k,j) the Jacobian element J(i,j) * with k = i - j + MU + 1 (k = 1 ... ML+MU+1) and j = 1 ... N. * IPAR and RPAR are user (integer and real) arrays passed to FCVMALLOC. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * (4s) Optional user-supplied Lapack dense Jacobian routine: FCVLDJAC * See the description for FCVDJAC. NOTE: the dense Jacobian matrix * is NOT set to zero before calling the user's FCVLDJAC. * * (5s) Optional user-supplied Lapack band Jacobian routine: FCVLBJAC * See the description for FCVBJAC. NOTE: the band Jacobian matrix * is NOT set to zero before calling the user's FCVLBJAC. * * (6) Optional user-supplied Jacobian-vector product routine: FCVJTIMES * As an option when using the SP* linear solver, the user may supply * a routine that computes the product of the system Jacobian J = df/dy and * a given vector v. If supplied, it must have the following form: * SUBROUTINE FCVJTIMES (V, FJV, T, Y, FY, H, IPAR, RPAR, WORK, IER) * DIMENSION V(*), FJV(*), Y(*), FY(*), IPAR(*), RPAR(*), WORK(*) * Typically this routine will use only NEQ, T, Y, V, and FJV. It must * compute the product vector Jv where the vector v is stored in V, and store * the product in FJV. On return, set IER = 0 if FCVJTIMES was successful, * and nonzero otherwise. * IPAR and RPAR are user (integer and real) arrays passed to FCVMALLOC. * * (7) Optional user-supplied error weight vector routine: FCVEWT * As an option to providing the relative and absolute tolerances, the user * may supply a routine that computes the weights used in the WRMS norms. * If supplied, it must have the following form: * SUBROUTINE FCVEWT (Y, EWT, IPAR, RPAR, IER) * DIMENSION Y(*), EWT(*), IPAR(*), RPAR(*) * It must store the error weights in EWT, given the current solution vector Y. * On return, set IER = 0 if successful, and nonzero otherwise. * IPAR and RPAR are user (integer and real) arrays passed to FCVMALLOC. * * ----------------------------------------------------------------------------- * * (8) Initialization: FNVINITS / FNVINITP , FCVMALLOC, FCVREINIT * * (8.1s) To initialize the serial machine environment, the user must make * the following call: * CALL FNVINITS (1, NEQ, IER) * where the first argument is the CVODE solver ID. The other arguments are: * NEQ = size of vectors * IER = return completion flag. Values are 0 = success, -1 = failure. * * (8.1p) To initialize the parallel machine environment, the user must make * the following call: * CALL FNVINITP (1, NLOCAL, NGLOBAL, IER) * The arguments are: * NLOCAL = local size of vectors on this processor * NGLOBAL = the system size, and the global size of vectors (the sum * of all values of NLOCAL) * IER = return completion flag. Values are 0 = success, -1 = failure. * Note: If MPI was initialized by the user, the communicator must be * set to MPI_COMM_WORLD. If not, this routine initializes MPI and sets * the communicator equal to MPI_COMM_WORLD. * * (8.2) To set various problem and solution parameters and allocate * internal memory, make the following call: * CALL FCVMALLOC(T0, Y0, METH, ITMETH, IATOL, RTOL, ATOL, * 1 IOUT, ROUT, IPAR, RPAR, IER) * The arguments are: * T0 = initial value of t * Y0 = array of initial conditions * METH = basic integration method: 1 = Adams (nonstiff), 2 = BDF (stiff) * ITMETH = nonlinear iteration method: 1=functional iteration, 2=Newton iter. * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array. * If IATOL = 3, then the user must supply a routine FCVEWT to compute * the error weight vector. * RTOL = relative tolerance (scalar) * ATOL = absolute tolerance (scalar or array) * IOUT = array of length 21 for integer optional outputs * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * ROUT = array of length 6 for real optional outputs * IPAR = array with user integer data * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * RPAR = array with user real data * IER = return completion flag. Values are 0 = SUCCESS, and -1 = failure. * See printed message for details in case of failure. * * The user data arrays IPAR and RPAR are passed unmodified to all subsequent * calls to user-provided routines. Modifications to either array inside a * user-provided routine will be propagated. Using these two arrays, the user * can dispense with Common blocks to pass data betwen user-provided routines. * * The optional outputs are: * LENRW = IOUT( 1) from CVodeGetWorkSpace * LENIW = IOUT( 2) from CVodeGetWorkSpace * NST = IOUT( 3) from CVodeGetNumSteps * NFE = IOUT( 4) from CVodeGetNumRhsEvals * NETF = IOUT( 5) from CVodeGetNumErrTestFails * NCFN = IOUT( 6) from CVodeGetNumNonlinSolvConvFails * NNI = IOUT( 7) from CVodeGetNumNonlinSolvIters * NSETUPS = IOUT( 8) from CVodeGetNumLinSolvSetups * QU = IOUT( 9) from CVodeGetLastOrder * QCUR = IOUT(10) from CVodeGetCurrentOrder * NOR = IOUT(11) from CVodeGetNumStabLimOrderReds * NGE = IOUT(12) from CVodeGetNumGEvals * * H0U = ROUT( 1) from CVodeGetActualInitStep * HU = ROUT( 2) from CVodeGetLastStep * HCUR = ROUT( 3) from CVodeGetCurrentStep * TCUR = ROUT( 4) from CVodeGetCurrentTime * TOLSF = ROUT( 5) from CVodeGetTolScaleFactor * UROUND = ROUT( 6) from UNIT_ROUNDOFF * See the CVODE manual for details. * * If the user program includes the FCVEWT routine for the evaluation of the * error weights, the following call must be made * CALL FCVEWTSET(FLAG, IER) * with FLAG = 1 to specify that FCVEWT is provided. * The return flag IER is 0 if successful, and nonzero otherwise. * * (8.3) To re-initialize the CVODE solver for the solution of a new problem * of the same size as one already solved, make the following call: * CALL FCVREINIT(T0, Y0, IATOL, RTOL, ATOL, IER) * The arguments have the same names and meanings as those of FCVMALLOC, * except that METH and ITMETH have been omitted from the argument list * (being unchanged for the new problem). * FCVREINIT performs the same initializations as FCVMALLOC, but does no memory * allocation, using instead the existing internal memory created by the * previous FCVMALLOC call. The call to specify the linear system solution * method may or may not be needed; see paragraph (7) below. * * (8.4) To set various integer optional inputs, make the folowing call: * CALL FCVSETIIN(KEY, VALUE, IER) * to set the integer value VAL to the optional input specified by the * quoted character string KEY. * KEY is one of the following: MAX_ORD, MAX_NSTEPS, MAX_ERRFAIL, MAX_NITERS, * MAX_CONVFAIL, HNIL_WARNS, STAB_LIM. * * To set various real optional inputs, make the folowing call: * CALL FCVSETRIN(KEY, VALUE, IER) * to set the real value VAL to the optional input specified by the * quoted character string KEY. * KEY is one of the following: INIT_STEP, MAX_STEP, MIN_STEP, STOP_TIME, * NLCONV_COEF. * * FCVSETIIN and FCVSETRIN return IER = 0 if successful and IER < 0 if an * error occured. * * ----------------------------------------------------------------------------- * * (9) Specification of linear system solution method. * In the case of a stiff system, the implicit BDF method involves the solution * of linear systems related to the Jacobian J = df/dy of the ODE system. * CVODE presently includes four choices for the treatment of these systems, * and the user of FCVODE must call a routine with a specific name to make the * desired choice. * * (9.1) Diagonal approximate Jacobian. * This choice is appropriate when the Jacobian can be well approximated by * a diagonal matrix. The user must make the call: * CALL FCVDIAG(IER) * IER is an error return flag: 0 = success, negative value = error. * There is no additional user-supplied routine. * * Optional outputs specific to the DIAG case are: * LENRWLS = IOUT(13) from CVDiagGetWorkSpace * LENIWLS = IOUT(14) from CVDiagGetWorkSpace * LSTF = IOUT(15) from CVDiagGetLastFlag * NFELS = IOUT(16) from CVDiagGetNumRhsEvals * See the CVODE manual for descriptions. * * (9.2s) DENSE treatment of the linear system. * The user must make the call * CALL FCVDENSE(NEQ, IER) * The argument is: * IER = error return flag: 0 = success , negative value = an error occured * * If the user program includes the FCVDJAC routine for the evaluation of the * dense approximation to the Jacobian, the following call must be made * CALL FCVDENSESETJAC(FLAG, IER) * with FLAG = 1 to specify that FCVDJAC is provided. (FLAG = 0 specifies * using the internal finite differences approximation to the Jacobian.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Optional outputs specific to the DENSE case are: * LENRWLS = IOUT(13) from CVDenseGetWorkSpace * LENIWLS = IOUT(14) from CVDenseGetWorkSpace * LSTF = IOUT(15) from CVDenseGetLastFlag * NFELS = IOUT(16) from CVDenseGetNumRhsEvals * NJED = IOUT(17) from CVDenseGetNumJacEvals * See the CVODE manual for descriptions. * * (9.3s) BAND treatment of the linear system * The user must make the call * CALL FCVBAND(NEQ, MU, ML, IER) * The arguments are: * MU = upper bandwidth * ML = lower bandwidth * IER = error return flag: 0 = success , negative value = an error occured * * If the user program includes the FCVBJAC routine for the evaluation of the * band approximation to the Jacobian, the following call must be made * CALL FCVBANDSETJAC(FLAG, IER) * with FLAG = 1 to specify that FCVBJAC is provided. (FLAG = 0 specifies * using the internal finite differences approximation to the Jacobian.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Optional outputs specific to the BAND case are: * LENRWLS = IOUT(13) from CVBandGetWorkSpace * LENIWLS = IOUT(14) from CVBandGetWorkSpace * LSTF = IOUT(15) from CVBandGetLastFlag * NFELS = IOUT(16) from CVBandGetNumRhsEvals * NJEB = IOUT(17) from CVBandGetNumJacEvals * See the CVODE manual for descriptions. * * (9.4s) LAPACK dense treatment of the linear system * The user must make the call * CALL FCVLAPACKDENSE(NEQ, IER) * and, optionally * CALL FCVLAPACKDENSESETJAC(FLAG, IER) * with FLAG=1 if the user provides the function FCVLDJAC. * See (9.2s) for more details. * * (9.5s) LAPACK band treatment of the linear system * The user must make the call * CALL FCVLAPACKBAND(NEQ, IER) * and, optionally * CALL FCVLAPACKBANDSETJAC(FLAG, IER) * with FLAG=1 if the user provides the function FCVLBJAC. * See (9.3s) * * (9.6) SPGMR treatment of the linear systems. * For the Scaled Preconditioned GMRES solution of the linear systems, * the user must make the following call: * CALL FCVSPGMR(IPRETYPE, IGSTYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides * IGSTYPE = Gram-schmidt process type: * 1 = modified G-S * 2 = classical G-S. * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = error return flag: 0 = success; negative value = an error occured * * * Optional outputs specific to the SPGMR case are: * LENRWLS = IOUT(13) from CVSpgmrGetWorkSpace * LENIWLS = IOUT(14) from CVSpgmrGetWorkSpace * LSTF = IOUT(15) from CVSpgmrGetLastFlag * NFELS = IOUT(16) from CVSpgmrGetRhsEvals * NJTV = IOUT(17) from CVSpgmrGetJtimesEvals * NPE = IOUT(18) from CVSpgmrGetPrecEvals * NPS = IOUT(19) from CVSpgmrGetPrecSolves * NLI = IOUT(20) from CVSpgmrGetLinIters * NCFL = IOUT(21) from CVSpgmrGetConvFails * See the CVODE manual for descriptions. * * If a sequence of problems of the same size is being solved using the * SPGMR linear solver, then following the call to FCVREINIT, a call to the * FCVSPGMRREINIT routine is needed if any of IPRETYPE, IGSTYPE, DELT is * being changed. In that case, call FCVSPGMRREINIT as follows: * CALL FCVSPGMRREINIT(IPRETYPE, IGSTYPE, DELT, IER) * The arguments have the same meanings as for FCVSPGMR. If MAXL is being * changed, then call FCVSPGMR instead. * * (9.7) SPBCG treatment of the linear systems. * For the Scaled Preconditioned Bi-CGSTAB solution of the linear systems, * the user must make the following call: * CALL FCVSPBCG(IPRETYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = error return flag: 0 = success; negative value = an error occured * * Optional outputs specific to the SPBCG case are: * LENRWLS = IOUT(13) from CVSpbcgGetWorkSpace * LENIWLS = IOUT(14) from CVSpbcgGetWorkSpace * LSTF = IOUT(15) from CVSpbcgGetLastFlag * NFELS = IOUT(16) from CVSpbcgGetRhsEvals * NJTV = IOUT(17) from CVSpbcgGetJtimesEvals * NPE = IOUT(18) from CVSpbcgGetPrecEvals * NPS = IOUT(19) from CVSpbcgGetPrecSolves * NLI = IOUT(20) from CVSpbcgGetLinIters * NCFL = IOUT(21) from CVSpbcgGetConvFails * See the CVODE manual for descriptions. * * If a sequence of problems of the same size is being solved using the * SPBCG linear solver, then following the call to FCVREINIT, a call to the * FCVSPBCGREINIT routine is needed if any of its arguments is * being changed. The call is: * CALL FCVSPBCGREINIT(IPRETYPE, MAXL, DELT, IER) * The arguments have the same meanings as for FCVSPBCG. * * (9.8) SPTFQMR treatment of the linear systems. * For the Scaled Preconditioned TFQMR solution of the linear systems, * the user must make the following call: * CALL FCVSPTFQMR(IPRETYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = error return flag: 0 = success; negative value = an error occured * * Optional outputs specific to the SPTFQMR case are: * LENRWLS = IOUT(13) from CVSptfqmrGetWorkSpace * LENIWLS = IOUT(14) from CVSptfqmrGetWorkSpace * LSTF = IOUT(15) from CVSptfqmrGetLastFlag * NFELS = IOUT(16) from CVSptfqmrGetRhsEvals * NJTV = IOUT(17) from CVSptfqmrGetJtimesEvals * NPE = IOUT(18) from CVSptfqmrGetPrecEvals * NPS = IOUT(19) from CVSptfqmrGetPrecSolves * NLI = IOUT(20) from CVSptfqmrGetLinIters * NCFL = IOUT(21) from CVSptfqmrGetConvFails * See the CVODE manual for descriptions. * * If a sequence of problems of the same size is being solved using the * SPTFQMR linear solver, then following the call to FCVREINIT, a call to the * FCVSPTFQMRREINIT routine is needed if any of its arguments is * being changed. The call is: * CALL FCVSPTFQMRREINIT(IPRETYPE, MAXL, DELT, IER) * The arguments have the same meanings as for FCVSPTFQMR. * * (9.9) Usage of user-supplied routines for the Krylov solvers * * If the user program includes the FCVJTIMES routine for the evaluation of the * Jacobian vector product, the following call must be made * CALL FCVSPILSSETJAC(FLAG, IER) * with FLAG = 1 to specify that FCVJTIMES is provided. (FLAG = 0 specifies * using and internal finite difference approximation to this product.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Usage of the user-supplied routines FCVPSOL and FCVPSET for solution of the * preconditioner linear system requires the following call: * CALL FCVSPILSSETPREC(FLAG, IER) * with FLAG = 1. The return flag IER is 0 if successful, nonzero otherwise. * The user-supplied routine FCVPSOL must have the form: * SUBROUTINE FCVPSOL (T,Y,FY,R,Z,GAMMA,DELTA,LR,IPAR,RPAR,VT,IER) * DIMENSION Y(*), FY(*), VT(*), R(*), Z(*), IPAR(*), RPAR(*) * Typically this routine will use only NEQ, T, Y, GAMMA, R, LR, and Z. It * must solve the preconditioner linear system Pz = r, where r = R is input, * and store the solution z in Z. Here P is the left preconditioner if LR = 1 * and the right preconditioner if LR = 2. The preconditioner (or the product * of the left and right preconditioners if both are nontrivial) should be an * approximation to the matrix I - GAMMA*J (I = identity, J = Jacobian). * IPAR and RPAR are user (integer and real) arrays passed to FCVMALLOC. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * ----------------------------------------------------------------------------- * * (10) The integrator: FCVODE * Carrying out the integration is accomplished by making calls as follows: * CALL FCVODE (TOUT, T, Y, ITASK, IER) * The arguments are: * TOUT = next value of t at which a solution is desired (input) * T = value of t reached by the solver on output * Y = array containing the computed solution on output * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate) * 2 = one-step mode (return after each internal step taken) * 3 = normal tstop mode (like 1, but integration never proceeds past * TSTOP, which must be specified through a call to FCVSETRIN * using the key 'STOP_TIME') * 4 = one step tstop (like 2, but integration never goes past TSTOP) * IER = completion flag: 0 = success, 1 = tstop return, 2 = root return, * values -1 ... -10 are various failure modes (see CVODE manual). * The current values of the optional outputs are available in IOUT and ROUT. * * ----------------------------------------------------------------------------- * * (11) Computing solution derivatives: FCVDKY * To obtain a derivative of the solution, of order up to the current method * order, make the following call: * CALL FCVDKY (T, K, DKY, IER) * The arguments are: * T = value of t at which solution derivative is desired, in [TCUR-HU,TCUR]. * K = derivative order (0 .le. K .le. QU) * DKY = array containing computed K-th derivative of y on return * IER = return flag: = 0 for success, < 0 for illegal argument. * * ----------------------------------------------------------------------------- * * (12) Memory freeing: FCVFREE * To free the internal memory created by the calls to FCVMALLOC and * FNVINITS or FNVINITP, make the call * CALL FCVFREE * * ============================================================================= */ #ifndef _FCVODE_H #define _FCVODE_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* header files */ #include #include /* definition of type DlsMat */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ /* Definitions of interface function names */ #if defined(SUNDIALS_F77_FUNC) #define FCV_MALLOC SUNDIALS_F77_FUNC(fcvmalloc, FCVMALLOC) #define FCV_REINIT SUNDIALS_F77_FUNC(fcvreinit, FCVREINIT) #define FCV_SETIIN SUNDIALS_F77_FUNC(fcvsetiin, FCVSETIIN) #define FCV_SETRIN SUNDIALS_F77_FUNC(fcvsetrin, FCVSETRIN) #define FCV_EWTSET SUNDIALS_F77_FUNC(fcvewtset, FCVEWTSET) #define FCV_DIAG SUNDIALS_F77_FUNC(fcvdiag, FCVDIAG) #define FCV_DENSE SUNDIALS_F77_FUNC(fcvdense, FCVDENSE) #define FCV_DENSESETJAC SUNDIALS_F77_FUNC(fcvdensesetjac, FCVDENSESETJAC) #define FCV_BAND SUNDIALS_F77_FUNC(fcvband, FCVBAND) #define FCV_BANDSETJAC SUNDIALS_F77_FUNC(fcvbandsetjac, FCVBANDSETJAC) #define FCV_LAPACKDENSE SUNDIALS_F77_FUNC(fcvlapackdense, FCVLAPACKDENSE) #define FCV_LAPACKDENSESETJAC SUNDIALS_F77_FUNC(fcvlapackdensesetjac, FCVLAPACKDENSESETJAC) #define FCV_LAPACKBAND SUNDIALS_F77_FUNC(fcvlapackband, FCVLAPACKBAND) #define FCV_LAPACKBANDSETJAC SUNDIALS_F77_FUNC(fcvlapackbandsetjac, FCVLAPACKBANDSETJAC) #define FCV_SPTFQMR SUNDIALS_F77_FUNC(fcvsptfqmr, FCVSPTFQMR) #define FCV_SPTFQMRREINIT SUNDIALS_F77_FUNC(fcvsptfqmrreinit, FCVSPTFQMRREINIT) #define FCV_SPBCG SUNDIALS_F77_FUNC(fcvspbcg, FCVSPBCG) #define FCV_SPBCGREINIT SUNDIALS_F77_FUNC(fcvspbcgreinit, FCVSPBCGREINIT) #define FCV_SPGMR SUNDIALS_F77_FUNC(fcvspgmr, FCVSPGMR) #define FCV_SPGMRREINIT SUNDIALS_F77_FUNC(fcvspgmrreinit, FCVSPGMRREINIT) #define FCV_SPILSSETJAC SUNDIALS_F77_FUNC(fcvspilssetjac, FCVSPILSSETJAC) #define FCV_SPILSSETPREC SUNDIALS_F77_FUNC(fcvspilssetprec, FCVSPILSSETPREC) #define FCV_CVODE SUNDIALS_F77_FUNC(fcvode, FCVODE) #define FCV_DKY SUNDIALS_F77_FUNC(fcvdky, FCVDKY) #define FCV_FREE SUNDIALS_F77_FUNC(fcvfree, FCVFREE) #define FCV_FUN SUNDIALS_F77_FUNC(fcvfun, FCVFUN) #define FCV_DJAC SUNDIALS_F77_FUNC(fcvdjac, FCVDJAC) #define FCV_BJAC SUNDIALS_F77_FUNC(fcvbjac, FCVBJAC) #define FCV_PSOL SUNDIALS_F77_FUNC(fcvpsol, FCVPSOL) #define FCV_PSET SUNDIALS_F77_FUNC(fcvpset, FCVPSET) #define FCV_JTIMES SUNDIALS_F77_FUNC(fcvjtimes, FCVJTIMES) #define FCV_EWT SUNDIALS_F77_FUNC(fcvewt, FCVEWT) #define FCV_GETERRWEIGHTS SUNDIALS_F77_FUNC(fcvgeterrweights, FCVGETERRWEIGHTS) #define FCV_GETESTLOCALERR SUNDIALS_F77_FUNC(fcvgetestlocalerr, FCVGETESTLOCALERR) #else #define FCV_MALLOC fcvmalloc_ #define FCV_REINIT fcvreinit_ #define FCV_SETIIN fcvsetiin_ #define FCV_SETRIN fcvsetrin_ #define FCV_EWTSET fcvewtset_ #define FCV_DIAG fcvdiag_ #define FCV_DENSE fcvdense_ #define FCV_DENSESETJAC fcvdensesetjac_ #define FCV_BAND fcvband_ #define FCV_BANDSETJAC fcvbandsetjac_ #define FCV_LAPACKDENSE fcvlapackdense_ #define FCV_LAPACKDENSESETJAC fcvlapackdensesetjac_ #define FCV_LAPACKBAND fcvlapackband_ #define FCV_LAPACKBANDSETJAC fcvlapackbandsetjac_ #define FCV_SPTFQMR fcvsptfqmr_ #define FCV_SPTFQMRREINIT fcvsptfqmrreinit_ #define FCV_SPBCG fcvspbcg_ #define FCV_SPBCGREINIT fcvspbcgreinit_ #define FCV_SPGMR fcvspgmr_ #define FCV_SPGMRREINIT fcvspgmrreinit_ #define FCV_SPILSSETJAC fcvspilssetjac_ #define FCV_SPILSSETPREC fcvspilssetprec_ #define FCV_CVODE fcvode_ #define FCV_DKY fcvdky_ #define FCV_FREE fcvfree_ #define FCV_FUN fcvfun_ #define FCV_DJAC fcvdjac_ #define FCV_BJAC fcvbjac_ #define FCV_PSOL fcvpsol_ #define FCV_PSET fcvpset_ #define FCV_JTIMES fcvjtimes_ #define FCV_EWT fcvewt_ #define FCV_GETERRWEIGHTS fcvgeterrweights_ #define FCV_GETESTLOCALERR fcvgetestlocalerr_ #endif /* Type for user data */ typedef struct { realtype *rpar; long int *ipar; } *FCVUserData; /* Prototypes of exported functions */ void FCV_MALLOC(realtype *t0, realtype *y0, int *meth, int *itmeth, int *iatol, realtype *rtol, realtype *atol, long int *iout, realtype *rout, long int *ipar, realtype *rpar, int *ier); void FCV_REINIT(realtype *t0, realtype *y0, int *iatol, realtype *rtol, realtype *atol, int *ier); void FCV_SETIIN(char key_name[], long int *ival, int *ier, int key_len); void FCV_SETRIN(char key_name[], realtype *rval, int *ier, int key_len); void FCV_EWTSET(int *flag, int *ier); void FCV_DIAG(int *ier); void FCV_DENSE(long int *neq, int *ier); void FCV_DENSESETJAC(int *flag, int *ier); void FCV_BAND(long int *neq, long int *mupper, long int *mlower, int *ier); void FCV_BANDSETJAC(int *flag, int *ier); void FCV_LAPACKDENSE(int *neq, int *ier); void FCV_LAPACKDENSESETJAC(int *flag, int *ier); void FCV_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier); void FCV_LAPACKBANDSETJAC(int *flag, int *ier); void FCV_SPGMR(int *pretype, int *gstype, int *maxl, realtype *delt, int *ier); void FCV_SPGMRREINIT(int *pretype, int *gstype, realtype *delt, int *ier); void FCV_SPBCG(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_SPBCGREINIT(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_SPTFQMR(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_SPTFQMRREINIT(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_SPILSSETJAC(int *flag, int *ier); void FCV_SPILSSETPREC(int *flag, int *ier); void FCV_CVODE(realtype *tout, realtype *t, realtype *y, int *itask, int *ier); void FCV_DKY(realtype *t, int *k, realtype *dky, int *ier); void FCV_GETERRWEIGHTS(realtype *eweight, int *ier); void FCV_GETESTLOCALERR(realtype *ele, int *ier); void FCV_FREE(void); /* Prototypes: Functions Called by the CVODE Solver */ int FCVf(realtype t, N_Vector y, N_Vector ydot, void *user_data); int FCVDenseJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FCVBandJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FCVLapackDenseJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int FCVLapackBandJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int FCVPSet(realtype tn, N_Vector y,N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FCVPSol(realtype tn, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); int FCVJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector work); int FCVEwtSet(N_Vector y, N_Vector ewt, void *user_data); /* Declarations for global variables shared amongst various routines */ extern N_Vector F2C_CVODE_vec; /* defined in FNVECTOR module */ extern void *CV_cvodemem; /* defined in fcvode.c */ extern long int *CV_iout; /* defined in fcvode.c */ extern realtype *CV_rout; /* defined in fcvode.c */ extern int CV_nrtfn; /* defined in fcvode.c */ extern int CV_ls; /* defined in fcvode.c */ /* Linear solver IDs */ enum { CV_LS_DENSE = 1, CV_LS_BAND = 2, CV_LS_DIAG = 3, CV_LS_LAPACKDENSE = 4, CV_LS_LAPACKBAND = 5, CV_LS_SPGMR = 6, CV_LS_SPBCG = 7, CV_LS_SPTFQMR = 8 }; #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/fcmix/fcvlapack.c0000600000175000017500000000306011741421121021276 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/11/10 21:04:11 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE/CVLAPACK * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /***************************************************************************/ void FCV_LAPACKDENSE(int *neq, int *ier) { /* neq is the problem size */ *ier = CVLapackDense(CV_cvodemem, *neq); CV_ls = CV_LS_LAPACKDENSE; } /***************************************************************************/ void FCV_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier) { /* neq is the problem size mupper is the upper bandwidth mlower is the lower bandwidth */ *ier = CVLapackBand(CV_cvodemem, *neq, *mupper, *mlower); CV_ls = CV_LS_LAPACKBAND; } /***************************************************************************/ sundials-2.5.0/src/cvode/fcmix/fcvlapdense.c0000600000175000017500000000634311741421121021645 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE/CVLAPACK, for the case * of a user-supplied dense Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /***************************************************************************/ /* Prototype of the Fortran routines */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_DJAC(long int*, /* N */ realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, /* LDJAC */ realtype*, /* H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, realtype*, /* V1, V2, V3 */ int *ier); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_LAPACKDENSESETJAC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVDlsSetDenseJacFn(CV_cvodemem, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVDlsSetDenseJacFn(CV_cvodemem, FCVLapackDenseJac); } } /***************************************************************************/ /* The C function FCVLapackDenseJac interfaces between CVODE and a * Fortran subroutine FCVDJAC for solution of a linear system using * Lapack with dense Jacobian approximation. * Addresses of arguments are passed to FCVDJAC, using the macro * DENSE_COL and the routine N_VGetArrayPointer from NVECTOR. * Auxiliary data is assumed to be communicated by Common. */ int FCVLapackDenseJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int ier; realtype *ydata, *fydata, *jacdata, *v1data, *v2data, *v3data; realtype h; FCVUserData CV_userdata; CVodeGetLastStep(CV_cvodemem, &h); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); jacdata = DENSE_COL(J,0); CV_userdata = (FCVUserData) user_data; FCV_DJAC(&N, &t, ydata, fydata, jacdata, &h, CV_userdata->ipar, CV_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvbp.h0000600000175000017500000002645411741421121020465 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the BAND * preconditioner (CVBANDPRE). * ----------------------------------------------------------------- */ /* * ============================================================================== * * FCVBP Interface Package * * The FCVBP Interface Package is a package of C functions which, * together with the FCVODE Interface Package, support the use of the * CVODE solver (serial version) with the CVBANDPRE preconditioner module, * for the solution of ODE systems in a mixed Fortran/C setting. The * combination of CVODE and CVBANDPRE solves systems dy/dt = f(t,y) with the * SPGMR (scaled preconditioned GMRES), SPTFQMR (scaled preconditioned TFQMR), * or SPBCG (scaled preconditioned Bi-CGSTAB) method for the linear systems * that arise, and with a banded difference quotient Jacobian-based preconditioner. * * The user-callable functions in this package, with the corresponding * CVODE and CVBBDPRE functions, are as follows: * FCVBPINIT interfaces to CVBandPrecInit * FCVBPSPTFQMR interfaces to CVBPSptfqmr * FCVBPSPBCG interfaces to CVBPSpbcg * FCVBPSPGMR interfaces to CVBPSpgmr * FCVBPOPT accesses optional outputs * * In addition to the Fortran right-hand side function FCVFUN, the * user may (optionally) supply a routine FCVJTIMES which is called by * the interface function FCVJtimes of type CVSpilsJtimesFn. * (The names of all user-supplied routines here are fixed, in order to * maximize portability for the resulting mixed-language program.) * * Important note on portability. * In this package, the names of the interface functions, and the names of * the Fortran user routines called by them, appear as dummy names * which are mapped to actual values by a series of definitions in the * header file fcvbp.h. * * ============================================================================== * * Usage of the FCVODE/FCVBP Interface Packages * * The usage of the combined interface packages FCVODE and FCVBP requires * calls to seven to ten interface functions, and one or two user-supplied * routines which define the problem to be solved and indirectly define * the preconditioner. These function calls and user routines are * summarized separately below. * * Some details are omitted, and the user is referred to the CVODE user document * for more complete information. * * (1) User-supplied right-hand side routine: FCVFUN * The user must in all cases supply the following Fortran routine * SUBROUTINE FCVFUN (T, Y, YDOT, IPAR, RPAR, IER) * DIMENSION Y(*), YDOT(*), IPAR(*), RPAR(*) * It must set the YDOT array to f(t,y), the right-hand side of the ODE * system, as function of T = t and the array Y = y. Here Y and YDOT * are distributed vectors. * * (2) Optional user-supplied Jacobian-vector product routine: FCVJTIMES * As an option, the user may supply a routine that computes the product * of the system Jacobian J = df/dy and a given vector v. If supplied, it * must have the following form: * SUBROUTINE FCVJTIMES (V, FJV, T, Y, FY, EWT, IPAR, RPAR, WORK, IER) * DIMENSION V(*), FJV(*), Y(*), FY(*), EWT(*), IPAR(*), RPAR(*), WORK(*) * Typically this routine will use only NEQ, T, Y, V, and FJV. It must * compute the product vector Jv, where the vector v is stored in V, and store * the product in FJV. On return, set IER = 0 if FCVJTIMES was successful, * and nonzero otherwise. * * (3) Initialization: FNVINITS, FCVMALLOC, FCVBPINIT. * * (3.1) To initialize the serial vector specification, the user must make * the following call: * CALL FNVINITS(NEQ, IER) * where NEQ is the problem size and IER is a return completion flag. * Possible values for IER are 0 = success, -1 = failure. * * (3.2) To set various problem and solution parameters and allocate * internal memory for CVODE, make the following call: * CALL FCVMALLOC(T0, Y0, METH, ITMETH, IATOL, RTOL, ATOL, * 1 IOUT, ROUT, IPAR, RPAR, IER) * The arguments are: * T0 = initial value of t * Y0 = array of initial conditions * METH = basic integration method: 1 = Adams (nonstiff), 2 = BDF (stiff) * ITMETH = nonlinear iteration method: 1 = functional iteration, 2 = Newton iter. * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array * RTOL = relative tolerance (scalar) * ATOL = absolute tolerance (scalar or array) * IOUT = array of length 21 for integer optional outputs * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * ROUT = array of length 6 for real optional outputs * IPAR = array with user integer data * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * RPAR = array with user real data * IER = return completion flag. Values are 0 = success, and -1 = failure. * See printed message for details in case of failure. * * (3.3) To allocate memory and initialize data associated with the CVBANDPRE * preconditioner, make the following call: * CALL FCVBPINIT(NEQ, MU, ML, IER) * The arguments are: * NEQ = problem size * MU, ML = upper and lower half-bandwidths of the band matrix that * is retained as an approximation of the Jacobian. * IER = return completion flag: IER=0: success, IER<0: and error occurred * * (3.4A) To specify the SPGMR linear solver with the CVBANDPRE preconditioner, * make the following call * CALL FCVBPSPGMR(IPRETYPE, IGSTYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides. * IGSTYPE = Gram-schmidt process type: 0 = modified G-S, 1 = classical G-S. * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = return completion flag: IER=0: success, IER<0: ans error occurred * * (3.4B) To specify the SPBCG linear solver with the CVBANDPRE preconditioner, * make the following call * CALL FCVBPSPBCG(IPRETYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides. * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = return completion flag: IER=0: success, IER<0: ans error occurred * * (3.4C) To specify the SPTFQMR linear solver with the CVBANDPRE preconditioner, * make the following call * CALL FCVBPSPTFQMR(IPRETYPE, MAXL, DELT, IER) * The arguments are: * IPRETYPE = preconditioner type: * 0 = none * 1 = left only * 2 = right only * 3 = both sides. * MAXL = maximum Krylov subspace dimension; 0 indicates default. * DELT = linear convergence tolerance factor; 0.0 indicates default. * IER = return completion flag: IER=0: success, IER<0: ans error occurred * * (3.5) To specify whether the Krylov linear solver (GMRES, Bi-CGSTAB, or TFQMR) * should use the supplied FCVJTIMES or the internal finite difference approximation, * make the call * CALL FCVSPILSSETJAC(FLAG, IER) * where FLAG=0 for finite differences approxaimtion or * FLAG=1 to use the supplied routine FCVJTIMES * * (4) The integrator: FCVODE * Carrying out the integration is accomplished by making calls as follows: * CALL FCVODE (TOUT, T, Y, ITASK, IER) * The arguments are: * TOUT = next value of t at which a solution is desired (input) * T = value of t reached by the solver on output * Y = array containing the computed solution on output * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate); * 2 = one-step mode (return after each internal step taken); * 3 = normal mode with TSTOP; 4 = one-step mode with TSTOP. * IER = completion flag: 0 = success, 1 = TSTOP return, 2 = root return, * negative values are various failure modes (see CVODE User Guide). * The current values of the optional outputs are available in IOUT and ROUT. * * (5) Optional outputs: FCVBPOPT * Optional outputs specific to the SP* solver are LRW, LIW, LFLG, NFELS, NJTV, * NPE, NPS, NLI, NCFL, stored in IOUT(13)...IOUT(21). * To obtain the optional outputs associated with the CVBANDPRE module, make * the following call: * CALL FCVBPOPT(LENRWBP, LENIWBP, NFEBP) * The arguments returned are: * LENRWBP = length of real preconditioner work space, in realtype words. * This size is local to the current processor. * LENIWBP = length of integer preconditioner work space, in integer words. * This size is local to the current processor. * NFEBP = number of f(t,y) evaluations for CVBANDPRE * * (6) Computing solution derivatives: FCVDKY * To obtain a derivative of the solution (optionally), of order up to * the current method order, make the following call: * CALL FCVDKY (T, K, DKY) * The arguments are: * T = value of t at which solution derivative is desired * K = derivative order (0 .le. K .le. QU) * DKY = array containing computed K-th derivative of y on return * * (7) Memory freeing: FCVFREE * To the free the internal memory created by the calls to FNVINITS, * FCVMALLOC, and FCVBPINIT, make the following call: * CALL FCVFREE * * ============================================================================== */ #ifndef _FCVBP_H #define _FCVBP_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* header files */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ /* Definitions of interface function names */ #if defined(SUNDIALS_F77_FUNC) #define FCV_BPINIT SUNDIALS_F77_FUNC(fcvbpinit, FCVBPINIT) #define FCV_BPSPTFQMR SUNDIALS_F77_FUNC(fcvbpsptfqmr, FCVBPSPTFQMR) #define FCV_BPSPBCG SUNDIALS_F77_FUNC(fcvbpspbcg, FCVBPSPBCG) #define FCV_BPSPGMR SUNDIALS_F77_FUNC(fcvbpspgmr, FCVBPSPGMR) #define FCV_BPOPT SUNDIALS_F77_FUNC(fcvbpopt, FCVBPOPT) #else #define FCV_BPINIT fcvbpinit_ #define FCV_BPSPTFQMR fcvbpsptfqmr_ #define FCV_BPSPBCG fcvbpspbcg_ #define FCV_BPSPGMR fcvbpspgmr_ #define FCV_BPOPT fcvbpopt_ #endif /* Prototypes of exported function */ void FCV_BPINIT(long int *N, long int *mu, long int *ml, int *ier); void FCV_BPSPTFQMR(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_BPSPBCG(int *pretype, int *maxl, realtype *delt, int *ier); void FCV_BPSPGMR(int *pretype, int *gstype, int *maxl, realtype *delt, int *ier); void FCV_BPOPT(long int *lenrwbp, long int *leniwbp, long int *nfebp); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/fcmix/fcvbbd.c0000600000175000017500000001203211741421121020571 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This module contains the routines necessary to interface with the * CVBBDPRE module and user-supplied Fortran routines. * The routines here call the generically named routines and provide * a standard interface to the C code of the CVBBDPRE package. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual function names, prototypes, global vars.*/ #include "fcvbbd.h" /* prototypes of interfaces to CVBBDPRE */ #include /* prototypes of CVBBDPRE functions and macros */ #include /* prototypes of CVSPTFQMR interface routines */ #include /* prototypes of CVSPBCG interface routines */ #include /* prototypes of CVSPGMR interface routines */ /***************************************************************************/ /* Prototypes of the Fortran routines */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_GLOCFN(long int*, /* NLOC */ realtype*, realtype*, realtype*, /* T, YLOC, GLOC */ long int*, realtype*, /* IPAR, RPAR */ int *ier); /* IER */ extern void FCV_COMMFN(long int*, /* NLOC */ realtype*, realtype*, /* T, Y */ long int*, realtype*, /* IPAR, RPAR */ int *ier); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_BBDINIT(long int *Nloc, long int *mudq, long int *mldq, long int *mu, long int *ml, realtype* dqrely, int *ier) { /* First call CVBBDPrecInit to initialize CVBBDPRE module: Nloc is the local vector size mudq,mldq are the half-bandwidths for computing preconditioner blocks mu, ml are the half-bandwidths of the retained preconditioner blocks dqrely is the difference quotient relative increment factor FCVgloc is a pointer to the CVLocalFn function FCVcfn is a pointer to the CVCommFn function */ *ier = CVBBDPrecInit(CV_cvodemem, *Nloc, *mudq, *mldq, *mu, *ml, *dqrely, FCVgloc, FCVcfn); return; } /***************************************************************************/ void FCV_BBDREINIT(long int *Nloc, long int *mudq, long int *mldq, realtype* dqrely, int *ier) { /* First call CVReInitBBD to re-initialize CVBBDPRE module: mudq,mldq are the half-bandwidths for computing preconditioner blocks dqrely is the difference quotient relative increment factor FCVgloc is a pointer to the CVLocalFn function FCVcfn is a pointer to the CVCommFn function */ *ier = CVBBDPrecReInit(CV_cvodemem, *mudq, *mldq, *dqrely); } /***************************************************************************/ /* C function FCVgloc to interface between CVBBDPRE module and a Fortran subroutine FCVLOCFN. */ int FCVgloc(long int Nloc, realtype t, N_Vector yloc, N_Vector gloc, void *user_data) { int ier; realtype *yloc_data, *gloc_data; FCVUserData CV_userdata; yloc_data = N_VGetArrayPointer(yloc); gloc_data = N_VGetArrayPointer(gloc); CV_userdata = (FCVUserData) user_data; FCV_GLOCFN(&Nloc, &t, yloc_data, gloc_data, CV_userdata->ipar, CV_userdata->rpar, &ier); return(ier); } /***************************************************************************/ /* C function FCVcfn to interface between CVBBDPRE module and a Fortran subroutine FCVCOMMF. */ int FCVcfn(long int Nloc, realtype t, N_Vector y, void *user_data) { int ier; realtype *yloc; FCVUserData CV_userdata; yloc = N_VGetArrayPointer(y); CV_userdata = (FCVUserData) user_data; FCV_COMMFN(&Nloc, &t, yloc, CV_userdata->ipar, CV_userdata->rpar, &ier); return(ier); } /***************************************************************************/ /* C function FCVBBDOPT to access optional outputs from CVBBD_Data */ void FCV_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd) { CVBBDPrecGetWorkSpace(CV_cvodemem, lenrwbbd, leniwbbd); CVBBDPrecGetNumGfnEvals(CV_cvodemem, ngebbd); } sundials-2.5.0/src/cvode/fcmix/fcvjtimes.c0000600000175000017500000000623611741421121021346 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:28:59 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The C function FCVJtimes is to interface between the * CVSP* module and the user-supplied Jacobian-vector * product routine FCVJTIMES. Note the use of the generic name * FCV_JTIMES below. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /***************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_JTIMES(realtype*, realtype*, /* V, JV */ realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, /* H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, /* WRK */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_SPILSSETJAC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVSpilsSetJacTimesVecFn(CV_cvodemem, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVSpilsSetJacTimesVecFn(CV_cvodemem, FCVJtimes); } } /***************************************************************************/ /* C function FCVJtimes to interface between CVODE and user-supplied Fortran routine FCVJTIMES for Jacobian * vector product. Addresses of v, Jv, t, y, fy, h, and work are passed to FCVJTIMES, using the routine N_VGetArrayPointer from NVECTOR. A return flag ier from FCVJTIMES is returned by FCVJtimes. Auxiliary data is assumed to be communicated by common blocks. */ int FCVJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector work) { realtype *vdata, *Jvdata, *ydata, *fydata, *wkdata; realtype h; FCVUserData CV_userdata; int ier = 0; CVodeGetLastStep(CV_cvodemem, &h); vdata = N_VGetArrayPointer(v); Jvdata = N_VGetArrayPointer(Jv); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); wkdata = N_VGetArrayPointer(work); CV_userdata = (FCVUserData) user_data; FCV_JTIMES (vdata, Jvdata, &t, ydata, fydata, &h, CV_userdata->ipar, CV_userdata->rpar, wkdata, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvdense.c0000600000175000017500000000627111741421121021150 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE/CVDENSE, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /***************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_DJAC(long int*, /* N */ realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, /* DJAC */ realtype*, /* H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, realtype*, /* V1, V2, V3 */ int *ier); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_DENSESETJAC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVDlsSetDenseJacFn(CV_cvodemem, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVDlsSetDenseJacFn(CV_cvodemem, FCVDenseJac); } } /***************************************************************************/ /* C function CVDenseJac interfaces between CVODE and a Fortran subroutine FCVDJAC for solution of a linear system with dense Jacobian approximation. Addresses of arguments are passed to FCVDJAC, using the macro DENSE_COL from DENSE and the routine N_VGetArrayPointer from NVECTOR. Auxiliary data is assumed to be communicated by Common. */ int FCVDenseJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int ier; realtype *ydata, *fydata, *jacdata, *v1data, *v2data, *v3data; realtype h; FCVUserData CV_userdata; CVodeGetLastStep(CV_cvodemem, &h); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); jacdata = DENSE_COL(J,0); CV_userdata = (FCVUserData) user_data; FCV_DJAC(&N, &t, ydata, fydata, jacdata, &h, CV_userdata->ipar, CV_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/cvode/fcmix/fcvbbd.h0000600000175000017500000003760311741421121020611 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Alan Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the BBD * preconditioner (CVBBDPRE) * ----------------------------------------------------------------- */ /* * ============================================================================== * * FCVBBD Interface Package * * The FCVBBD Interface Package is a package of C functions which, * together with the FCVODE Interface Package, support the use of the * CVODE solver (parallel MPI version) with the CVBBDPRE preconditioner module, * for the solution of ODE systems in a mixed Fortran/C setting. The * combination of CVODE and CVBBDPRE solves systems dy/dt = f(t,y) with * the SPGMR (scaled preconditioned GMRES), SPTFQMR (scaled preconditioned TFQMR), * or SPBCG (scaled preconditioned Bi-CGSTAB) method for the linear systems that * arise, and with a preconditioner that is block-diagonal with banded blocks. * While CVODE and CVBBDPRE are written in C, it is assumed here that the user's * calling program and user-supplied problem-defining routines are written in * Fortran. * * The user-callable functions in this package, with the corresponding * CVODE and CVBBDPRE functions, are as follows: * FCVBBDININT interfaces to CVBBDPrecInit * FCVBBDSPTFQMR interfaces to CVBBDSptfqmr * FCVBBDSPBCG interfaces to CVBBDSpbcg * FCVBBDPSGMR interfaces to CVBBDSpgmr * FCVBBDREINIT interfaces to CVBBDPrecReInit * FCVBBDOPT accesses optional outputs * * In addition to the Fortran right-hand side function FCVFUN, the * user-supplied functions used by this package, are listed below, * each with the corresponding interface function which calls it (and its * type within CVBBDPRE or CVODE): * FCVLOCFN is called by the interface function FCVgloc of type CVLocalFn * FCVCOMMF is called by the interface function FCVcfn of type CVCommFn * FCVJTIMES (optional) is called by the interface function FCVJtimes of * type CVSpilsJtimesFn * (The names of all user-supplied routines here are fixed, in order to * maximize portability for the resulting mixed-language program.) * * Important note on portability. * In this package, the names of the interface functions, and the names of * the Fortran user routines called by them, appear as dummy names * which are mapped to actual values by a series of definitions in the * header file fcvbbd.h. * * ============================================================================== * * Usage of the FCVODE/FCVBBD Interface Packages * * The usage of the combined interface packages FCVODE and FCVBBD requires * calls to seven to twelve interface functions, and three or four user-supplied * routines which define the problem to be solved and indirectly define * the preconditioner. These function calls and user routines are * summarized separately below. * * Some details are omitted, and the user is referred to the CVODE user document * for more complete information. * * (1) User-supplied right-hand side routine: FCVFUN * The user must in all cases supply the following Fortran routine * SUBROUTINE FCVFUN (T, Y, YDOT, IPAR, RPAR, IER) * DIMENSION Y(*), YDOT(*), IPAR(*), RPAR(*) * It must set the YDOT array to f(t,y), the right-hand side of the ODE * system, as function of T = t and the array Y = y. Here Y and YDOT * are distributed vectors. * * (2) User-supplied routines to define preconditoner: FCVLOCFN and FCVCOMMF * * The routines in the CVBBDPRE module provide a preconditioner matrix * for CVODE that is block-diagonal with banded blocks. The blocking * corresponds to the distribution of the dependent variable vector y * among the processors. Each preconditioner block is generated from the * Jacobian of the local part (on the current processor) of a given * function g(t,y) approximating f(t,y). The blocks are generated by a * difference quotient scheme on each processor independently, utilizing * an assumed banded structure with given half-bandwidths. A separate * pair of half-bandwidths defines the band matrix retained. * * (2.1) Local approximate function FCVLOCFN. * The user must supply a subroutine of the form * SUBROUTINE FCVLOCFN (NLOC, T, YLOC, GLOC, IPAR, RPAR, IER) * DIMENSION YLOC(*), GLOC(*), IPAR(*), RPAR(*) * to compute the function g(t,y) which approximates the right-hand side * function f(t,y). This function is to be computed locally, i.e. without * interprocess communication. (The case where g is mathematically * identical to f is allowed.) It takes as input the local vector length * NLOC, the independent variable value T = t, and the local realtype * dependent variable array YLOC. It is to compute the local part of * g(t,y) and store this in the realtype array GLOC. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * (2.2) Communication function FCVCOMMF. * The user must also supply a subroutine of the form * SUBROUTINE FCVCOMMF (NLOC, T, YLOC, IPAR, RPAR, IER) * DIMENSION YLOC(*), IPAR(*), RPAR(*) * which is to perform all interprocess communication necessary to * evaluate the approximate right-hand side function g described above. * This function takes as input the local vector length NLOC, the * independent variable value T = t, and the local real dependent * variable array YLOC. It is expected to save communicated data in * work space defined by the user, and made available to CVLOCFN. * Each call to the FCVCOMMF is preceded by a call to FCVFUN with the same * (t,y) arguments. Thus FCVCOMMF can omit any communications done by * FCVFUN if relevant to the evaluation of g. * On return, set IER = 0 if successful, IER > 0 if a recoverable error occurred, * and IER < 0 if an unrecoverable error ocurred. * * (3) Optional user-supplied Jacobian-vector product routine: FCVJTIMES * As an option, the user may supply a routine that computes the product * of the system Jacobian J = df/dy and a given vector v. If supplied, it * must have the following form: * SUBROUTINE FCVJTIMES (V, FJV, T, Y, FY, EWT, IPAR, RPAR, WORK, IER) * DIMENSION V(*), FJV(*), Y(*), FY(*), EWT(*), IPAR(*), RPAR(*), WORK(*) * Typically this routine will use only NEQ, T, Y, V, and FJV. It must * compute the product vector Jv, where the vector v is stored in V, and store * the product in FJV. On return, set IER = 0 if FCVJTIMES was successful, * and nonzero otherwise. * * (4) Initialization: FNVINITP, FCVMALLOC, FCVBBDINIT. * * (4.1) To initialize the parallel vector specification, the user must make * the following call: * CALL FNVINITP (NLOCAL, NGLOBAL, IER) * The arguments are: * NLOCAL = local size of vectors on this processor * NGLOBAL = the system size, and the global size of vectors (the sum * of all values of NLOCAL) * IER = return completion flag. Values are 0 = success, -1 = failure. * * Note: If MPI was initialized by the user, the communicator must be * set to MPI_COMM_WORLD. If not, this routine initializes MPI and sets * the communicator equal to MPI_COMM_WORLD. * * (4.2) To set various problem and solution parameters and allocate * internal memory for CVODE, make the following call: * CALL FCVMALLOC(T0, Y0, METH, ITMETH, IATOL, RTOL, ATOL, * 1 IOUT, ROUT, IPAR, RPAR, IER) * The arguments are: * T0 = initial value of t * Y0 = array of initial conditions * METH = basic integration method: 1 = Adams (nonstiff), 2 = BDF (stiff) * ITMETH = nonlinear iteration method: 1 = functional iteration, 2 = Newton iter. * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array * RTOL = relative tolerance (scalar) * ATOL = absolute tolerance (scalar or array) * IOUT = array of length 21 for integer optional outputs * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * ROUT = array of length 6 for real optional outputs * IPAR = array with user integer data * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * RPAR = array with user real data * IER = return completion flag. Values are 0 = success, and -1 = failure. * See printed message for details in case of failure. * * (4.3) Attach one of the 3 SPILS linear solvers. Make one of the * following calls (see fcvode.h) for more details. * CALL FCVSPGMR(IPRETYPE, IGSTYPE, MAXL, DELT, IER) * CALL FCVSPBCG(IPRETYPE, MAXL, DELT, IER) * CALL FCVSPTFQMR(IPRETYPE, MAXL, DELT, IER) * * (4.4) To allocate memory and initialize data associated with the CVBBDPRE * preconditioner, make the following call: * CALL FCVBBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, DQRELY, IER) * * The arguments are: * NLOCAL = local size of vectors on this processor * MUDQ,MLDQ = upper and lower half-bandwidths to be used in the computation * of the local Jacobian blocks by difference quotients. * These may be smaller than the true half-bandwidths of the * Jacobian of the local block of g, when smaller values may * provide greater efficiency. * MU, ML = upper and lower half-bandwidths of the band matrix that * is retained as an approximation of the local Jacobian block. * These may be smaller than MUDQ and MLDQ. * DQRELY = relative increment factor in y for difference quotients * (optional). 0.0 indicates the default, sqrt(unit roundoff). * IER = return completion flag: IER=0: success, IER<0: an error occurred * * CALL FCVBBDSPTFQMR(IPRETYPE, MAXL, DELT, IER) * (4.5) To specify whether the Krylov linear solver (GMRES, Bi-CGSTAB, or TFQMR) * should use the supplied FCVJTIMES or the internal finite difference approximation, * make the call * CALL FCVSPILSSETJAC(FLAG, IER) * where FLAG=0 for finite differences approximation or * FLAG=1 to use the supplied routine FCVJTIMES * * (5) Re-initialization: FCVREINIT, FCVBBDREINIT * If a sequence of problems of the same size is being solved using the SPGMR, SPBCG, * SPTFQMR linear solver in combination with the CVBBDPRE preconditioner, then the * CVODE package can be reinitialized for the second and subsequent problems * so as to avoid further memory allocation. First, in place of the call * to FCVMALLOC, make the following call: * CALL FCVREINIT(T0, Y0, IATOL, RTOL, ATOL, IER) * The arguments have the same names and meanings as those of FCVMALLOC, except * that METH and ITMETH have been omitted from the argument list (being unchanged * for the new problem). FCVREINIT performs the same initializations as * FCVMALLOC, but does no memory allocation, using instead the existing * internal memory created by the previous FCVMALLOC call. * * If there is a change in any of the linear solver arguments, then * a call to FCVSPGMR, FCVSPBCG, or FCVSPTFQMR must also be made; * in this case the linear solver memory is reallocated. * * Following the call to FCVREINIT, a call to FCVBBDINIT may or may not be needed. * If the input arguments are the same, no FCVBBDINIT call is needed. * If there is a change in input arguments, then make the call * CALL FCVBBDREINIT(NLOCAL, MUDQ, MLDQ, DQRELY, IER) * This reinitializes the BBD preconditioner, but without reallocating its memory. * The arguments of the have the same names and meanings as FCVBBDINIT. * If the value of MU or ML is being changed, then a call to FCVBBDINIT must * be made. * * (6) The integrator: FCVODE * Carrying out the integration is accomplished by making calls as follows: * CALL FCVODE (TOUT, T, Y, ITASK, IER) * The arguments are: * TOUT = next value of t at which a solution is desired (input) * T = value of t reached by the solver on output * Y = array containing the computed solution on output * ITASK = task indicator: * 1 = normal mode (overshoot TOUT and interpolate) * 2 = one-step mode (return after each internal step taken) * 3 = normal mode with TSTOP check * 4 = one-step mode with TSTOP check * IER = completion flag: 0 = success, 1 = TSTOP return, 2 = root return, * negative values are various failure modes (see CVODE User Guide). * The current values of the optional outputs are available in IOUT and ROUT. * * (7) Optional outputs: FCVBBDOPT * Optional outputs specific to the SP* solver are LRW, LIW, LFLG, NFELS, NJTV, * NPE, NPS, NLI, NCFL, stored in IOUT(13)...IOUT(21). * To obtain the optional outputs associated with the CVBBDPRE module, make * the following call: * CALL FCVBBDOPT (LENRWBBD, LENIWBBD, NGEBBD) * The arguments returned are: * LENRWBBD = length of real preconditioner work space, in realtype words. * This size is local to the current processor. * LENIWBBD = length of integer preconditioner work space, in integer words. * This size is local to the current processor. * NGEBBD = number of g(t,y) evaluations (calls to CVLOCFN) so far. * * (8) Computing solution derivatives: FCVDKY * To obtain a derivative of the solution (optionally), of order up to * the current method order, make the following call: * CALL FCVDKY (T, K, DKY) * The arguments are: * T = value of t at which solution derivative is desired * K = derivative order (0 .le. K .le. QU) * DKY = array containing computed K-th derivative of y on return * * (9) Memory freeing: FCVFREE * To the free the internal memory created by the calls to FNVINITP, * FCVMALLOC, and FCVBBDINIT, make the following call: * CALL FCVFREE * * ============================================================================== */ #ifndef _FCVBBD_H #define _FCVBBD_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* header files */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ /* Definitions of interface function names */ #if defined(SUNDIALS_F77_FUNC) #define FCV_BBDINIT SUNDIALS_F77_FUNC(fcvbbdinit, FCVBBDINIT) #define FCV_BBDSPTFQMR SUNDIALS_F77_FUNC(fcvbbdsptfqmr, FCVBBDSPTFQMR) #define FCV_BBDSPBCG SUNDIALS_F77_FUNC(fcvbbdspbcg, FCVBBDSPBCG) #define FCV_BBDSPGMR SUNDIALS_F77_FUNC(fcvbbdspgmr, FCVBBDSPGMR) #define FCV_BBDREINIT SUNDIALS_F77_FUNC(fcvbbdreinit, FCVBBDREINIT) #define FCV_BBDOPT SUNDIALS_F77_FUNC(fcvbbdopt, FCVBBDOPT) #define FCV_GLOCFN SUNDIALS_F77_FUNC(fcvglocfn, FCVGLOCFN) #define FCV_COMMFN SUNDIALS_F77_FUNC(fcvcommfn, FCVCOMMFN) #else #define FCV_BBDINIT fcvbbdinit_ #define FCV_BBDSPTFQMR fcvbbdsptfqmr_ #define FCV_BBDSPBCG fcvbbdspbcg_ #define FCV_BBDSPGMR fcvbbdspgmr_ #define FCV_BBDREINIT fcvbbdreinit_ #define FCV_BBDOPT fcvbbdopt_ #define FCV_GLOCFN fcvglocfn_ #define FCV_COMMFN fcvcommfn_ #endif /* Prototypes of exported functions */ void FCV_BBDINIT(long int *Nloc, long int *mudq, long int *mldq, long int *mu, long int *ml, realtype* dqrely, int *ier); void FCV_BBDREINIT(long int *Nloc, long int *mudq, long int *mldq, realtype* dqrely, int *ier); void FCV_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd); /* Prototypes: Functions Called by the CVBBDPRE Module */ int FCVgloc(long int Nloc, realtype t, N_Vector yloc, N_Vector gloc, void *user_data); int FCVcfn(long int Nloc, realtype t, N_Vector y, void *user_data); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvode/fcmix/fcvlapband.c0000600000175000017500000000713211741421121021450 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:27:37 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for CVODE/CVLAPACK, for the case * of a user-supplied band Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fcvode.h" /* actual fn. names, prototypes and global vars.*/ #include "cvode_impl.h" /* definition of CVodeMem type */ #include /***************************************************************************/ /* Prototype of the Fortran routines */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FCV_BJAC(long int*, long int*, long int*, long int*, /* N,MU,ML,EBAND */ realtype*, realtype*, realtype*, /* T, Y, FY */ realtype*, /* LBJAC */ realtype*, /* H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, realtype*, /* V1, V2, V3 */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FCV_LAPACKBANDSETJAC(int *flag, int *ier) { CVodeMem cv_mem; if (*flag == 0) { *ier = CVDlsSetBandJacFn(CV_cvodemem, NULL); } else { cv_mem = (CVodeMem) CV_cvodemem; *ier = CVDlsSetBandJacFn(CV_cvodemem, FCVLapackBandJac); } } /***************************************************************************/ /* The C function FCVLapackBandJac interfaces between CVODE and a * Fortran subroutine FCVBJAC for the solution of a linear system using * Lapack with band Jacobian approximation. * Addresses of arguments are passed to FCVBJAC, using the macro * BAND_COL and the routine N_VGetArrayPointer from NVECTOR. * The address passed for J is that of the element in column 0 with row * index -mupper. An extended bandwith equal to (J->smu) + mlower + 1 is * passed as the column dimension of the corresponding array. * Auxiliary data is assumed to be communicated by Common. */ int FCVLapackBandJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int ier; realtype *ydata, *fydata, *jacdata, *v1data, *v2data, *v3data; realtype h; long int eband; FCVUserData CV_userdata; CVodeGetLastStep(CV_cvodemem, &h); ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; CV_userdata = (FCVUserData) user_data; FCV_BJAC(&N, &mupper, &mlower, &eband, &t, ydata, fydata, jacdata, &h, CV_userdata->ipar, CV_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/cvode/cvode_dense.c0000600000175000017500000002365511741421121020530 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the impleentation file for the CVDENSE linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvode_direct_impl.h" #include "cvode_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* CVDENSE linit, lsetup, lsolve, and lfree routines */ static int cvDenseInit(CVodeMem cv_mem); static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void cvDenseFree(CVodeMem cv_mem); /* Readability Replacements */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define jacDQ (cvdls_mem->d_jacDQ) #define jac (cvdls_mem->d_djac) #define M (cvdls_mem->d_M) #define lpivots (cvdls_mem->d_lpivots) #define savedJ (cvdls_mem->d_savedJ) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ----------------------------------------------------------------- * CVDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the dense linear solver module. CVDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be cvDenseInit, cvDenseSetup, cvDenseSolve, and cvDenseFree, * respectively. It allocates memory for a structure of type * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to * TRUE, and the d_jac field to the default cvDlsDenseDQJac. * Finally, it allocates memory for M, savedJ, and lpivots. * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVDense will first * test for compatible a compatible N_Vector internal * representation by checking that N_VGetArrayPointer and * N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ int CVDense(void *cvode_mem, long int N) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDLS_MEM_NULL, "CVDENSE", "CVDense", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { CVProcessError(cv_mem, CVDLS_ILL_INPUT, "CVDENSE", "CVDense", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree !=NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvDenseInit; lsetup = cvDenseSetup; lsolve = cvDenseSolve; lfree = cvDenseFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Initialize Jacobian-related data */ jacDQ = TRUE; jac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = N; /* Allocate memory for M, savedJ, and pivot array */ M = NULL; M = NewDenseMat(N, N); if (M == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NULL; savedJ = NewDenseMat(N, N); if (savedJ == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { CVProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDENSE", "CVDense", MSGD_MEM_FAIL); DestroyMat(M); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * cvDenseInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the dense * linear solver. * ----------------------------------------------------------------- */ static int cvDenseInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { jac = cvDlsDenseDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvDenseSetup * ----------------------------------------------------------------- * This routine does the setup operations for the dense linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the dense LU * factorization routine. * ----------------------------------------------------------------- */ static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; long int ier; CVDlsMem cvdls_mem; int retval; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; DenseCopy(savedJ, M); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { CVProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVDENSE", "cvDenseSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } DenseCopy(M, savedJ); } /* Scale and add I to get M = I - gamma*J */ DenseScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = DenseGETRF(M, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = ier; if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * cvDenseSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the dense linear solver * by calling the dense backsolve routine. The returned value is 0. * ----------------------------------------------------------------- */ static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { CVDlsMem cvdls_mem; realtype *bd; cvdls_mem = (CVDlsMem) lmem; bd = N_VGetArrayPointer(b); DenseGETRS(M, lpivots, bd); /* If CV_BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { N_VScale(TWO/(ONE + gamrat), b, b); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvDenseFree * ----------------------------------------------------------------- * This routine frees memory specific to the dense linear solver. * ----------------------------------------------------------------- */ static void cvDenseFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyMat(savedJ); DestroyArray(lpivots); free(cvdls_mem); cv_mem->cv_lmem = NULL; } sundials-2.5.0/src/cvode/cvode_sptfqmr.c0000600000175000017500000003411711741421121021121 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2011/03/23 22:27:43 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPTFQMR linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvode_spils_impl.h" #include "cvode_impl.h" #include #include /* Other Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPTFQMR linit, lsetup, lsolve, and lfree routines */ static int CVSptfqmrInit(CVodeMem cv_mem); static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSptfqmrFree(CVodeMem cv_mem); /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define errfp (cv_mem->cv_errfp) #define mnewt (cv_mem->cv_mnewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : CVSptfqmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Sptfqmr linear solver module. CVSptfqmr first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSptfqmrInit, CVSptfqmrSetup, CVSptfqmrSolve, and CVSptfqmrFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSptfqmr allocates memory for ytemp and x, and calls * SptfqmrMalloc to allocate memory for the Sptfqmr solver. * ----------------------------------------------------------------- */ int CVSptfqmr(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPTFQMR", "CVSptfqmr", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSptfqmrInit; lsetup = CVSptfqmrSetup; lsolve = CVSptfqmrSolve; lfree = CVSptfqmrFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPTFQMR; /* Set Sptfqmr parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Sptfqmr parameters */ cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ sptfqmr_mem = NULL; sptfqmr_mem = SptfqmrMalloc(mxl, vec_tmpl); if (sptfqmr_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPTFQMR memory to spils memory structure */ spils_mem = (void *) sptfqmr_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : CVSptfqmrInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Sptfqmr * linear solver. * ----------------------------------------------------------------- */ static int CVSptfqmrInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; cvspils_mem = (CVSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { CVProcessError(cv_mem, -1, "CVSPTFQMR", "CVSptfqmrInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } /* Set maxl in the SPTFQMR memory in case it was changed by the user */ sptfqmr_mem->l_max = maxl; last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Sptfqmr linear solver. * It makes a decision as to whether or not to signal for reevaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for reevaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { CVProcessError(cv_mem, SPTFQMR_PSET_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSetup", MSGS_PSET_FAILED); last_flag = SPTFQMR_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPTFQMR_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPTFQMR_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SptfqmrSolve * for the solution of the linear system Ax = b with the SPTFQMR method. * The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SptfqmrSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SptfqmrSolve. The success flag is * returned if SptfqmrSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac * tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SptfqmrSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SptfqmrSolve and copy x to b */ retval = SptfqmrSolve(sptfqmr_mem, cv_mem, x, b, pretype, delta, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPTFQMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPTFQMR_SUCCESS: return(0); break; case SPTFQMR_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPTFQMR_CONV_FAIL: return(1); break; case SPTFQMR_PSOLVE_FAIL_REC: return(1); break; case SPTFQMR_ATIMES_FAIL_REC: return(1); break; case SPTFQMR_MEM_NULL: return(-1); break; case SPTFQMR_ATIMES_FAIL_UNREC: CVProcessError(cv_mem, SPTFQMR_ATIMES_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPTFQMR_PSOLVE_FAIL_UNREC: CVProcessError(cv_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrFree * ----------------------------------------------------------------- * This routine frees memory specific to the Sptfqmr linear solver. * ----------------------------------------------------------------- */ static void CVSptfqmrFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); sptfqmr_mem = (SptfqmrMem) spils_mem; SptfqmrFree(sptfqmr_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; return; } sundials-2.5.0/src/cvode/cvode_diag.c0000600000175000017500000003010311741421121020320 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:21:04 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVDIAG linear solver. * ----------------------------------------------------------------- */ #include #include #include "cvode_diag_impl.h" #include "cvode_impl.h" /* Other Constants */ #define FRACT RCONST(0.1) #define ONE RCONST(1.0) /* CVDIAG linit, lsetup, lsolve, and lfree routines */ static int CVDiagInit(CVodeMem cv_mem); static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void CVDiagFree(CVodeMem cv_mem); /* Readability Replacements */ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) #define f (cv_mem->cv_f) #define uround (cv_mem->cv_uround) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define rl1 (cv_mem->cv_rl1) #define gamma (cv_mem->cv_gamma) #define ewt (cv_mem->cv_ewt) #define nfe (cv_mem->cv_nfe) #define zn (cv_mem->cv_zn) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define gammasv (cvdiag_mem->di_gammasv) #define M (cvdiag_mem->di_M) #define bit (cvdiag_mem->di_bit) #define bitcomp (cvdiag_mem->di_bitcomp) #define nfeDI (cvdiag_mem->di_nfeDI) #define last_flag (cvdiag_mem->di_last_flag) /* * ----------------------------------------------------------------- * CVDiag * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the diagonal linear solver module. CVDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVDiagInit, CVDiagSetup, CVDiagSolve, and CVDiagFree, * respectively. It allocates memory for a structure of type * CVDiagMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to * TRUE. Finally, it allocates memory for M, bit, and bitcomp. * The CVDiag return value is SUCCESS = 0, LMEM_FAIL = -1, or * LIN_ILL_INPUT=-2. * ----------------------------------------------------------------- */ int CVDiag(void *cvode_mem) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VCompare and N_VInvTest are present */ if(vec_tmpl->ops->nvcompare == NULL || vec_tmpl->ops->nvinvtest == NULL) { CVProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVDIAG", "CVDiag", MSGDG_BAD_NVECTOR); return(CVDIAG_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVDiagInit; lsetup = CVDiagSetup; lsolve = CVDiagSolve; lfree = CVDiagFree; /* Get memory for CVDiagMemRec */ cvdiag_mem = NULL; cvdiag_mem = (CVDiagMem) malloc(sizeof(CVDiagMemRec)); if (cvdiag_mem == NULL) { CVProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); return(CVDIAG_MEM_FAIL); } last_flag = CVDIAG_SUCCESS; /* Set flag setupNonNull = TRUE */ setupNonNull = TRUE; /* Allocate memory for M, bit, and bitcomp */ M = N_VClone(vec_tmpl); if (M == NULL) { CVProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bit = N_VClone(vec_tmpl); if (bit == NULL) { CVProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bitcomp = N_VClone(vec_tmpl); if (bitcomp == NULL) { CVProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); N_VDestroy(bit); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdiag_mem; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetWorkSpace * ----------------------------------------------------------------- */ int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetWorkSpace", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *lenrwLS = 3*lrw1; *leniwLS = 3*liw1; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetNumRhsEvals * ----------------------------------------------------------------- */ int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *nfevalsLS = nfeDI; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetLastFlag * ----------------------------------------------------------------- */ int CVDiagGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { CVProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *flag = last_flag; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetReturnFlagName * ----------------------------------------------------------------- */ char *CVDiagGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVDIAG_SUCCESS: sprintf(name,"CVDIAG_SUCCESS"); break; case CVDIAG_MEM_NULL: sprintf(name,"CVDIAG_MEM_NULL"); break; case CVDIAG_LMEM_NULL: sprintf(name,"CVDIAG_LMEM_NULL"); break; case CVDIAG_ILL_INPUT: sprintf(name,"CVDIAG_ILL_INPUT"); break; case CVDIAG_MEM_FAIL: sprintf(name,"CVDIAG_MEM_FAIL"); break; case CVDIAG_INV_FAIL: sprintf(name,"CVDIAG_INV_FAIL"); break; case CVDIAG_RHSFUNC_UNRECVR: sprintf(name,"CVDIAG_RHSFUNC_UNRECVR"); break; case CVDIAG_RHSFUNC_RECVR: sprintf(name,"CVDIAG_RHSFUNC_RECVR"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * CVDiagInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the diagonal * linear solver. * ----------------------------------------------------------------- */ static int CVDiagInit(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; nfeDI = 0; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSetup * ----------------------------------------------------------------- * This routine does the setup operations for the diagonal linear * solver. It constructs a diagonal approximation to the Newton matrix * M = I - gamma*J, updates counters, and inverts M. * ----------------------------------------------------------------- */ static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype r; N_Vector ftemp, y; booleantype invOK; CVDiagMem cvdiag_mem; int retval; cvdiag_mem = (CVDiagMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = vtemp1; y = vtemp2; /* Form y with perturbation = FRACT*(func. iter. correction) */ r = FRACT * rl1; N_VLinearSum(h, fpred, -ONE, zn[1], ftemp); N_VLinearSum(r, ftemp, ONE, ypred, y); /* Evaluate f at perturbed y */ retval = f(tn, y, M, cv_mem->cv_user_data); nfeDI++; if (retval < 0) { CVProcessError(cv_mem, CVDIAG_RHSFUNC_UNRECVR, "CVDIAG", "CVDiagSetup", MSGDG_RHSFUNC_FAILED); last_flag = CVDIAG_RHSFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDIAG_RHSFUNC_RECVR; return(1); } /* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */ N_VLinearSum(ONE, M, -ONE, fpred, M); N_VLinearSum(FRACT, ftemp, -h, M, M); N_VProd(ftemp, ewt, y); /* Protect against deltay_i being at roundoff level */ N_VCompare(uround, y, bit); N_VAddConst(bit, -ONE, bitcomp); N_VProd(ftemp, bit, y); N_VLinearSum(FRACT, y, -ONE, bitcomp, y); N_VDiv(M, y, M); N_VProd(M, bit, M); N_VLinearSum(ONE, M, -ONE, bitcomp, M); /* Invert M with test for zero components */ invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return(1); } /* Set jcur = TRUE, save gamma in gammasv, and return */ *jcurPtr = TRUE; gammasv = gamma; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSolve * ----------------------------------------------------------------- * This routine performs the solve operation for the diagonal linear * solver. If necessary it first updates gamma in M = I - gamma*J. * ----------------------------------------------------------------- */ static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { booleantype invOK; realtype r; CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; /* If gamma has changed, update factor in M, and save gamma value */ if (gammasv != gamma) { r = gamma / gammasv; N_VInv(M, M); N_VAddConst(M, -ONE, M); N_VScale(r, M, M); N_VAddConst(M, ONE, M); invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return (1); } gammasv = gamma; } /* Apply M-inverse to b */ N_VProd(b, M, b); last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagFree * ----------------------------------------------------------------- * This routine frees memory specific to the diagonal linear solver. * ----------------------------------------------------------------- */ static void CVDiagFree(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; N_VDestroy(M); N_VDestroy(bit); N_VDestroy(bitcomp); free(cvdiag_mem); cv_mem->cv_lmem = NULL; } sundials-2.5.0/src/cvode/cvode_spbcgs.c0000600000175000017500000003365411741421121020713 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2011/03/23 22:27:43 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPBCG linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvode_spils_impl.h" #include "cvode_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPBCG linit, lsetup, lsolve, and lfree routines */ static int CVSpbcgInit(CVodeMem cv_mem); static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSpbcgFree(CVodeMem cv_mem); /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define errfp (cv_mem->cv_errfp) #define mnewt (cv_mem->cv_mnewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : CVSpbcg * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Spbcg linear solver module. CVSpbcg first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSpbcgInit, CVSpbcgSetup, CVSpbcgSolve, and CVSpbcgFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSpbcg allocates memory for ytemp and x, and calls * SpbcgMalloc to allocate memory for the Spbcg solver. * ----------------------------------------------------------------- */ int CVSpbcg(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcg", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSpbcgInit; lsetup = CVSpbcgSetup; lsolve = CVSpbcgSolve; lfree = CVSpbcgFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPBCG; /* Set Spbcg parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Spbcg parameters */ cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SpbcgMalloc to allocate workspace for Spbcg */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(mxl, vec_tmpl); if (spbcg_mem == NULL) { CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *) spbcg_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : CVSpbcgInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Spbcg * linear solver. * ----------------------------------------------------------------- */ static int CVSpbcgInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; cvspils_mem = (CVSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { CVProcessError(cv_mem, -1, "CVSPBCG", "CVSpbcgInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } /* Set maxl in the SPBCG memory in case it was changed by the user */ spbcg_mem->l_max = maxl; last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : CVSpbcgSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Spbcg linear solver. * It makes a decision as to whether or not to signal for reevaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for reevaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { CVProcessError(cv_mem, SPBCG_PSET_FAIL_UNREC, "CVSPBCG", "CVSpbcgSetup", MSGS_PSET_FAILED); last_flag = SPBCG_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPBCG_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPBCG_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * Function : CVSpbcgSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SpbcgSolve * for the solution of the linear system Ax = b with the SPBCG method. * The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SpbcgSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SpbcgSolve. The success flag is * returned if SpbcgSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac * tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SpbcgSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SpbcgSolve and copy x to b */ retval = SpbcgSolve(spbcg_mem, cv_mem, x, b, pretype, delta, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPBCG_SUCCESS) ncfl++; /* Interpret return value from SpbcgSolve */ last_flag = retval; switch(retval) { case SPBCG_SUCCESS: return(0); break; case SPBCG_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPBCG_CONV_FAIL: return(1); break; case SPBCG_PSOLVE_FAIL_REC: return(1); break; case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_MEM_NULL: return(-1); break; case SPBCG_ATIMES_FAIL_UNREC: CVProcessError(cv_mem, SPBCG_ATIMES_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPBCG_PSOLVE_FAIL_UNREC: CVProcessError(cv_mem, SPBCG_PSOLVE_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : CVSpbcgFree * ----------------------------------------------------------------- * This routine frees memory specific to the Spbcg linear solver. * ----------------------------------------------------------------- */ static void CVSpbcgFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); spbcg_mem = (SpbcgMem) spils_mem; SpbcgFree(spbcg_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; } sundials-2.5.0/src/cvode/README0000600000175000017500000005651611741421121016770 0ustar sylvestresylvestre CVODE Release 2.7.0, March 2012 Alan C. Hindmarsh and Radu Serban Center for Applied Scientific Computing, LLNL CVODE is a solver for stiff and nonstiff ODE systems (initial value problem) given in explicit form dy/dt = f(t,y). It is written in ANSI standard C. CVODE can be used both on serial and parallel (MPI) computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel version, communication between processors is done with the MPI (Message Passage Interface) system. When used with the serial NVECTOR module, CVODE provides both direct (dense and band) and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When CVODE is used with the parallel NVECTOR module, only the Krylov linear solvers are available. (An approximate diagonal Jacobian option is available with both versions.) For the serial version, there is a banded preconditioner module called CVBANDPRE available for use with the Krylov solvers, while for the parallel version there is a preconditioner module called CVBBDPRE which provides a band-block-diagonal preconditioner. CVODE is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers. This suite consists of CVODE, KINSOL, IDAS, and IDA, and variants of these. The directory structure of the package supplied reflects this family relationship. For use with Fortran applications, a set of Fortran/C interface routines, called FCVODE, is also supplied. These are written in C, but assume that the user calling program and all user-supplied routines are in Fortran. The notes below provide the location of documentation, directions for the installation of the CVODE package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/cvode/ contains PDF files for the CVODE User Guide [1] (cv_guide.pdf) and the CVODE Examples [2] (cv_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_NOTES. For complete installation instructions see the "CVODE Installation Procedure" chapter in the CVODE User Guide. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.7.0," LLNL technical report UCRL-SM-208108, December 2011. [2] A. C. Hindmarsh and R. Serban, "Example Programs for CVODE v2.7.0," LLNL technical report UCRL-SM-208110, December 2011. [3] S.D. Cohen and A.C. Hindmarsh, "CVODE, a Stiff/nonstiff ODE Solver in C," Computers in Physics, 10(2), pp. 138-143, 1996. [4] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 2.7.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - Apr. 2005 v. 2.2.2 - Mar. 2005 v. 2.2.1 - Jan. 2005 v. 2.2.0 - Dec. 2004 v. 2.0 - Jul. 2002 (first SUNDIALS release) v. 1.0 - Mar. 2002 (CVODE and PVODE combined) v. 1.0 (PVODE) - Jul. 1997 (date written) v. 1.0 (CVODE) - Sep. 1994 (date written) E. Revision History ------------------- v. 2.6.0 (May 2009) ---> v. 2.7.0 (Mar. 2012) --------------------------------------------- - Bug fixes - in CVSetTqBDF, the logic was changed to avoid a divide by zero. - after the solver memory is created, it is set to zero before being filled. - in each linear solver interface function, the linear solver memory is freed on an error return, and the **Free function now includes a line setting to NULL the main memory pointer to the linear solver memory. - in rootfinding functions CVRcheck1/CVRcheck2, when an exact zero is found, the array glo at the left endpoint is adjusted instead of shifting tlo. - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag, have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. - in the installation files, we modified the treatment of the macro SUNDIALS_USE_GENERIC_MATH, so that the parameter GENERIC_MATH_LIB is either defined (with no value) or not defined. v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (May 2009) --------------------------------------------- - New features - added a new linear solver module based on Blas + Lapack for both dense and banded matrices. - added optional input to specify which direction of zero-crossing is to be monitored while performing root-finding. The root information array iroots (returned by CVodeGetRootInfo) also encodes the direction of zero-crossing. - Bug fixes - in the rootfinding algorithm, fixed a bug resulting in unnecessary evaluations of the root functions after reinitialization of the solver right after a return at a root. - in the initial step size calculation, restrict h based on tstop. - modified the setting and use of the tq[] array. Now tq[i] (i = 1,2,3) are defined to be the reciprocals of what they were before. This eliminates a rare crash that can occur with xistar_inv = 0. - Changes to user interface - renamed all **Malloc functions to **Init - tolerances are now specified through separate functions instead of the initialization functions CVodeInit (former CVodeMalloc) and CVodeReInit. Depending on the tolerance type, one of 3 functions must be called before the first call to CVode. - removed function inputs from argument lists of all re-initialization functions. - all user-supplied functions now receive the same pointer to user data (instead of having different ones for the system evaluation, Jacobian information functions, etc.). - removed CV_NORMAL_TSTOP and CV_ONE_STEP_TSTOP named constants for the itask argument to CVode. A tstop value is now both set and activated through CVodeSetStopTime. Once tstop is reached it is also deactivated. A new value can be then specified by calling again CVodeSetStopTime. - common functionality for all direct linear solvers (dense, band, and the new Lapack solver) has been collected into the DLS (Direct Linear Solver) module, similar to the SPILS module for the iterative linear solvers. All optional input and output functions for these linear solver now have the prefix 'CVDls'. In addition, in order to include the new Lapack-based linear solver, all dimensions for these linear solvers (problem sizes, bandwidths, etc) are now of type 'int' (instead of 'long int'). - the initialization functions for the two preconditioner modules, CVBANDPRE and CVBBDPRE were renamed ***Init (from ***Alloc) and they do not return a pointer to preconditioner memory anymore. Instead, all preconditioner module-related functions are now called with the main solver memory pointer as their first argument. When using one of these two modules, there is no need to use special functions to attach one of the SPILS linear solvers (instead use one of CVSpgmr, CVSpbcg, or CVSptfqmr). Moreover, there is no need to call a memory deallocation function for the preconditioner module. - changed names CVSpilsSetDelt and delt to CVSpilsSetEpsLin and eplifac. - added the error return CV_RTFUNC_FAIL. - changes corresponding to the above were made to the FCMIX interface. v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Nov. 2006) ---------------------------------------------- - Bug fixes - added a roundoff factor when testing whether tn was just returned (in root finding) to prevent an unnecessary return. - fixed wrong logic in final stopping tests: now we check if tout was reached before checking if tstop was reached. - Changes related to the build system - reorganized source tree: header files in ${srcdir}/include/cvode, source files in ${srcdir}/src/cvode, fcmix source files in ${srcdir}/src/cvode/fcmix, examples in ${srcdir}/examples/cvode - exported header files are installed unde ${includedir}/cvode - Changes to user interface - all included header files use relative paths from ${includedir} v. 2.3.0 (Apr. 2005) ---> v. 2.4.0 (Mar. 2006) ---------------------------------------------- - New features - added CVSPBCG interface module to allow CVODE to interface with the shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. - added CVSPTFQMR interface module to allow CVODE to interface with the shared SPTFQMR (scaled preconditioned TFQMR) linear solver module. - added support for SPBCG and SPTFQMR to the CVBBDPRE and CVBANDPRE preconditioner modules. - added support for interpreting failures in user-supplied functions. - Changes to user interface - changed argument of CVodeFree, CVBandPrecFree, and CVBBDPrecFree to be the address of the respective memory block pointer, so that its NULL value is propagated back to the calling function. - added CVSPBCG module which defines appropriate CVSpbcg* functions to allow CVODE to interface with the shared SPBCG linear solver module. - added CVBBDSpbcg function to CVBBDPRE module and CVBPSpbcg function to CVBANDPRE module to support SPBCG linear solver module. - added CVBBDSptfqmr function to CVBBDPRE module and CVBPSptfqmr function to CVBANDPRE module to support SPTFQMR linear solver module. - changed function type names (not the actual definition) to accomodate all the Scaled Preconditioned Iterative Linear Solvers now available: CVSpgmrJactimesVecFn -> CVSpilsJacTimesVecFn CVSpgmrPrecSetupFn -> CVSpilsPrecSetupFn CVSpgmrPrecSolveFn -> CVSpilsPrecSolveFn - changed function types so that all user-supplied functions return an integer flag (not all of them currently used). - changed some names for CVBBDPRE and CVBANDPRE function outputs - added option for user-supplied error handler function. - renamed all exported header files (except for cvode.h, all header files have the prefix 'cvode_') - changed naming scheme for CVODE examples - Changes to the FCVODE module - added support for CVSPBCG/SPBCG (added FCV*SPBCG* functions). - added support for CVSPTFQMR/SPTFQMR (added FCV*SPTFQMR* functions). - optional inputs are now set using routines FCVSETIIN (integer inputs) and FCVSETRIN (real inputs) through pairs key-value. Optional outputs are still obtained from two arrays (IOUT and ROUT), owned by the user and passed as arguments to FCVMALLOC. Note that the argument OPTIN was removed from FCVMALLOC. - changed the prototypes of user-supplied functions so that they all return an error flag as their last argument (not all of them currently used). - the arguments OPTIN, IOPT, and ROPT were removed from FCVREINIT - Changes related to the build system - updated configure script and Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link only if necessary) - the main CVODE header file (cvode.h) is still exported to the install include directory. However, all other CVODE header files are exported into a 'cvode' subdirectory of the install include directory. - the CVODE library now contains all shared object files (there is no separate libsundials_shared library anymore) v. 2.2.2 (Mar. 2005) ---> v. 2.3.0 (Apr. 2005) ---------------------------------------------- - New features - added option for user-provided error weight computation function (of type CVEwtFn specified through CVodeSetEwtFn). - Changes to user interface - CVODE now stores tolerances through values rather than references (to resolve potential scoping issues). - CVODE now passes information back to the user through values rather than references (error weights, estimated local errors, root info) - CVodeMalloc, CVodeReInit, CVodeSetTolerances: added option itol=CV_WF to indicate user-supplied function for computing the error weights; reltol is now declared as realtype. Note that it is now illegal to call CVodeSetTolerances before CVodeMalloc. It is now legal to deallocate the absolute tolerance N_Vector right after its use. - CVodeGetErrorWeights: the user is now responsible for allocating space for the N_Vector in which error weights will be copied. - CVodeGetEstLocalErrors: the user is now responsible for allocating space for the N_Vector in which estimated local errors will be copied. - CVodeGetRootInfo: the user is now responsible for allocating space for the int array in which root information will be copied. - Passing a value of 0 for the maximum step size, the minimum step size, or for maxsteps results in the solver using the corresponding default value (infinity, 0, 500, respectively) - Several optional input functions were combined into a single one (CVodeRootInit and CvodeSetGdata, CVDenseSetJacFn and CVDenseSetJacData, CVBandSetJacFn and CVBandSetJacData, CVSpgmrSetPrecSolveFn and CVSpgmrSetPrecSetFn and CVSpgmrSetPrecData, CVSpgmrSetJacTimesVecFn and CVSpgmrSetJacData). - Changes to the FCVODE module: - Added option for user-supplied error weight computation subroutine (FCVEWT). Use FCVEWTSET to indicate that FCVEWT is provided. - Due to the changes to the main solver, if FCVPSOL is provided then FCVPSET must also be defined, even if it is empty. v. 2.2.1 (Jan. 2005) ---> v. 2.2.2 (Mar. 2005) ---------------------------------------------- - Bug fixes - fixed bug in CVode function: Initial setting of tretlast = *tret = tn removed (correcting erroneous behavior at first call to CVRcheck3). - removed redundant setting of tretlast = *tret = tn at CLOSE_ROOTS return from CVode. - modified FCMIX files to avoid C++ compiler errors - changed implicit type conversion to explicit in check_flag() routine in examples to avoid C++ compiler errors - Changes to documentation - added section with numerical values of all input and output solver constants - added more detailed notes on the type of absolute tolerances - added more details on ownership of memory for the array returned by CVodeGetRootInfo - corrected/added descriptions of error returns. - added description of --with-mpi-flags option - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.2.0 (Dec. 2004) ---> v. 2.2.1 (Jan. 2005) ---------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 2.0 (Jul. 2002) ---> v. 2.2.0 (Dec. 2004) -------------------------------------------- - New features - added option to specify a value of the independent variable (time) past which the integration is never to proceed. - added rootfinding capabilities. - added option to disable all error messages. - Changes related to the NVECTOR module (see also file sundials/shared/README) - removed machEnv, redefined table of vector operations (now contained in the N_Vector structure itself). - all CVODE functions create new N_Vector variables through cloning, using an N_Vector passed by the user as a template. - Changes to type names and CVODE constants - removed type 'integertype'; instead use int or long int, as appropriate. - restructured the list of return values from the various CVODE functions. - changed all CVODE constants (inputs and return values) to have the prefix 'CV_' (e.g. CV_SUCCESS). - renamed various function types to have the prefix 'CV' (e.g. CVRhsFn). - Changes to optional input/ouput - added CVodeSet* and CVodeGet* functions for optional inputs/outputs, replacing the arrays iopt and ropt. - added new optional inputs (e.g. maximum number of Newton iterations, maximum number of convergence failures, etc). - the value of the last return flag from any function within a linear solver module can be obtained as an optional output (e.g. CVDenseGetLastFlag). - Changes to user-callable functions - added new function CVodeCreate which initializes the CVODE solver object and returns a pointer to the CVODE memory block. - removed N (problem size) from all functions except the initialization functions for the direct linear solvers (CVDense and CVBand). - shortened argument lists of most CVODE functions (the arguments that were dropped can now be specified through CVodeSet* functions). - removed reinitialization functions for band/dense/SPGMR linear solvers (same functionality can be obtained using CV*Set* functions). - in CVBBDPRE, added a new function, CVBBDSpgmr to initialize the SPGMR linear solver with the BBD preconditioner. - function names changed in CVBANDPRE and CVBBDPRE for uniformity. - Changes to user-supplied functions - removed N (probem dimension) from argument lists. - shortened argument lists for user dense/band/SPGMR Jacobian routines. (Data needed to do difference quotients is accessible in other ways.) - in CVSPGMR, shortened argument lists for user preconditioner functions. - Changes to the FCVODE module - revised to use underscore and precision flags at compile time (from configure); example sources are preprocessed accordingly. - reorganized FCVODE into fewer files. - added tstop options, and interfaces to CVBANDPRE and rootfinding features. - use CV*Set* and CV*Get* functions from CVODE (although the optional I/O is still communicated to the user of FCVODE through arrays IOPT and ROPT). - added new optional inputs and outputs (e.g.tstop, nlscoef, maxnef, maxcor, maxncf, etc.) and rearranged locations in IOPT and ROPT for uniformity. Summary of previous revisions (YYYYMMDD) (significant revisions only) --------------------------------------------------------------------- Combined CVODE package (Mar. 2002 - Jul. 2002) ----------------------------------------------- 20020313 Modified to work with new NVECTOR abstraction. Changed name PVBBDPRE to CVBBDPRE, etc. 20020321 Revisions throughout to reflect usage changes for NVECTOR modules. Changed dense/band backsolve argument b type from N_Vector to real*. 20020328 In FCVODE, added interfaces to dense/band linear solvers. 20020626 Changed type names real/integer to realtype/integertype. PVODE (Jul. 1995 - Mar. 2002) ----------------------------- 19950726 DATE WRITTEN; MPI version of VECTOR module written, creating MPI_PVODE; makefiles written with defs. specific to IBM-SP. 19950929 Formed package directory structure; added Cray-T3D defs. to Makefiles. 19970219 FPVODE package of Fortran/C interfaces written, with examples. 19970724 Wrote preconditioner module BBDPRE and Fortran/C interface. 19970811 Type names changed to LLNL_FLOAT etc. 19970813 Changed first FFUN arg. in FPVODE to local length NLOC. 19971103 Added argc,argv to PVInitMPI call list; removed ICOMM argument to FPVINITMPI (pass MPI_COMM_WORLD). 19971201 Name changes: PVInitMPI/PVFreeMPI to PVecInitMPI/PVecFreeMPI. 19971208 Added optional argument dqrely to BBDPRE. 19971217 Revised FPVODE to use name mappings via parameters in fcmixpar.h. 19980120 Name changes: VECTOR to NVECTOR etc. 19980206 Name changes: BBDPRE to PVBBDPRE, FFUN to PVFUN, etc. 19980508 Wrappers on header files for C++ use; type bool changed to boole. 19980923 In PVBBDPRE and Fortran interface, added two half-bandwidth arguments. 20000316 SPGMR module modified for correct treatment of scalings. added new routine CVReInit for re-initialization of CVODE. 20000320 In NVECTOR module: removed comm = NULL option in PVecInitMPI. 20000321 Added interface FPVREINIT, and expanded diagkf example. 20000719 Fixed memory leak bugs in CVReInit and FPVREINIT. 20000808 Fixed bug in N_VMin routine. 20011114 Added option for stability limit detection algorithm STALD. 20011220 Default type 'integer' changed to 'long int' in llnltyps.h. 20011220 Optional input ropt[HMAX] examined on every call to CVode. 20011221 Optional input iopt[MXHNIL] = -1 means no t+h=t messages. 20011228 Added arguments to CVSpgmr: jtimes (user J*v routine), jac_data. Added optional jtimes to FPVODE. Revised examples accordingly. 20020114 Linear solver modules reorganized: specification routines CVDiag and CVSpgmr perform malloc operations and return a completion flag. Re-use of linear solver memory is allowed if linear solver choice and parameters are unchanged. Fortran interface routines modified analogously. All examples modified to receive and test new return flag. 20020301 Added CVReInitSpgmr routine to CVSPGMR module, and added Fortran interfaces to it. Revised cvdemk and pvdiagkf accordingly. 20020306 Added PVReInitBBD routine to PVBBDPRE, and added Fortran interface to it. Revised pvkxb and pvidagkbf examples accordingly. CVODE (1993 - Mar. 2002) ------------------------ 1993-94 DATE WRITTEN. First released 2 September 1994. 19970811 Type names changed to LLNL_FLOAT etc. 19980120 Name changes: VECTOR to NVECTOR etc. 19980508 Wrappers on header files for C++ use; type bool changed to boole. 20000316 SPGMR module modified for correct treatment of scalings. Added CVODE re-initialization routine CVReInit. 20000323 Added band preconditioner module CVBANDPRE. 20000719 Fixed memory leak bugs in CVReInit. 20000808 Fixed bug in N_VMin routine. 20011114 Added option for stability limit detection algorithm STALD. 20011115 Reorganized DENSE module, with smalldense.* files separate. 20011220 Default type 'integer' changed to 'long int' in llnltyps.h. 20011220 Optional input ropt[HMAX] examined on every call to CVode. 20011221 Optional input iopt[MXHNIL] = -1 means no t+h=t messages. 20011228 Added arguments to CVSpgmr: jtimes (user J*v routine), jac_data. 20020114 Linear solver modules reorganized: linear solver specification routines perform malloc operations and return a completion flag. Re-use of linear solver memory is allowed if linear solver choice and parameters are unchanged. All examples modified accordingly. 20020301 Added ReInit routine to CVDENSE, CVBAND, CVSPGMR modules. 20020305 Added CVReInitBandPre routine to CVBANDPRE module. sundials-2.5.0/src/sundials/0000755000175000017500000000000011767174700016645 5ustar sylvestresylvestresundials-2.5.0/src/sundials/sundials_spgmr.c0000600000175000017500000003055211741421110022016 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2007/04/06 20:33:30 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the scaled preconditioned * GMRES (SPGMR) iterative linear solver. * ----------------------------------------------------------------- */ #include #include #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : SpgmrMalloc * ----------------------------------------------------------------- */ SpgmrMem SpgmrMalloc(int l_max, N_Vector vec_tmpl) { SpgmrMem mem; N_Vector *V, xcor, vtemp; realtype **Hes, *givens, *yg; int k, i; /* Check the input parameters. */ if (l_max <= 0) return(NULL); /* Get memory for the Krylov basis vectors V[0], ..., V[l_max]. */ V = N_VCloneVectorArray(l_max+1, vec_tmpl); if (V == NULL) return(NULL); /* Get memory for the Hessenberg matrix Hes. */ Hes = NULL; Hes = (realtype **) malloc((l_max+1)*sizeof(realtype *)); if (Hes == NULL) { N_VDestroyVectorArray(V, l_max+1); return(NULL); } for (k = 0; k <= l_max; k++) { Hes[k] = NULL; Hes[k] = (realtype *) malloc(l_max*sizeof(realtype)); if (Hes[k] == NULL) { for (i = 0; i < k; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } } /* Get memory for Givens rotation components. */ givens = NULL; givens = (realtype *) malloc(2*l_max*sizeof(realtype)); if (givens == NULL) { for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } /* Get memory to hold the correction to z_tilde. */ xcor = N_VClone(vec_tmpl); if (xcor == NULL) { free(givens); givens = NULL; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } /* Get memory to hold SPGMR y and g vectors. */ yg = NULL; yg = (realtype *) malloc((l_max+1)*sizeof(realtype)); if (yg == NULL) { N_VDestroy(xcor); free(givens); givens = NULL; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } /* Get an array to hold a temporary vector. */ vtemp = N_VClone(vec_tmpl); if (vtemp == NULL) { free(yg); yg = NULL; N_VDestroy(xcor); free(givens); givens = NULL; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } /* Get memory for an SpgmrMemRec containing SPGMR matrices and vectors. */ mem = NULL; mem = (SpgmrMem) malloc(sizeof(SpgmrMemRec)); if (mem == NULL) { N_VDestroy(vtemp); free(yg); yg = NULL; N_VDestroy(xcor); free(givens); givens = NULL; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; N_VDestroyVectorArray(V, l_max+1); return(NULL); } /* Set the fields of mem. */ mem->l_max = l_max; mem->V = V; mem->Hes = Hes; mem->givens = givens; mem->xcor = xcor; mem->yg = yg; mem->vtemp = vtemp; /* Return the pointer to SPGMR memory. */ return(mem); } /* * ----------------------------------------------------------------- * Function : SpgmrSolve * ----------------------------------------------------------------- */ int SpgmrSolve(SpgmrMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, int gstype, realtype delta, int max_restarts, void *P_data, N_Vector s1, N_Vector s2, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { N_Vector *V, xcor, vtemp; realtype **Hes, *givens, *yg; realtype beta, rotation_product, r_norm, s_product, rho; booleantype preOnLeft, preOnRight, scale2, scale1, converged; int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries; if (mem == NULL) return(SPGMR_MEM_NULL); /* Initialize some variables */ l_plus_1 = 0; krydim = 0; /* Make local copies of mem variables. */ l_max = mem->l_max; V = mem->V; Hes = mem->Hes; givens = mem->givens; xcor = mem->xcor; yg = mem->yg; vtemp = mem->vtemp; *nli = *nps = 0; /* Initialize counters */ converged = FALSE; /* Initialize converged flag */ if (max_restarts < 0) max_restarts = 0; if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; preOnLeft = ((pretype == PREC_LEFT) || (pretype == PREC_BOTH)); preOnRight = ((pretype == PREC_RIGHT) || (pretype == PREC_BOTH)); scale1 = (s1 != NULL); scale2 = (s2 != NULL); /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0. */ if (N_VDotProd(x, x) == ZERO) { N_VScale(ONE, b, vtemp); } else { ier = atimes(A_data, x, vtemp); if (ier != 0) return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); } N_VScale(ONE, vtemp, V[0]); /* Apply left preconditioner and left scaling to V[0] = r_0. */ if (preOnLeft) { ier = psolve(P_data, V[0], vtemp, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); } else { N_VScale(ONE, V[0], vtemp); } if (scale1) { N_VProd(s1, vtemp, V[0]); } else { N_VScale(ONE, vtemp, V[0]); } /* Set r_norm = beta to L2 norm of V[0] = s1 P1_inv r_0, and return if small. */ *res_norm = r_norm = beta = RSqrt(N_VDotProd(V[0], V[0])); if (r_norm <= delta) return(SPGMR_SUCCESS); /* Initialize rho to avoid compiler warning message */ rho = beta; /* Set xcor = 0. */ N_VConst(ZERO, xcor); /* Begin outer iterations: up to (max_restarts + 1) attempts. */ for (ntries = 0; ntries <= max_restarts; ntries++) { /* Initialize the Hessenberg matrix Hes and Givens rotation product. Normalize the initial vector V[0]. */ for (i = 0; i <= l_max; i++) for (j = 0; j < l_max; j++) Hes[i][j] = ZERO; rotation_product = ONE; N_VScale(ONE/r_norm, V[0], V[0]); /* Inner loop: generate Krylov sequence and Arnoldi basis. */ for (l = 0; l < l_max; l++) { (*nli)++; krydim = l_plus_1 = l + 1; /* Generate A-tilde V[l], where A-tilde = s1 P1_inv A P2_inv s2_inv. */ /* Apply right scaling: vtemp = s2_inv V[l]. */ if (scale2) N_VDiv(V[l], s2, vtemp); else N_VScale(ONE, V[l], vtemp); /* Apply right preconditioner: vtemp = P2_inv s2_inv V[l]. */ if (preOnRight) { N_VScale(ONE, vtemp, V[l_plus_1]); ier = psolve(P_data, V[l_plus_1], vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); } /* Apply A: V[l+1] = A P2_inv s2_inv V[l]. */ ier = atimes(A_data, vtemp, V[l_plus_1] ); if (ier != 0) return((ier < 0) ? SPGMR_ATIMES_FAIL_UNREC : SPGMR_ATIMES_FAIL_REC); /* Apply left preconditioning: vtemp = P1_inv A P2_inv s2_inv V[l]. */ if (preOnLeft) { ier = psolve(P_data, V[l_plus_1], vtemp, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); } else { N_VScale(ONE, V[l_plus_1], vtemp); } /* Apply left scaling: V[l+1] = s1 P1_inv A P2_inv s2_inv V[l]. */ if (scale1) { N_VProd(s1, vtemp, V[l_plus_1]); } else { N_VScale(ONE, vtemp, V[l_plus_1]); } /* Orthogonalize V[l+1] against previous V[i]: V[l+1] = w_tilde. */ if (gstype == CLASSICAL_GS) { if (ClassicalGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l]), vtemp, yg) != 0) return(SPGMR_GS_FAIL); } else { if (ModifiedGS(V, Hes, l_plus_1, l_max, &(Hes[l_plus_1][l])) != 0) return(SPGMR_GS_FAIL); } /* Update the QR factorization of Hes. */ if(QRfact(krydim, Hes, givens, l) != 0 ) return(SPGMR_QRFACT_FAIL); /* Update residual norm estimate; break if convergence test passes. */ rotation_product *= givens[2*l+1]; *res_norm = rho = ABS(rotation_product*r_norm); if (rho <= delta) { converged = TRUE; break; } /* Normalize V[l+1] with norm value from the Gram-Schmidt routine. */ N_VScale(ONE/Hes[l_plus_1][l], V[l_plus_1], V[l_plus_1]); } /* Inner loop is done. Compute the new correction vector xcor. */ /* Construct g, then solve for y. */ yg[0] = r_norm; for (i = 1; i <= krydim; i++) yg[i]=ZERO; if (QRsol(krydim, Hes, givens, yg) != 0) return(SPGMR_QRSOL_FAIL); /* Add correction vector V_l y to xcor. */ for (k = 0; k < krydim; k++) N_VLinearSum(yg[k], V[k], ONE, xcor, xcor); /* If converged, construct the final solution vector x and return. */ if (converged) { /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ if (scale2) N_VDiv(xcor, s2, xcor); if (preOnRight) { ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); } else { N_VScale(ONE, xcor, vtemp); } /* Add vtemp to initial x to get final solution x, and return */ N_VLinearSum(ONE, x, ONE, vtemp, x); return(SPGMR_SUCCESS); } /* Not yet converged; if allowed, prepare for restart. */ if (ntries == max_restarts) break; /* Construct last column of Q in yg. */ s_product = ONE; for (i = krydim; i > 0; i--) { yg[i] = s_product*givens[2*i-2]; s_product *= givens[2*i-1]; } yg[0] = s_product; /* Scale r_norm and yg. */ r_norm *= s_product; for (i = 0; i <= krydim; i++) yg[i] *= r_norm; r_norm = ABS(r_norm); /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ N_VScale(yg[0], V[0], V[0]); for (k = 1; k <= krydim; k++) N_VLinearSum(yg[k], V[k], ONE, V[0], V[0]); } /* Failed to converge, even after allowed restarts. If the residual norm was reduced below its initial value, compute and return x anyway. Otherwise return failure flag. */ if (rho < beta) { /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor. */ if (scale2) N_VDiv(xcor, s2, xcor); if (preOnRight) { ier = psolve(P_data, xcor, vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPGMR_PSOLVE_FAIL_UNREC : SPGMR_PSOLVE_FAIL_REC); } else { N_VScale(ONE, xcor, vtemp); } /* Add vtemp to initial x to get final solution x, and return. */ N_VLinearSum(ONE, x, ONE, vtemp, x); return(SPGMR_RES_REDUCED); } return(SPGMR_CONV_FAIL); } /* * ----------------------------------------------------------------- * Function : SpgmrFree * ----------------------------------------------------------------- */ void SpgmrFree(SpgmrMem mem) { int i, l_max; realtype **Hes, *givens, *yg; if (mem == NULL) return; l_max = mem->l_max; Hes = mem->Hes; givens = mem->givens; yg = mem->yg; for (i = 0; i <= l_max; i++) {free(Hes[i]); Hes[i] = NULL;} free(Hes); Hes = NULL; free(mem->givens); givens = NULL; free(mem->yg); yg = NULL; N_VDestroyVectorArray(mem->V, l_max+1); N_VDestroy(mem->xcor); N_VDestroy(mem->vtemp); free(mem); mem = NULL; } sundials-2.5.0/src/sundials/sundials_nvector.c0000600000175000017500000001113611741421110022343 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/06 20:33:30 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a generic NVECTOR package. * It contains the implementation of the N_Vector operations listed * in nvector.h. * ----------------------------------------------------------------- */ #include #include /* * ----------------------------------------------------------------- * Functions in the 'ops' structure * ----------------------------------------------------------------- */ N_Vector N_VClone(N_Vector w) { N_Vector v = NULL; v = w->ops->nvclone(w); return(v); } N_Vector N_VCloneEmpty(N_Vector w) { N_Vector v = NULL; v = w->ops->nvcloneempty(w); return(v); } void N_VDestroy(N_Vector v) { if (v==NULL) return; v->ops->nvdestroy(v); return; } void N_VSpace(N_Vector v, long int *lrw, long int *liw) { v->ops->nvspace(v, lrw, liw); return; } realtype *N_VGetArrayPointer(N_Vector v) { return((realtype *) v->ops->nvgetarraypointer(v)); } void N_VSetArrayPointer(realtype *v_data, N_Vector v) { v->ops->nvsetarraypointer(v_data, v); return; } void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { z->ops->nvlinearsum(a, x, b, y, z); return; } void N_VConst(realtype c, N_Vector z) { z->ops->nvconst(c, z); return; } void N_VProd(N_Vector x, N_Vector y, N_Vector z) { z->ops->nvprod(x, y, z); return; } void N_VDiv(N_Vector x, N_Vector y, N_Vector z) { z->ops->nvdiv(x, y, z); return; } void N_VScale(realtype c, N_Vector x, N_Vector z) { z->ops->nvscale(c, x, z); return; } void N_VAbs(N_Vector x, N_Vector z) { z->ops->nvabs(x, z); return; } void N_VInv(N_Vector x, N_Vector z) { z->ops->nvinv(x, z); return; } void N_VAddConst(N_Vector x, realtype b, N_Vector z) { z->ops->nvaddconst(x, b, z); return; } realtype N_VDotProd(N_Vector x, N_Vector y) { return((realtype) y->ops->nvdotprod(x, y)); } realtype N_VMaxNorm(N_Vector x) { return((realtype) x->ops->nvmaxnorm(x)); } realtype N_VWrmsNorm(N_Vector x, N_Vector w) { return((realtype) x->ops->nvwrmsnorm(x, w)); } realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) { return((realtype) x->ops->nvwrmsnormmask(x, w, id)); } realtype N_VMin(N_Vector x) { return((realtype) x->ops->nvmin(x)); } realtype N_VWL2Norm(N_Vector x, N_Vector w) { return((realtype) x->ops->nvwl2norm(x, w)); } realtype N_VL1Norm(N_Vector x) { return((realtype) x->ops->nvl1norm(x)); } void N_VCompare(realtype c, N_Vector x, N_Vector z) { z->ops->nvcompare(c, x, z); return; } booleantype N_VInvTest(N_Vector x, N_Vector z) { return((booleantype) z->ops->nvinvtest(x, z)); } booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) { return((booleantype) x->ops->nvconstrmask(c, x, m)); } realtype N_VMinQuotient(N_Vector num, N_Vector denom) { return((realtype) num->ops->nvminquotient(num, denom)); } /* * ----------------------------------------------------------------- * Additional functions exported by the generic NVECTOR: * N_VCloneEmptyVectorArray * N_VCloneVectorArray * N_VDestroyVectorArray * ----------------------------------------------------------------- */ N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w) { N_Vector *vs = NULL; int j; if (count <= 0) return(NULL); vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = N_VCloneEmpty(w); if (vs[j] == NULL) { N_VDestroyVectorArray(vs, j-1); return(NULL); } } return(vs); } N_Vector *N_VCloneVectorArray(int count, N_Vector w) { N_Vector *vs = NULL; int j; if (count <= 0) return(NULL); vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = N_VClone(w); if (vs[j] == NULL) { N_VDestroyVectorArray(vs, j-1); return(NULL); } } return(vs); } void N_VDestroyVectorArray(N_Vector *vs, int count) { int j; if (vs==NULL) return; for (j = 0; j < count; j++) N_VDestroy(vs[j]); free(vs); vs = NULL; return; } sundials-2.5.0/src/sundials/sundials_dense.c0000600000175000017500000002047611741421110021770 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:46:56 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a generic package of dense * matrix operations. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ----------------------------------------------------- * Functions working on DlsMat * ----------------------------------------------------- */ long int DenseGETRF(DlsMat A, long int *p) { return(denseGETRF(A->cols, A->M, A->N, p)); } void DenseGETRS(DlsMat A, long int *p, realtype *b) { denseGETRS(A->cols, A->N, p, b); } long int DensePOTRF(DlsMat A) { return(densePOTRF(A->cols, A->M)); } void DensePOTRS(DlsMat A, realtype *b) { densePOTRS(A->cols, A->M, b); } int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk) { return(denseGEQRF(A->cols, A->M, A->N, beta, wrk)); } int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk) { return(denseORMQR(A->cols, A->M, A->N, beta, vn, vm, wrk)); } void DenseCopy(DlsMat A, DlsMat B) { denseCopy(A->cols, B->cols, A->M, A->N); } void DenseScale(realtype c, DlsMat A) { denseScale(c, A->cols, A->M, A->N); } long int denseGETRF(realtype **a, long int m, long int n, long int *p) { long int i, j, k, l; realtype *col_j, *col_k; realtype temp, mult, a_kj; /* k-th elimination step number */ for (k=0; k < n; k++) { col_k = a[k]; /* find l = pivot row number */ l=k; for (i=k+1; i < m; i++) if (ABS(col_k[i]) > ABS(col_k[l])) l=i; p[k] = l; /* check for zero pivot element */ if (col_k[l] == ZERO) return(k+1); /* swap a(k,1:n) and a(l,1:n) if necessary */ if ( l!= k ) { for (i=0; i 0; k--) { col_k = a[k]; b[k] /= col_k[k]; for (i=0; i0) { for(i=j; i=0; i--) { col_i = a[i]; for (j=i+1; j= n) * using Householder reflections. * * On exit, the elements on and above the diagonal of A contain the n by n * upper triangular matrix R; the elements below the diagonal, with the array beta, * represent the orthogonal matrix Q as a product of elementary reflectors . * * v (of length m) must be provided as workspace. * */ int denseGEQRF(realtype **a, long int m, long int n, realtype *beta, realtype *v) { realtype ajj, s, mu, v1, v1_2; realtype *col_j, *col_k; long int i, j, k; /* For each column...*/ for(j=0; j= n. * * v (of length m) must be provided as workspace. */ int denseORMQR(realtype **a, long int m, long int n, realtype *beta, realtype *vn, realtype *vm, realtype *v) { realtype *col_j, s; long int i, j; /* Initialize vm */ for(i=0; i=0; j--) { col_j = a[j]; v[0] = ONE; s = vm[j]; for(i=1; i #include #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : SpbcgMalloc * ----------------------------------------------------------------- */ SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl) { SpbcgMem mem; N_Vector r_star, r, p, q, u, Ap, vtemp; /* Check the input parameters */ if (l_max <= 0) return(NULL); /* Get arrays to hold temporary vectors */ r_star = N_VClone(vec_tmpl); if (r_star == NULL) { return(NULL); } r = N_VClone(vec_tmpl); if (r == NULL) { N_VDestroy(r_star); return(NULL); } p = N_VClone(vec_tmpl); if (p == NULL) { N_VDestroy(r_star); N_VDestroy(r); return(NULL); } q = N_VClone(vec_tmpl); if (q == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); return(NULL); } u = N_VClone(vec_tmpl); if (u == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); return(NULL); } Ap = N_VClone(vec_tmpl); if (Ap == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); return(NULL); } vtemp = N_VClone(vec_tmpl); if (vtemp == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); N_VDestroy(Ap); return(NULL); } /* Get memory for an SpbcgMemRec containing SPBCG matrices and vectors */ mem = NULL; mem = (SpbcgMem) malloc(sizeof(SpbcgMemRec)); if (mem == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); N_VDestroy(Ap); N_VDestroy(vtemp); return(NULL); } /* Set the fields of mem */ mem->l_max = l_max; mem->r_star = r_star; mem->r = r; mem->p = p; mem->q = q; mem->u = u; mem->Ap = Ap; mem->vtemp = vtemp; /* Return the pointer to SPBCG memory */ return(mem); } /* * ----------------------------------------------------------------- * Function : SpbcgSolve * ----------------------------------------------------------------- */ int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; N_Vector r_star, r, p, q, u, Ap, vtemp; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; int l, l_max, ier; if (mem == NULL) return(SPBCG_MEM_NULL); /* Make local copies of mem variables */ l_max = mem->l_max; r_star = mem->r_star; r = mem->r; p = mem->p; q = mem->q; u = mem->u; Ap = mem->Ap; vtemp = mem->vtemp; *nli = *nps = 0; /* Initialize counters */ converged = FALSE; /* Initialize converged flag */ if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star = r_0 */ if (preOnLeft) { ier = psolve(P_data, r_star, r, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, r_star, r); if (scale_b) N_VProd(sb, r, r_star); else N_VScale(ONE, r, r_star); /* Initialize beta_denom to the dot product of r0 with r0 */ beta_denom = N_VDotProd(r_star, r_star); /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and return if small */ *res_norm = r_norm = rho = RSqrt(beta_denom); if (r_norm <= delta) return(SPBCG_SUCCESS); /* Copy r_star to r and p */ N_VScale(ONE, r_star, r); N_VScale(ONE, r_star, p); /* Begin main iteration loop */ for(l = 0; l < l_max; l++) { (*nli)++; /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ /* Apply x-scaling: vtemp = sx_inv p */ if (scale_x) N_VDiv(p, sx, vtemp); else N_VScale(ONE, p, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ if (preOnRight) { N_VScale(ONE, vtemp, Ap); ier = psolve(P_data, Ap, vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } /* Apply A: Ap = A P2_inv sx_inv p */ ier = atimes(A_data, vtemp, Ap ); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, Ap, vtemp, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, Ap, vtemp); /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ if (scale_b) N_VProd(sb, vtemp, Ap); else N_VScale(ONE, vtemp, Ap); /* Calculate alpha = / */ alpha = ((N_VDotProd(r, r_star) / N_VDotProd(Ap, r_star))); /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ N_VLinearSum(ONE, r, -alpha, Ap, q); /* Generate u = A-tilde q */ /* Apply x-scaling: vtemp = sx_inv q */ if (scale_x) N_VDiv(q, sx, vtemp); else N_VScale(ONE, q, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ if (preOnRight) { N_VScale(ONE, vtemp, u); ier = psolve(P_data, u, vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } /* Apply A: u = A P2_inv sx_inv u */ ier = atimes(A_data, vtemp, u ); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, u, vtemp, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, u, vtemp); /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ if (scale_b) N_VProd(sb, vtemp, u); else N_VScale(ONE, vtemp, u); /* Calculate omega = / */ omega_denom = N_VDotProd(u, u); if (omega_denom == ZERO) omega_denom = ONE; omega = (N_VDotProd(u, q) / omega_denom); /* Update x = x + alpha*p + omega*q */ N_VLinearSum(alpha, p, omega, q, vtemp); N_VLinearSum(ONE, x, ONE, vtemp, x); /* Update the residual r = q - omega*u */ N_VLinearSum(ONE, q, -omega, u, r); /* Set rho = norm(r) and check convergence */ *res_norm = rho = RSqrt(N_VDotProd(r, r)); if (rho <= delta) { converged = TRUE; break; } /* Not yet converged, continue iteration */ /* Update beta = / * alpha / omega */ beta_num = N_VDotProd(r, r_star); beta = ((beta_num / beta_denom) * (alpha / omega)); beta_denom = beta_num; /* Update p = r + beta*(p - omega*Ap) */ N_VLinearSum(ONE, p, -omega, Ap, vtemp); N_VLinearSum(ONE, r, beta, vtemp, p); } /* Main loop finished */ if ((converged == TRUE) || (rho < r_norm)) { /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); N_VScale(ONE, vtemp, x); } if (converged == TRUE) return(SPBCG_SUCCESS); else return(SPBCG_RES_REDUCED); } else return(SPBCG_CONV_FAIL); } /* * ----------------------------------------------------------------- * Function : SpbcgFree * ----------------------------------------------------------------- */ void SpbcgFree(SpbcgMem mem) { if (mem == NULL) return; N_VDestroy(mem->r_star); N_VDestroy(mem->r); N_VDestroy(mem->p); N_VDestroy(mem->q); N_VDestroy(mem->u); N_VDestroy(mem->Ap); N_VDestroy(mem->vtemp); free(mem); mem = NULL; } sundials-2.5.0/src/sundials/sundials_iterative.c0000600000175000017500000001675611741421110022674 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the iterative.h header * file. It contains the implementation of functions that may be * useful for many different iterative solvers of A x = b. * ----------------------------------------------------------------- */ #include #include #include #define FACTOR RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : ModifiedGS * ----------------------------------------------------------------- * This implementation of ModifiedGS is a slight modification of a * previous modified Gram-Schmidt routine (called mgs) written by * Milo Dorr. * ----------------------------------------------------------------- */ int ModifiedGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm) { int i, k_minus_1, i0; realtype new_norm_2, new_product, vk_norm, temp; vk_norm = RSqrt(N_VDotProd(v[k],v[k])); k_minus_1 = k - 1; i0 = MAX(k-p, 0); /* Perform modified Gram-Schmidt */ for (i=i0; i < k; i++) { h[i][k_minus_1] = N_VDotProd(v[i], v[k]); N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); } /* Compute the norm of the new vector at v[k] */ *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); /* If the norm of the new vector at v[k] is less than FACTOR (== 1000) times unit roundoff times the norm of the input vector v[k], then the vector will be reorthogonalized in order to ensure that nonorthogonality is not being masked by a very small vector length. */ temp = FACTOR * vk_norm; if ((temp + (*new_vk_norm)) != temp) return(0); new_norm_2 = ZERO; for (i=i0; i < k; i++) { new_product = N_VDotProd(v[i], v[k]); temp = FACTOR * h[i][k_minus_1]; if ((temp + new_product) == temp) continue; h[i][k_minus_1] += new_product; N_VLinearSum(ONE, v[k],-new_product, v[i], v[k]); new_norm_2 += SQR(new_product); } if (new_norm_2 != ZERO) { new_product = SQR(*new_vk_norm) - new_norm_2; *new_vk_norm = (new_product > ZERO) ? RSqrt(new_product) : ZERO; } return(0); } /* * ----------------------------------------------------------------- * Function : ClassicalGS * ----------------------------------------------------------------- * This implementation of ClassicalGS was contributed by Homer Walker * and Peter Brown. * ----------------------------------------------------------------- */ int ClassicalGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm, N_Vector temp, realtype *s) { int i, k_minus_1, i0; realtype vk_norm; k_minus_1 = k - 1; /* Perform Classical Gram-Schmidt */ vk_norm = RSqrt(N_VDotProd(v[k], v[k])); i0 = MAX(k-p, 0); for (i=i0; i < k; i++) { h[i][k_minus_1] = N_VDotProd(v[i], v[k]); } for (i=i0; i < k; i++) { N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); } /* Compute the norm of the new vector at v[k] */ *new_vk_norm = RSqrt(N_VDotProd(v[k], v[k])); /* Reorthogonalize if necessary */ if ((FACTOR * (*new_vk_norm)) < vk_norm) { for (i=i0; i < k; i++) { s[i] = N_VDotProd(v[i], v[k]); } if (i0 < k) { N_VScale(s[i0], v[i0], temp); h[i0][k_minus_1] += s[i0]; } for (i=i0+1; i < k; i++) { N_VLinearSum(s[i], v[i], ONE, temp, temp); h[i][k_minus_1] += s[i]; } N_VLinearSum(ONE, v[k], -ONE, temp, v[k]); *new_vk_norm = RSqrt(N_VDotProd(v[k],v[k])); } return(0); } /* * ----------------------------------------------------------------- * Function : QRfact * ----------------------------------------------------------------- * This implementation of QRfact is a slight modification of a * previous routine (called qrfact) written by Milo Dorr. * ----------------------------------------------------------------- */ int QRfact(int n, realtype **h, realtype *q, int job) { realtype c, s, temp1, temp2, temp3; int i, j, k, q_ptr, n_minus_1, code=0; switch (job) { case 0: /* Compute a new factorization of H */ code = 0; for (k=0; k < n; k++) { /* Multiply column k by the previous k-1 Givens rotations */ for (j=0; j < k-1; j++) { i = 2*j; temp1 = h[j][k]; temp2 = h[j+1][k]; c = q[i]; s = q[i+1]; h[j][k] = c*temp1 - s*temp2; h[j+1][k] = s*temp1 + c*temp2; } /* Compute the Givens rotation components c and s */ q_ptr = 2*k; temp1 = h[k][k]; temp2 = h[k+1][k]; if( temp2 == ZERO) { c = ONE; s = ZERO; } else if (ABS(temp2) >= ABS(temp1)) { temp3 = temp1/temp2; s = -ONE/RSqrt(ONE+SQR(temp3)); c = -s*temp3; } else { temp3 = temp2/temp1; c = ONE/RSqrt(ONE+SQR(temp3)); s = -c*temp3; } q[q_ptr] = c; q[q_ptr+1] = s; if( (h[k][k] = c*temp1 - s*temp2) == ZERO) code = k+1; } break; default: /* Update the factored H to which a new column has been added */ n_minus_1 = n - 1; code = 0; /* Multiply the new column by the previous n-1 Givens rotations */ for (k=0; k < n_minus_1; k++) { i = 2*k; temp1 = h[k][n_minus_1]; temp2 = h[k+1][n_minus_1]; c = q[i]; s = q[i+1]; h[k][n_minus_1] = c*temp1 - s*temp2; h[k+1][n_minus_1] = s*temp1 + c*temp2; } /* Compute new Givens rotation and multiply it times the last two entries in the new column of H. Note that the second entry of this product will be 0, so it is not necessary to compute it. */ temp1 = h[n_minus_1][n_minus_1]; temp2 = h[n][n_minus_1]; if (temp2 == ZERO) { c = ONE; s = ZERO; } else if (ABS(temp2) >= ABS(temp1)) { temp3 = temp1/temp2; s = -ONE/RSqrt(ONE+SQR(temp3)); c = -s*temp3; } else { temp3 = temp2/temp1; c = ONE/RSqrt(ONE+SQR(temp3)); s = -c*temp3; } q_ptr = 2*n_minus_1; q[q_ptr] = c; q[q_ptr+1] = s; if ((h[n_minus_1][n_minus_1] = c*temp1 - s*temp2) == ZERO) code = n; } return (code); } /* * ----------------------------------------------------------------- * Function : QRsol * ----------------------------------------------------------------- * This implementation of QRsol is a slight modification of a * previous routine (called qrsol) written by Milo Dorr. * ----------------------------------------------------------------- */ int QRsol(int n, realtype **h, realtype *q, realtype *b) { realtype c, s, temp1, temp2; int i, k, q_ptr, code=0; /* Compute Q*b */ for (k=0; k < n; k++) { q_ptr = 2*k; c = q[q_ptr]; s = q[q_ptr+1]; temp1 = b[k]; temp2 = b[k+1]; b[k] = c*temp1 - s*temp2; b[k+1] = s*temp1 + c*temp2; } /* Solve R*x = Q*b */ for (k=n-1; k >= 0; k--) { if (h[k][k] == ZERO) { code = k + 1; break; } b[k] /= h[k][k]; for (i=0; i < k; i++) b[i] -= b[k]*h[i][k]; } return (code); } sundials-2.5.0/src/sundials/sundials_sptfqmr.c0000600000175000017500000003463011741421110022363 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2007/04/06 20:33:30 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the scaled preconditioned * Transpose-Free Quasi-Minimal Residual (SPTFQMR) linear solver. * ----------------------------------------------------------------- */ #include #include #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : SptfqmrMalloc * ----------------------------------------------------------------- */ SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl) { SptfqmrMem mem; N_Vector *r; N_Vector q, d, v, p, u; N_Vector r_star, vtemp1, vtemp2, vtemp3; /* Check the input parameters */ if ((l_max <= 0) || (vec_tmpl == NULL)) return(NULL); /* Allocate space for vectors */ r_star = N_VClone(vec_tmpl); if (r_star == NULL) return(NULL); q = N_VClone(vec_tmpl); if (q == NULL) { N_VDestroy(r_star); return(NULL); } d = N_VClone(vec_tmpl); if (d == NULL) { N_VDestroy(r_star); N_VDestroy(q); return(NULL); } v = N_VClone(vec_tmpl); if (v == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); return(NULL); } p = N_VClone(vec_tmpl); if (p == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); return(NULL); } r = N_VCloneVectorArray(2, vec_tmpl); if (r == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); return(NULL); } u = N_VClone(vec_tmpl); if (u == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); return(NULL); } vtemp1 = N_VClone(vec_tmpl); if (vtemp1 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); return(NULL); } vtemp2 = N_VClone(vec_tmpl); if (vtemp2 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); return(NULL); } vtemp3 = N_VClone(vec_tmpl); if (vtemp3 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); N_VDestroy(vtemp2); return(NULL); } /* Allocate memory for SptfqmrMemRec */ mem = NULL; mem = (SptfqmrMem) malloc(sizeof(SptfqmrMemRec)); if (mem == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); N_VDestroy(vtemp2); N_VDestroy(vtemp3); return(NULL); } /* Intialize SptfqmrMemRec data structure */ mem->l_max = l_max; mem->r_star = r_star; mem->q = q; mem->d = d; mem->v = v; mem->p = p; mem->r = r; mem->u = u; mem->vtemp1 = vtemp1; mem->vtemp2 = vtemp2; mem->vtemp3 = vtemp3; /* Return pointer to SPTFQMR memory block */ return(mem); } #define l_max (mem->l_max) #define r_star (mem->r_star) #define q_ (mem->q) #define d_ (mem->d) #define v_ (mem->v) #define p_ (mem->p) #define r_ (mem->r) #define u_ (mem->u) #define vtemp1 (mem->vtemp1) #define vtemp2 (mem->vtemp2) #define vtemp3 (mem->vtemp3) /* * ----------------------------------------------------------------- * Function : SptfqmrSolve * ----------------------------------------------------------------- */ int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; realtype rho[2]; realtype r_init_norm, r_curr_norm; realtype temp_val; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; booleantype b_ok; int n, m, ier; /* Exit immediately if memory pointer is NULL */ if (mem == NULL) return(SPTFQMR_MEM_NULL); temp_val = r_curr_norm = -ONE; /* Initialize to avoid compiler warnings */ *nli = *nps = 0; /* Initialize counters */ converged = FALSE; /* Initialize convergence flag */ b_ok = FALSE; if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ /* NOTE: if x == 0 then just set residual to b and continue */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ if (preOnLeft) { ier = psolve(P_data, r_star, vtemp1, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, r_star, vtemp1); if (scale_b) N_VProd(sb, vtemp1, r_star); else N_VScale(ONE, vtemp1, r_star); /* Initialize rho[0] */ /* NOTE: initialized here to reduce number of computations - avoid need to compute r_star^T*r_star twice, and avoid needlessly squaring values */ rho[0] = N_VDotProd(r_star, r_star); /* Compute norm of initial residual (r_0) to see if we really need to do anything */ *res_norm = r_init_norm = RSqrt(rho[0]); if (r_init_norm <= delta) return(SPTFQMR_SUCCESS); /* Set v_ = A*r_0 (preconditioned and scaled) */ if (scale_x) N_VDiv(r_star, sx, vtemp1); else N_VScale(ONE, r_star, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v_); ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, vtemp1, v_); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, v_, vtemp1, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, v_, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v_); else N_VScale(ONE, vtemp1, v_); /* Initialize remaining variables */ N_VScale(ONE, r_star, r_[0]); N_VScale(ONE, r_star, u_); N_VScale(ONE, r_star, p_); N_VConst(ZERO, d_); tau = r_init_norm; v_bar = eta = ZERO; /* START outer loop */ for (n = 0; n < l_max; ++n) { /* Increment linear iteration counter */ (*nli)++; /* sigma = r_star^T*v_ */ sigma = N_VDotProd(r_star, v_); /* alpha = rho[0]/sigma */ alpha = rho[0]/sigma; /* q_ = u_-alpha*v_ */ N_VLinearSum(ONE, u_, -alpha, v_, q_); /* r_[1] = r_[0]-alpha*A*(u_+q_) */ N_VLinearSum(ONE, u_, ONE, q_, r_[1]); if (scale_x) N_VDiv(r_[1], sx, r_[1]); if (preOnRight) { N_VScale(ONE, r_[1], vtemp1); ier = psolve(P_data, vtemp1, r_[1], PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, r_[1], vtemp1); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, vtemp1, r_[1], PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, vtemp1, r_[1]); if (scale_b) N_VProd(sb, r_[1], vtemp1); else N_VScale(ONE, r_[1], vtemp1); N_VLinearSum(ONE, r_[0], -alpha, vtemp1, r_[1]); /* START inner loop */ for (m = 0; m < 2; ++m) { /* d_ = [*]+(v_bar^2*eta/alpha)*d_ */ /* NOTES: * (1) [*] = u_ if m == 0, and q_ if m == 1 * (2) using temp_val reduces the number of required computations * if the inner loop is executed twice */ if (m == 0) { temp_val = RSqrt(N_VDotProd(r_[1], r_[1])); omega = RSqrt(RSqrt(N_VDotProd(r_[0], r_[0]))*temp_val); N_VLinearSum(ONE, u_, SQR(v_bar)*eta/alpha, d_, d_); } else { omega = temp_val; N_VLinearSum(ONE, q_, SQR(v_bar)*eta/alpha, d_, d_); } /* v_bar = omega/tau */ v_bar = omega/tau; /* c = (1+v_bar^2)^(-1/2) */ c = ONE / RSqrt(ONE+SQR(v_bar)); /* tau = tau*v_bar*c */ tau = tau*v_bar*c; /* eta = c^2*alpha */ eta = SQR(c)*alpha; /* x = x+eta*d_ */ N_VLinearSum(ONE, x, eta, d_, x); /* Check for convergence... */ /* NOTE: just use approximation to norm of residual, if possible */ *res_norm = r_curr_norm = tau*RSqrt(m+1); /* Exit inner loop if iteration has converged based upon approximation to norm of current residual */ if (r_curr_norm <= delta) { converged = TRUE; break; } /* Decide if actual norm of residual vector should be computed */ /* NOTES: * (1) if r_curr_norm > delta, then check if actual residual norm * is OK (recall we first compute an approximation) * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then * compute actual residual norm to see if the iteration can be * saved * (3) the scaled and preconditioned right-hand side of the given * linear system (denoted by b) is only computed once, and the * result is stored in vtemp3 so it can be reused - reduces the * number of psovles if using left preconditioning */ if ((r_curr_norm > delta) || (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ if (scale_x) N_VDiv(x, sx, vtemp1); else N_VScale(ONE, x, vtemp1); if (preOnRight) { ier = psolve(P_data, vtemp1, vtemp2, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); N_VScale(ONE, vtemp2, vtemp1); } ier = atimes(A_data, vtemp1, vtemp2); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, vtemp2, vtemp1, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, vtemp2, vtemp1); if (scale_b) N_VProd(sb, vtemp1, vtemp2); else N_VScale(ONE, vtemp1, vtemp2); /* Only precondition and scale b once (result saved for reuse) */ if (!b_ok) { b_ok = TRUE; if (preOnLeft) { ier = psolve(P_data, b, vtemp3, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, b, vtemp3); if (scale_b) N_VProd(sb, vtemp3, vtemp3); } N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); *res_norm = r_curr_norm = RSqrt(N_VDotProd(vtemp1, vtemp1)); /* Exit inner loop if inequality condition is satisfied (meaning exit if we have converged) */ if (r_curr_norm <= delta) { converged = TRUE; break; } } } /* END inner loop */ /* If converged, then exit outer loop as well */ if (converged == TRUE) break; /* rho[1] = r_star^T*r_[1] */ rho[1] = N_VDotProd(r_star, r_[1]); /* beta = rho[1]/rho[0] */ beta = rho[1]/rho[0]; /* u_ = r_[1]+beta*q_ */ N_VLinearSum(ONE, r_[1], beta, q_, u_); /* p_ = u_+beta*(q_+beta*p_) */ N_VLinearSum(beta, q_, SQR(beta), p_, p_); N_VLinearSum(ONE, u_, ONE, p_, p_); /* v_ = A*p_ */ if (scale_x) N_VDiv(p_, sx, vtemp1); else N_VScale(ONE, p_, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v_); ier = psolve(P_data, v_, vtemp1, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, vtemp1, v_); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, v_, vtemp1, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, v_, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v_); else N_VScale(ONE, vtemp1, v_); /* Shift variable values */ /* NOTE: reduces storage requirements */ N_VScale(ONE, r_[1], r_[0]); rho[0] = rho[1]; } /* END outer loop */ /* Determine return value */ /* If iteration converged or residual was reduced, then return current iterate (x) */ if ((converged == TRUE) || (r_curr_norm < r_init_norm)) { if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp1, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); N_VScale(ONE, vtemp1, x); } if (converged == TRUE) return(SPTFQMR_SUCCESS); else return(SPTFQMR_RES_REDUCED); } /* Otherwise, return error code */ else return(SPTFQMR_CONV_FAIL); } /* * ----------------------------------------------------------------- * Function : SptfqmrFree * ----------------------------------------------------------------- */ void SptfqmrFree(SptfqmrMem mem) { if (mem == NULL) return; N_VDestroy(r_star); N_VDestroy(q_); N_VDestroy(d_); N_VDestroy(v_); N_VDestroy(p_); N_VDestroyVectorArray(r_, 2); N_VDestroy(u_); N_VDestroy(vtemp1); N_VDestroy(vtemp2); N_VDestroy(vtemp3); free(mem); mem = NULL; } sundials-2.5.0/src/sundials/sundials_math.c0000600000175000017500000000465211741421110021621 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:38 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a simple C-language math * library. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) realtype RPowerI(realtype base, int exponent) { int i, expt; realtype prod; prod = ONE; expt = abs(exponent); for(i = 1; i <= expt; i++) prod *= base; if (exponent < 0) prod = ONE/prod; return(prod); } realtype RPowerR(realtype base, realtype exponent) { if (base <= ZERO) return(ZERO); #if defined(SUNDIALS_USE_GENERIC_MATH) return((realtype) pow((double) base, (double) exponent)); #elif defined(SUNDIALS_DOUBLE_PRECISION) return(pow(base, exponent)); #elif defined(SUNDIALS_SINGLE_PRECISION) return(powf(base, exponent)); #elif defined(SUNDIALS_EXTENDED_PRECISION) return(powl(base, exponent)); #endif } realtype RSqrt(realtype x) { if (x <= ZERO) return(ZERO); #if defined(SUNDIALS_USE_GENERIC_MATH) return((realtype) sqrt((double) x)); #elif defined(SUNDIALS_DOUBLE_PRECISION) return(sqrt(x)); #elif defined(SUNDIALS_SINGLE_PRECISION) return(sqrtf(x)); #elif defined(SUNDIALS_EXTENDED_PRECISION) return(sqrtl(x)); #endif } realtype RAbs(realtype x) { #if defined(SUNDIALS_USE_GENERIC_MATH) return((realtype) fabs((double) x)); #elif defined(SUNDIALS_DOUBLE_PRECISION) return(fabs(x)); #elif defined(SUNDIALS_SINGLE_PRECISION) return(fabsf(x)); #elif defined(SUNDIALS_EXTENDED_PRECISION) return(fabsl(x)); #endif } realtype RExp(realtype x) { #if defined(SUNDIALS_USE_GENERIC_MATH) return((realtype) exp((double) x)); #elif defined(SUNDIALS_DOUBLE_PRECISION) return(exp(x)); #elif defined(SUNDIALS_SINGLE_PRECISION) return(expf(x)); #elif defined(SUNDIALS_EXTENDED_PRECISION) return(expl(x)); #endif } sundials-2.5.0/src/sundials/sundials_band.c0000600000175000017500000001362411741421110021573 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:46:56 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a generic BAND linear * solver package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define ROW(i,j,smu) (i-j+smu) /* * ----------------------------------------------------- * Functions working on DlsMat * ----------------------------------------------------- */ long int BandGBTRF(DlsMat A, long int *p) { return(bandGBTRF(A->cols, A->M, A->mu, A->ml, A->s_mu, p)); } void BandGBTRS(DlsMat A, long int *p, realtype *b) { bandGBTRS(A->cols, A->M, A->s_mu, A->ml, p, b); } void BandCopy(DlsMat A, DlsMat B, long int copymu, long int copyml) { bandCopy(A->cols, B->cols, A->M, A->s_mu, B->s_mu, copymu, copyml); } void BandScale(realtype c, DlsMat A) { bandScale(c, A->cols, A->M, A->mu, A->ml, A->s_mu); } /* * ----------------------------------------------------- * Functions working on realtype** * ----------------------------------------------------- */ long int bandGBTRF(realtype **a, long int n, long int mu, long int ml, long int smu, long int *p) { long int c, r, num_rows; long int i, j, k, l, storage_l, storage_k, last_col_k, last_row_k; realtype *a_c, *col_k, *diag_k, *sub_diag_k, *col_j, *kptr, *jptr; realtype max, temp, mult, a_kj; booleantype swap; /* zero out the first smu - mu rows of the rectangular array a */ num_rows = smu - mu; if (num_rows > 0) { for (c=0; c < n; c++) { a_c = a[c]; for (r=0; r < num_rows; r++) { a_c[r] = ZERO; } } } /* k = elimination step number */ for (k=0; k < n-1; k++, p++) { col_k = a[k]; diag_k = col_k + smu; sub_diag_k = diag_k + 1; last_row_k = MIN(n-1,k+ml); /* find l = pivot row number */ l=k; max = ABS(*diag_k); for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { if (ABS(*kptr) > max) { l=i; max = ABS(*kptr); } } storage_l = ROW(l, k, smu); *p = l; /* check for zero pivot element */ if (col_k[storage_l] == ZERO) return(k+1); /* swap a(l,k) and a(k,k) if necessary */ if ( (swap = (l != k) )) { temp = col_k[storage_l]; col_k[storage_l] = *diag_k; *diag_k = temp; } /* Scale the elements below the diagonal in */ /* column k by -1.0 / a(k,k). After the above swap, */ /* a(k,k) holds the pivot element. This scaling */ /* stores the pivot row multipliers -a(i,k)/a(k,k) */ /* in a(i,k), i=k+1, ..., MIN(n-1,k+ml). */ mult = -ONE / (*diag_k); for (i=k+1, kptr = sub_diag_k; i <= last_row_k; i++, kptr++) (*kptr) *= mult; /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., MIN(n-1,k+ml) */ /* row k is the pivot row after swapping with row l. */ /* The computation is done one column at a time, */ /* column j=k+1, ..., MIN(k+smu,n-1). */ last_col_k = MIN(k+smu,n-1); for (j=k+1; j <= last_col_k; j++) { col_j = a[j]; storage_l = ROW(l,j,smu); storage_k = ROW(k,j,smu); a_kj = col_j[storage_l]; /* Swap the elements a(k,j) and a(k,l) if l!=k. */ if (swap) { col_j[storage_l] = col_j[storage_k]; col_j[storage_k] = a_kj; } /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ /* a_kj = a(k,j), *kptr = - a(i,k)/a(k,k), *jptr = a(i,j) */ if (a_kj != ZERO) { for (i=k+1, kptr=sub_diag_k, jptr=col_j+ROW(k+1,j,smu); i <= last_row_k; i++, kptr++, jptr++) (*jptr) += a_kj * (*kptr); } } } /* set the last pivot row to be n-1 and check for a zero pivot */ *p = n-1; if (a[n-1][smu] == ZERO) return(n); /* return 0 to indicate success */ return(0); } void bandGBTRS(realtype **a, long int n, long int smu, long int ml, long int *p, realtype *b) { long int k, l, i, first_row_k, last_row_k; realtype mult, *diag_k; /* Solve Ly = Pb, store solution y in b */ for (k=0; k < n-1; k++) { l = p[k]; mult = b[l]; if (l != k) { b[l] = b[k]; b[k] = mult; } diag_k = a[k]+smu; last_row_k = MIN(n-1,k+ml); for (i=k+1; i <= last_row_k; i++) b[i] += mult * diag_k[i-k]; } /* Solve Ux = y, store solution x in b */ for (k=n-1; k >= 0; k--) { diag_k = a[k]+smu; first_row_k = MAX(0,k-smu); b[k] /= (*diag_k); mult = -b[k]; for (i=first_row_k; i <= k-1; i++) b[i] += mult*diag_k[i-k]; } } void bandCopy(realtype **a, realtype **b, long int n, long int a_smu, long int b_smu, long int copymu, long int copyml) { long int i, j, copySize; realtype *a_col_j, *b_col_j; copySize = copymu + copyml + 1; for (j=0; j < n; j++) { a_col_j = a[j]+a_smu-copymu; b_col_j = b[j]+b_smu-copymu; for (i=0; i < copySize; i++) b_col_j[i] = a_col_j[i]; } } void bandScale(realtype c, realtype **a, long int n, long int mu, long int ml, long int smu) { long int i, j, colSize; realtype *col_j; colSize = mu + ml + 1; for(j=0; j < n; j++) { col_j = a[j]+smu-mu; for (i=0; i < colSize; i++) col_j[i] *= c; } } void bandAddIdentity(realtype **a, long int n, long int smu) { long int j; for(j=0; j < n; j++) a[j][smu] += ONE; } sundials-2.5.0/src/sundials/sundials_direct.c0000600000175000017500000001412111741421110022132 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 22:46:56 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for operations to be used by a * generic direct linear solver. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) DlsMat NewDenseMat(long int M, long int N) { DlsMat A; long int j; if ( (M <= 0) || (N <= 0) ) return(NULL); A = NULL; A = (DlsMat) malloc(sizeof *A); if (A==NULL) return (NULL); A->data = (realtype *) malloc(M * N * sizeof(realtype)); if (A->data == NULL) { free(A); A = NULL; return(NULL); } A->cols = (realtype **) malloc(N * sizeof(realtype *)); if (A->cols == NULL) { free(A->data); A->data = NULL; free(A); A = NULL; return(NULL); } for (j=0; j < N; j++) A->cols[j] = A->data + j * M; A->M = M; A->N = N; A->ldim = M; A->ldata = M*N; A->type = SUNDIALS_DENSE; return(A); } realtype **newDenseMat(long int m, long int n) { long int j; realtype **a; if ( (n <= 0) || (m <= 0) ) return(NULL); a = NULL; a = (realtype **) malloc(n * sizeof(realtype *)); if (a == NULL) return(NULL); a[0] = NULL; a[0] = (realtype *) malloc(m * n * sizeof(realtype)); if (a[0] == NULL) { free(a); a = NULL; return(NULL); } for (j=1; j < n; j++) a[j] = a[0] + j * m; return(a); } DlsMat NewBandMat(long int N, long int mu, long int ml, long int smu) { DlsMat A; long int j, colSize; if (N <= 0) return(NULL); A = NULL; A = (DlsMat) malloc(sizeof *A); if (A == NULL) return (NULL); colSize = smu + ml + 1; A->data = NULL; A->data = (realtype *) malloc(N * colSize * sizeof(realtype)); if (A->data == NULL) { free(A); A = NULL; return(NULL); } A->cols = NULL; A->cols = (realtype **) malloc(N * sizeof(realtype *)); if (A->cols == NULL) { free(A->data); free(A); A = NULL; return(NULL); } for (j=0; j < N; j++) A->cols[j] = A->data + j * colSize; A->M = N; A->N = N; A->mu = mu; A->ml = ml; A->s_mu = smu; A->ldim = colSize; A->ldata = N * colSize; A->type = SUNDIALS_BAND; return(A); } realtype **newBandMat(long int n, long int smu, long int ml) { realtype **a; long int j, colSize; if (n <= 0) return(NULL); a = NULL; a = (realtype **) malloc(n * sizeof(realtype *)); if (a == NULL) return(NULL); colSize = smu + ml + 1; a[0] = NULL; a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); if (a[0] == NULL) { free(a); a = NULL; return(NULL); } for (j=1; j < n; j++) a[j] = a[0] + j * colSize; return(a); } void DestroyMat(DlsMat A) { free(A->data); A->data = NULL; free(A->cols); free(A); A = NULL; } void destroyMat(realtype **a) { free(a[0]); a[0] = NULL; free(a); a = NULL; } int *NewIntArray(int N) { int *vec; if (N <= 0) return(NULL); vec = NULL; vec = (int *) malloc(N * sizeof(int)); return(vec); } int *newIntArray(int n) { int *v; if (n <= 0) return(NULL); v = NULL; v = (int *) malloc(n * sizeof(int)); return(v); } long int *NewLintArray(long int N) { long int *vec; if (N <= 0) return(NULL); vec = NULL; vec = (long int *) malloc(N * sizeof(long int)); return(vec); } long int *newLintArray(long int n) { long int *v; if (n <= 0) return(NULL); v = NULL; v = (long int *) malloc(n * sizeof(long int)); return(v); } realtype *NewRealArray(long int N) { realtype *vec; if (N <= 0) return(NULL); vec = NULL; vec = (realtype *) malloc(N * sizeof(realtype)); return(vec); } realtype *newRealArray(long int m) { realtype *v; if (m <= 0) return(NULL); v = NULL; v = (realtype *) malloc(m * sizeof(realtype)); return(v); } void DestroyArray(void *V) { free(V); V = NULL; } void destroyArray(void *v) { free(v); v = NULL; } void AddIdentity(DlsMat A) { long int i; switch (A->type) { case SUNDIALS_DENSE: for (i=0; iN; i++) A->cols[i][i] += ONE; break; case SUNDIALS_BAND: for (i=0; iM; i++) A->cols[i][A->s_mu] += ONE; break; } } void SetToZero(DlsMat A) { long int i, j, colSize; realtype *col_j; switch (A->type) { case SUNDIALS_DENSE: for (j=0; jN; j++) { col_j = A->cols[j]; for (i=0; iM; i++) col_j[i] = ZERO; } break; case SUNDIALS_BAND: colSize = A->mu + A->ml + 1; for (j=0; jM; j++) { col_j = A->cols[j] + A->s_mu - A->mu; for (i=0; itype) { case SUNDIALS_DENSE: printf("\n"); for (i=0; i < A->M; i++) { for (j=0; j < A->N; j++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12Lg ", DENSE_ELEM(A,i,j)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12lg ", DENSE_ELEM(A,i,j)); #else printf("%12g ", DENSE_ELEM(A,i,j)); #endif } printf("\n"); } printf("\n"); break; case SUNDIALS_BAND: a = A->cols; printf("\n"); for (i=0; i < A->N; i++) { start = MAX(0,i-A->ml); finish = MIN(A->N-1,i+A->mu); for (j=0; j < start; j++) printf("%12s ",""); for (j=start; j <= finish; j++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12Lg ", a[j][i-j+A->s_mu]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12lg ", a[j][i-j+A->s_mu]); #else printf("%12g ", a[j][i-j+A->s_mu]); #endif } printf("\n"); } printf("\n"); break; } } sundials-2.5.0/src/sundials/README0000600000175000017500000002040111741421110017470 0ustar sylvestresylvestre SUNDIALS Shared Module Release 2.5.0, March 2012 The family of solvers referred to as SUNDIALS consists of solvers CVODE (ODE), CVODES (ODE with sensitivity analysis capabilities), IDA (DAE), IDAS (DAE with sensitivity analysis capabilities), and KINSOL (for nonlinear algebraic systems). The various solvers of this family share many subordinate modules contained in this module: - generic NVECTOR module - generic linear solver modules (band, dense, lapack, spgmr, bcg, tfqmr) - definitions of SUNDIALS types (realtype, booleantype) - common math functions (RpowerI, RPowerR, RSqrt, RAbs,...) A. Documentation ---------------- All shared submodules are fully described in the user documentation for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular solver is available in the solver's subdirectory under doc/. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_NOTES. For complete installation instructions see any of the user guides. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.7.0," LLNL technical report UCRL-MA-208108, December 2011. [2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.7.0," LLNL technical report UCRL-MA-208111, December 2011. [3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.7.0," LLNL technical report UCRL-MA-208112, December 2011. [4] R. Serban and C. Petra, "User Documentation for IDAS v1.1.0," LLNL technical report UCRL-SM-234051, December 2011. [5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User Documentation for KINSOL v2.7.0," LLNL technical report UCRL-MA-208116, December 2011. D. Releases ----------- v. 2.5.0 - Mar. 2012 v. 2.4.0 - May 2009 v. 2.3.0 - Nov. 2006 v. 2.2.0 - Mar. 2006 v. 2.1.1 - May. 2005 v. 2.1.0 - Apr. 2005 v. 2.0.2 - Mar. 2005 v. 2.0.1 - Jan. 2005 v. 2.0 - Dec. 2004 v. 1.0 - Jul. 2002 (first SUNDIALS release) v. 0.0 - Mar. 2002 E. Revision History ------------------- v. 2.4.0 (May 2009) ---> v. 2.5.0 (Mar. 2012) --------------------------------------------- - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag, have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (May 2009) --------------------------------------------- - New features - added a new generic linear solver module based on Blas + Lapack for both dense and banded matrices. - Changes to user interface - common functionality for all direct linear solvers (dense, band, and the new Lapack solver) has been collected into the DLS (Direct Linear Solver) module, implemented in the files sundials_direct.h and sundials_direct.c (similar to the SPILS module for the iterative linear solvers). - in order to include the new Lapack-based linear solver, all dimensions for the above linear solvers (problem sizes, bandwidths,... including the underlying matrix data types) are now of type 'int' (and not 'long int'). v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) ---------------------------------------------- - Changes to the user interface - modified sundials_dense and sundials_smalldense to work with rectangular m by n matrices (m <= n). - Changes related to the build system - reorganized source tree - exported header files are installed in solver-specific subdirectories of ${includedir} - sundialsTB is distributed only as part of the SUNDIALS tarball v. 2.1.1 (May 2005) ---> v. 2.2.0 (Mar. 2006) --------------------------------------------- - New features - added SPBCG (scaled preconditioned Bi-CGStab) linear solver module - added SPTFQMR (scaled preconditioned TFQMR) linear solver module - Changes related to the build system - updated configure script and Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link only if necessary) - SUNDIALS shared header files are installed under a 'sundials' subdirectory of the install include directory - the shared object files are now linked into each SUNDIALS library rather than into a separate libsundials_shared library - Changes to the user interface - added prefix 'sundials_' to all shared header files v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May.2005) --------------------------------------------- - Changes to data structures - added N_VCloneEmpty to global vector operations table v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) ---------------------------------------------- - none v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) ---------------------------------------------- - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) -------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) ------------------------------------------ - Changes to the generic NVECTOR module - removed machEnv, redefined table of vector operations (now contained in the N_Vector structure itself). - all SUNDIALS functions create new N_Vector variables through cloning, using an N_Vector passed by the user as a template. - a particular NVECTOR implementation is supposed to provide user-callable constructor and destructor functions. - removed from structure of vector operations the following functions: N_VNew, N_VNew_S, N_VFree, N_VFree_S, N_VMake, N_VDispose, N_VGetData, N_VSetData, N_VConstrProdPos, and N_VOneMask. - added in structure of vector operations the following functions: N_VClone, N_VDestroy, N_VSpace, N_VGetArrayPointer, N_VSetArrayPointer, and N_VWrmsNormMask. - Note that nvec_ser and nvec_par are now separate modules outside the shared SUNDIALS module. - Changes to the generic linear solvers - in SPGMR, added a dummy N_Vector argument to be used as a template for cloning. - in SPGMR, removed N (problem dimension) from argument list of SpgmrMalloc. - iterative.{c,h} replace iterativ.{c,h} - modified constant names in iterative.h (preconditioner types are prefixed with 'PREC_'). - changed numerical values for MODIFIED_GS (from 0 to 1) and CLASSICAL_GS (from 1 to 2). - Changes to sundialsmath submodule - replaced internal routine for estimation of unit roundoff with definition of unit roundoff from float.h - modified functions to call appropriate math routines given the precision level specified by the user. - Changes to sundialstypes submodule - removed type 'integertype'. - added definitions for 'BIG_REAL', 'SMALL_REAL', and 'UNIT_ROUNDOFF' using values from float.h based on the precision. - changed definition of macro RCONST to depend on precision. v 0.0 (Mar. 2002) ---> v. 1.0 (Jul. 2002) ----------------------------------------- 20020321 Defined and implemented generic NVECTOR module, and separate serial/ parallel NVECTOR modules, including serial/parallel F/C interfaces. Modified dense and band backsolve routines to take real* type for RHS and solution vector. 20020329 Named the DenseMat, BandMat, and SpgmrMemRec structures. 20020626 Changed type names to realtype, integertype, booleantype. Renamed llnltypes and llnlmath files. sundials-2.5.0/src/idas/0000755000175000017500000000000011767174700015743 5ustar sylvestresylvestresundials-2.5.0/src/idas/idas_spbcgs.c0000600000175000017500000004231711741421242020353 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2011/05/25 20:46:33 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDAS scaled preconditioned * Bi-CGSTAB linear solver module, IDASPBCG. * ----------------------------------------------------------------- */ #include #include #include #include "idas_spils_impl.h" #include "idas_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPBCG linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASpbcgInit(IDAMem IDA_mem); static int IDASpbcgSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASpbcgPerf(IDAMem IDA_mem, int perftask); static int IDASpbcgFree(IDAMem IDA_mem); /* IDASPBCG lfreeB function */ static void IDASpbcgFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : IDASpbcg * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDASPBCG linear solver module. * * IDASpbcg first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASpbcgInit, IDASpbcgSetup, * IDASpbcgSolve, IDASpbcgPerf, and IDASpbcgFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then sets various fields * in the IDASpilsMemRec structure. Finally, IDASpbcg allocates memory * for ytemp, yptemp, and xx, and calls SpbcgMalloc to allocate memory * for the Spbcg solver. * * The return value of IDASpbcg is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory * allocation failed * IDASPILS_ILL_INPUT = -2 if a required vector operation is not * implemented. * ----------------------------------------------------------------- */ int IDASpbcg(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASpbcgInit; lsetup = IDASpbcgSetup; lsolve = IDASpbcgSolve; lperf = IDASpbcgPerf; lfree = IDASpbcgFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPBCG; /* Set SPBCG parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Spbcg parameters */ idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SpbcgMalloc to allocate workspace for Spbcg */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl); if (spbcg_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *)spbcg_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPBCG interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define maxl (idaspils_mem->s_maxl) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASpbcgInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; idaspils_mem = (IDASpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } /* Set maxl in the SPBCG memory in case it was changed by the user */ spbcg_mem->l_max = maxl; last_flag = IDASPILS_SUCCESS; return(0); } static int IDASpbcgSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; if (retval < 0) { IDAProcessError(IDA_mem, SPBCG_PSET_FAIL_UNREC, "IDASPBCG", "IDASpbcgSetup", MSGS_PSET_FAILED); last_flag = SPBCG_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPBCG_PSET_FAIL_REC; return(+1); } last_flag = SPBCG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : IDASpbcgSolve * ----------------------------------------------------------------- * Note: The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SpbcgSolve. * We copy the solution x into b, and update the counters nli, nps, * and ncfl. If SpbcgSolve returned nli_inc = 0 (hence x = 0), we * take the SPBCG vtemp vector (= P_inverse F) as the correction * vector instead. Finally, we set the return value according to the * success of SpbcgSolve. * ----------------------------------------------------------------- */ static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; spbcg_mem = (SpbcgMem)spils_mem; /* Set SpbcgSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SpbcgSolve inputs pretype and initial guess xx = 0 */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SpbcgSolve and copy xx to bb */ retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); last_flag = retval; if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful */ nli += nli_inc; nps += nps_inc; if (retval != SPBCG_SUCCESS) ncfl++; /* Interpret return value from SpbcgSolve */ last_flag = retval; switch(retval) { case SPBCG_SUCCESS: return(0); break; case SPBCG_RES_REDUCED: return(1); break; case SPBCG_CONV_FAIL: return(1); break; case SPBCG_PSOLVE_FAIL_REC: return(1); break; case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_MEM_NULL: return(-1); break; case SPBCG_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPBCG_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : IDASpbcgPerf * ----------------------------------------------------------------- * This routine handles performance monitoring specific to the * IDASPBCG linear solver. When perftask = 0, it saves values of * various counters. When perftask = 1, it examines difference * quotients in these counters, and depending on their values, it * prints up to three warning messages. Messages are printed up to * a maximum of 10 times. * ----------------------------------------------------------------- */ static int IDASpbcgPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl)); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASpbcgFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); spbcg_mem = (SpbcgMem)spils_mem; SpbcgFree(spbcg_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Additional readability replacements */ #define lmemB (IDAADJ_mem->ia_lmemB) #define lfreeB (IDAADJ_mem->ia_lfreeB) /* * IDASpbcgB * * Wrapper for the backward phase * */ int IDASpbcgB(void *ida_mem, int which, int maxlB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDASpilsMemB idaspilsB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcgB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASPBCG", "IDASpbcgB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcgB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Get memory for IDASpilsMemRecB */ idaspilsB_mem = NULL; idaspilsB_mem = (IDASpilsMemB) malloc(sizeof(struct IDASpilsMemRecB)); if (idaspilsB_mem == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcgB", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } idaspilsB_mem->s_psetB = NULL; idaspilsB_mem->s_psolveB = NULL; idaspilsB_mem->s_P_dataB = NULL; /* initialize Jacobian function */ idaspilsB_mem->s_jtimesB = NULL; /* attach lmem and lfree */ IDAB_mem->ida_lmem = idaspilsB_mem; IDAB_mem->ida_lfree = IDASpbcgFreeB; flag = IDASpbcg(IDAB_mem->IDA_mem, maxlB); if (flag != IDASPILS_SUCCESS) { free(idaspilsB_mem); idaspilsB_mem = NULL; } return(flag); } /* * IDASpbcgFreeB */ static void IDASpbcgFreeB(IDABMem IDAB_mem) { IDASpilsMemB idaspilsB_mem; idaspilsB_mem = (IDASpilsMemB) IDAB_mem->ida_lmem; free(idaspilsB_mem); } sundials-2.5.0/src/idas/idas_spils_impl.h0000600000175000017500000001720611741421242021251 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:39:18 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the common header file (private version) for the Scaled * Preconditioned Iterative Linear Solver modules. * ----------------------------------------------------------------- */ #ifndef _IDASSPILS_IMPL_H #define _IDASSPILS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "idas_impl.h" /* Types of iterative linear solvers */ #define SPILS_SPGMR 1 #define SPILS_SPBCG 2 #define SPILS_SPTFQMR 3 /* Constants */ #define IDA_SPILS_MAXL 5 #define IDA_SPILS_MAXRS 5 /* * ----------------------------------------------------------------- * Types : IDASpilsMemRec, IDASpilsMem * ----------------------------------------------------------------- */ typedef struct IDASpilsMemRec { int s_type; /* type of scaled preconditioned iterative LS */ int s_gstype; /* type of Gram-Schmidt orthogonalization */ realtype s_sqrtN; /* sqrt(N) */ int s_maxl; /* maxl = maximum dimension of the Krylov space */ int s_maxrs; /* maxrs = max. number of GMRES restarts */ realtype s_eplifac; /* eplifac = linear convergence factor */ realtype s_dqincfac; /* dqincfac = optional increment factor in Jv */ realtype s_epslin; /* SpgrmSolve tolerance parameter */ long int s_npe; /* npe = total number of precond calls */ long int s_nli; /* nli = total number of linear iterations */ long int s_nps; /* nps = total number of psolve calls */ long int s_ncfl; /* ncfl = total number of convergence failures */ long int s_nres; /* nres = total number of calls to res */ long int s_njtimes; /* njtimes = total number of calls to jtimes */ long int s_nst0; /* nst0 = saved nst (for performance monitor) */ long int s_nni0; /* nni0 = saved nni (for performance monitor) */ long int s_nli0; /* nli0 = saved nli (for performance monitor) */ long int s_ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ long int s_ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ long int s_nwarn; /* nwarn = no. of warnings (for perf. monitor) */ N_Vector s_ytemp; /* temp vector used by IDAAtimesDQ */ N_Vector s_yptemp; /* temp vector used by IDAAtimesDQ */ N_Vector s_xx; /* temp vector used by the solve function */ N_Vector s_ycur; /* current y vector in Newton iteration */ N_Vector s_ypcur; /* current yp vector in Newton iteration */ N_Vector s_rcur; /* rcur = F(tn, ycur, ypcur) */ void *s_spils_mem; /* memory used by the generic solver */ long int s_last_flag; /* last error return flag */ /* Preconditioner computation * (a) user-provided: * - pdata == user_data * - pfree == NULL (the user dealocates memory for f_data) * (b) internal preconditioner module * - pdata == ida_mem * - pfree == set by the prec. module and called in IDASpilsFree */ IDASpilsPrecSetupFn s_pset; IDASpilsPrecSolveFn s_psolve; void (*s_pfree)(IDAMem IDA_mem); void *s_pdata; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - jdata == user_data * - jtimesDQ == FALSE * (b) internal jtimes * - jdata == ida_mem * - jtimesDQ == TRUE */ booleantype s_jtimesDQ; IDASpilsJacTimesVecFn s_jtimes; void *s_jdata; } *IDASpilsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ /* Atimes and PSolve routines called by generic solver */ int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z); int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr); /* Difference quotient approximation for Jac times vector */ int IDASpilsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *data, N_Vector work1, N_Vector work2); /* * ----------------------------------------------------------------- * Error and Warning Messages * ----------------------------------------------------------------- */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSGS_TIME "at t = %Lg, " #define MSGS_FRMT "%Le." #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSGS_TIME "at t = %lg, " #define MSGS_FRMT "%le." #else #define MSGS_TIME "at t = %g, " #define MSGS_FRMT "%e." #endif /* Error Messages */ #define MSGS_IDAMEM_NULL "Integrator memory is NULL." #define MSGS_MEM_FAIL "A memory request failed." #define MSGS_BAD_NVECTOR "A required vector operation is not implemented." #define MSGS_BAD_LSTYPE "Incompatible linear solver type." #define MSGS_LMEM_NULL "Linear solver memory is NULL." #define MSGS_BAD_GSTYPE "gstype has an illegal value." #define MSGS_NEG_MAXRS "maxrs < 0 illegal." #define MSGS_NEG_EPLIFAC "eplifac < 0.0 illegal." #define MSGS_NEG_DQINCFAC "dqincfac < 0.0 illegal." #define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." /* Warning Messages */ #define MSGS_WARN "Warning: " MSGS_TIME "poor iterative algorithm performance. " #define MSGS_AVD_WARN MSGS_WARN "Average number of linear iterations is " MSGS_FRMT #define MSGS_CFN_WARN MSGS_WARN "Nonlinear convergence failure rate is " MSGS_FRMT #define MSGS_CFL_WARN MSGS_WARN "Linear convergence failure rate is " MSGS_FRMT /* * ----------------------------------------------------------------- * PART II - backward problems * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Types : IDASpilsMemRecB, IDASpilsMemB * ----------------------------------------------------------------- * IDASpgmrB, IDASpbcgB, and IDASptfqmr attach such a structure to the * lmemB filed of IDAadjMem * ----------------------------------------------------------------- */ typedef struct IDASpilsMemRecB { IDASpilsJacTimesVecFnB s_jtimesB; IDASpilsPrecSetupFnB s_psetB; IDASpilsPrecSolveFnB s_psolveB; void *s_P_dataB; } *IDASpilsMemB; /* * ----------------------------------------------------------------- * Error Messages * ----------------------------------------------------------------- */ #define MSGS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSGS_BAD_T "Bad t for interpolation." #define MSGS_BAD_WHICH "Illegal value for which." #define MSGS_NO_ADJ "Illegal attempt to call before calling IDAAdjInit." #define MSGS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/idas/CMakeLists.txt0000600000175000017500000000704611741421242020466 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:48 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the IDAS library INSTALL(CODE "MESSAGE(\"\nInstall IDAS\n\")") # Add variable idas_SOURCES with the sources for the IDAS library SET(idas_SOURCES idas.c idaa.c idas_io.c idas_ic.c idaa_io.c idas_direct.c idas_band.c idas_dense.c idas_spils.c idas_spbcgs.c idas_spgmr.c idas_sptfqmr.c idas_bbdpre.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the IDAS library SET(shared_SOURCES sundials_nvector.c sundials_math.c sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_spbcgs.c sundials_spgmr.c sundials_sptfqmr.c ) # Add prefix with complete path to the common SUNDIALS sources ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable idas_HEADERS with the exported IDAS header files SET(idas_HEADERS idas_band.h idas_bbdpre.h idas_dense.h idas_direct.h idas.h idas_spbcgs.h idas_spgmr.h idas_spils.h idas_sptfqmr.h ) # Add prefix with complete path to the IDAS header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/idas/ idas_HEADERS) # If Blas/Lapack support was enabled, set-up additional file lists IF(LAPACK_FOUND) SET(idas_BL_SOURCES idas_lapack.c) SET(idas_BL_HEADERS idas_lapack.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/idas/ idas_BL_HEADERS) ELSE(LAPACK_FOUND) SET(idas_BL_SOURCES "") SET(idas_BL_HEADERS "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static IDAS library ADD_LIBRARY(sundials_idas_static STATIC ${idas_SOURCES} ${idas_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_idas_static PROPERTIES OUTPUT_NAME sundials_idas CLEAN_DIRECT_OUTPUT 1) # Install the IDA library INSTALL(TARGETS sundials_idas_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the IDAS library ADD_LIBRARY(sundials_idas_shared SHARED ${idas_SOURCES} ${idas_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_idas_shared PROPERTIES OUTPUT_NAME sundials_idas CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_idas_shared PROPERTIES VERSION ${idaslib_VERSION} SOVERSION ${idaslib_SOVERSION}) # Install the IDAS library INSTALL(TARGETS sundials_idas_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the IDAS header files INSTALL(FILES ${idas_HEADERS} ${idas_BL_HEADERS} DESTINATION include/idas) # Install the IDAS implementation header file INSTALL(FILES idas_impl.h DESTINATION include/idas) # MESSAGE(STATUS "Added IDAS module") sundials-2.5.0/src/idas/Makefile.in0000600000175000017500000001600411741421242017765 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDA module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include LIB_REVISION = 0:0:0 IDAS_LIB = libsundials_idas.la IDAS_SRC_FILES = idas.c idaa.c idas_ic.c idas_io.c idaa_io.c idas_direct.c idas_dense.c idas_band.c idas_spils.c idas_spbcgs.c idas_spgmr.c idas_sptfqmr.c idas_bbdpre.c IDAS_BL_SRC_FILES = idas_lapack.c IDAS_OBJ_FILES = $(IDAS_SRC_FILES:.c=.o) IDAS_BL_OBJ_FILES = $(IDAS_BL_SRC_FILES:.c=.o) IDAS_LIB_FILES = $(IDAS_SRC_FILES:.c=.lo) IDAS_BL_LIB_FILES = $(IDAS_BL_SRC_FILES:.c=.lo) SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ $(top_builddir)/src/sundials/sundials_dense.lo \ $(top_builddir)/src/sundials/sundials_direct.lo \ $(top_builddir)/src/sundials/sundials_iterative.lo \ $(top_builddir)/src/sundials/sundials_spgmr.lo \ $(top_builddir)/src/sundials/sundials_spbcgs.lo \ $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ $(top_builddir)/src/sundials/sundials_math.lo \ $(top_builddir)/src/sundials/sundials_nvector.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(IDAS_LIB) $(IDAS_LIB): shared $(IDAS_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: shared $(IDAS_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDAS_LIB) $(IDAS_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) lib_with_bl: shared $(IDAS_LIB_FILES) $(IDAS_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDAS_LIB) $(IDAS_LIB_FILES) $(IDAS_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) install: $(IDAS_LIB) $(mkinstalldirs) $(includedir)/idas $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(IDAS_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_direct.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_dense.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_band.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_spbcgs.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_spgmr.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_sptfqmr.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_bbdpre.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_spils.h $(includedir)/idas/ $(INSTALL_HEADER) $(top_srcdir)/src/idas/idas_impl.h $(includedir)/idas/ @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ $(INSTALL_HEADER) $(top_srcdir)/include/idas/idas_lapack.h $(includedir)/idas/ ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(IDAS_LIB) rm -f $(includedir)/idas/idas.h rm -f $(includedir)/idas/idas_direct.h rm -f $(includedir)/idas/idas_dense.h rm -f $(includedir)/idas/idas_band.h rm -f $(includedir)/idas/idas_lapack.h rm -f $(includedir)/idas/idas_spbcgs.h rm -f $(includedir)/idas/idas_spgmr.h rm -f $(includedir)/idas/idas_sptfqmr.h rm -f $(includedir)/idas/idas_bbdpre.h rm -f $(includedir)/idas/idas_spils.h rm -f $(includedir)/idas/idas_impl.h $(rminstalldirs) ${includedir}/idas shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(IDAS_LIB) rm -f $(IDAS_LIB_FILES) rm -f $(IDAS_BL_LIB_FILES) rm -f $(IDAS_OBJ_FILES) rm -f $(IDAS_BL_OBJ_FILES) distclean: clean rm -f Makefile idas.lo: $(srcdir)/idas.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas.c idaa.lo: $(srcdir)/idaa.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idaa.c idas_ic.lo: $(srcdir)/idas_ic.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_ic.c idas_io.lo: $(srcdir)/idas_io.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_io.c idaa_io.lo: $(srcdir)/idaa_io.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idaa_io.c idas_direct.lo: $(srcdir)/idas_direct.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_direct.c idas_dense.lo: $(srcdir)/idas_dense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_dense.c idas_band.lo: $(srcdir)/idas_band.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_band.c idas_lapack.lo: $(srcdir)/idas_lapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_lapack.c idas_spils.lo: $(srcdir)/idas_spils.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_spils.c idas_spbcgs.lo: $(srcdir)/idas_spbcgs.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_spbcgs.c idas_spgmr.lo: $(srcdir)/idas_spgmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_spgmr.c idas_sptfqmr.lo: $(srcdir)/idas_sptfqmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_sptfqmr.c idas_bbdpre.lo: $(srcdir)/idas_bbdpre.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/idas_bbdpre.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/idas/idas_io.c0000600000175000017500000012576411741421242017511 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.26 $ * $Date: 2010/12/01 22:39:19 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the implementation file for the optional inputs and * outputs for the IDAS solver. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWOPT5 RCONST(2.5) /* * ================================================================= * IDA optional input functions * ================================================================= */ /* * Readability constants */ #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetErrHandlerFn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_ehfun = ehfun; IDA_mem->ida_eh_data = eh_data; return(IDA_SUCCESS); } int IDASetErrFile(void *ida_mem, FILE *errfp) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetErrFile", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_errfp = errfp; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetUserData(void *ida_mem, void *user_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetUserData", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_user_data = user_data; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxOrd(void *ida_mem, int maxord) { IDAMem IDA_mem; int maxord_alloc; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxOrd", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxord <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxOrd", MSG_NEG_MAXORD); return(IDA_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ maxord_alloc = IDA_mem->ida_maxord_alloc; if (maxord > maxord_alloc) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxOrd", MSG_BAD_MAXORD); return(IDA_ILL_INPUT); } IDA_mem->ida_maxord = MIN(maxord,MAXORD_DEFAULT); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) IDA_mem->ida_mxstep = MXSTEP_DEFAULT; else IDA_mem->ida_mxstep = mxsteps; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetInitStep(void *ida_mem, realtype hin) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_hin = hin; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxStep(void *ida_mem, realtype hmax) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (hmax < 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxStep", MSG_NEG_HMAX); return(IDA_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; return(IDA_SUCCESS); } IDA_mem->ida_hmax_inv = ONE/hmax; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStopTime(void *ida_mem, realtype tstop) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetStopTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* If IDASolve was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If IDASetStopTime is called before the first call to IDASolve, * tstop will be checked in IDASolve. */ if (IDA_mem->ida_nst > 0) { if ( (tstop - IDA_mem->ida_tn) * IDA_mem->ida_hh < ZERO ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStopTime", MSG_BAD_TSTOP, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } } IDA_mem->ida_tstop = tstop; IDA_mem->ida_tstopset = TRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinConvCoef", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epcon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinConvCoef", MSG_NEG_EPCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epcon = epcon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxErrTestFails(void *ida_mem, int maxnef) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxErrTestFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxnef = maxnef; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxConvFails(void *ida_mem, int maxncf) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxConvFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxncf = maxncf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNonlinIters(void *ida_mem, int maxcor) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNonlinIters", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxcor = maxcor; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSuppressAlg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_suppressalg = suppressalg; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetId(void *ida_mem, N_Vector id) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetId", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (id == NULL) { if (IDA_mem->ida_idMallocDone) { N_VDestroy(IDA_mem->ida_id); lrw -= lrw1; liw -= liw1; } IDA_mem->ida_idMallocDone = FALSE; return(IDA_SUCCESS); } if ( !(IDA_mem->ida_idMallocDone) ) { IDA_mem->ida_id = N_VClone(id); lrw += lrw1; liw += liw1; IDA_mem->ida_idMallocDone = TRUE; } /* Load the id vector */ N_VScale(ONE, id, IDA_mem->ida_id); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetConstraints(void *ida_mem, N_Vector constraints) { IDAMem IDA_mem; realtype temptest; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetConstraints", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (constraints == NULL) { if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(IDA_mem->ida_constraints); lrw -= lrw1; liw -= liw1; } IDA_mem->ida_constraintsMallocDone = FALSE; IDA_mem->ida_constraintsSet = FALSE; return(IDA_SUCCESS); } /* Test if required vector ops. are defined */ if (constraints->ops->nvdiv == NULL || constraints->ops->nvmaxnorm == NULL || constraints->ops->nvcompare == NULL || constraints->ops->nvconstrmask == NULL || constraints->ops->nvminquotient == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetConstraints", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if((temptest > TWOPT5) || (temptest < HALF)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetConstraints", MSG_BAD_CONSTR); return(IDA_ILL_INPUT); } if ( !(IDA_mem->ida_constraintsMallocDone) ) { IDA_mem->ida_constraints = N_VClone(constraints); lrw += lrw1; liw += liw1; IDA_mem->ida_constraintsMallocDone = TRUE; } /* Load the constraints vector */ N_VScale(ONE, constraints, IDA_mem->ida_constraints); IDA_mem->ida_constraintsSet = TRUE; return(IDA_SUCCESS); } /* * IDASetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int IDASetRootDirection(void *ida_mem, int *rootdir) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetRootDirection", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; if (nrt==0) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDASetRootDirection", MSG_NO_ROOT); return(IDA_ILL_INPUT); } for(i=0; iida_rootdir[i] = rootdir[i]; return(IDA_SUCCESS); } /* * IDASetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int IDASetNoInactiveRootWarn(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNoInactiveRootWarn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_mxgnull = 0; return(IDA_SUCCESS); } /* * ================================================================= * IDA IC optional input functions * ================================================================= */ int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinConvCoefIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epiccon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinConvCoefIC", MSG_BAD_EPICCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epiccon = epiccon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumStepsIC(void *ida_mem, int maxnh) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumStepsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnh <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumStepsIC", MSG_BAD_MAXNH); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnh = maxnh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumJacsIC(void *ida_mem, int maxnj) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumJacsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnj <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumJacsIC", MSG_BAD_MAXNJ); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnj = maxnj; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumItersIC(void *ida_mem, int maxnit) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumItersIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnit <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumItersIC", MSG_BAD_MAXNIT); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnit = maxnit; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetLineSearchOffIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_lsoff = lsoff; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStepToleranceIC(void *ida_mem, realtype steptol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetStepToleranceIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (steptol <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetStepToleranceIC", MSG_BAD_STEPTOL); return(IDA_ILL_INPUT); } IDA_mem->ida_steptol = steptol; return(IDA_SUCCESS); } /* * ================================================================= * Quadrature optional input functions * ================================================================= */ /* * Readability constants */ #define lrw1Q (IDA_mem->ida_lrw1Q) #define liw1Q (IDA_mem->ida_liw1Q) /*-----------------------------------------------------------------*/ int IDASetQuadErrCon(void *ida_mem, booleantype errconQ) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetQuadErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadMallocDone == FALSE) { IDAProcessError(NULL, IDA_NO_QUAD, "IDAS", "IDASetQuadErrCon", MSG_NO_QUAD); return(IDA_NO_QUAD); } IDA_mem->ida_errconQ = errconQ; return (IDA_SUCCESS); } /* * ================================================================= * FSA optional input functions * ================================================================= */ int IDASetSensDQMethod(void *ida_mem, int DQtype, realtype DQrhomax) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensDQMethod", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if ( (DQtype != IDA_CENTERED) && (DQtype != IDA_FORWARD) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetSensDQMethod", MSG_BAD_DQTYPE); return(IDA_ILL_INPUT); } if (DQrhomax < ZERO ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetSensDQMethod", MSG_BAD_DQRHO); return(IDA_ILL_INPUT); } IDA_mem->ida_DQtype = DQtype; IDA_mem->ida_DQrhomax = DQrhomax; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSensErrCon(void *ida_mem, booleantype errconS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_errconS = errconS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSensMaxNonlinIters(void *ida_mem, int maxcorS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensMaxNonlinIters", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxcorS = maxcorS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSensParams(void *ida_mem, realtype *p, realtype *pbar, int *plist) { IDAMem IDA_mem; int Ns, is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensParams", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASetSensParams", MSG_NO_SENSI); return(IDA_NO_SENS); } Ns = IDA_mem->ida_Ns; /* Parameters */ IDA_mem->ida_p = p; /* pbar */ if (pbar != NULL) for (is=0; isida_pbar[is] = ABS(pbar[is]); } else for (is=0; isida_pbar[is] = ONE; /* plist */ if (plist != NULL) for (is=0; isida_plist[is] = plist[is]; } else for (is=0; isida_plist[is] = is; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Function: IDASetQuadSensErrCon * ----------------------------------------------------------------- * IDASetQuadSensErrCon specifies if quadrature sensitivity variables * are considered or not in the error control. * ----------------------------------------------------------------- */ int IDASetQuadSensErrCon(void *ida_mem, booleantype errconQS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetQuadSensErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASetQuadSensErrCon", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was quadrature sensitivity initialized? */ if (IDA_mem->ida_quadSensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDASetQuadSensErrCon", MSG_NO_SENSI); return(IDA_NO_QUADSENS); } IDA_mem->ida_errconQS = errconQS; return(IDA_SUCCESS); } /* * ================================================================= * IDA optional output functions * ================================================================= */ /* * Readability constants */ #define ewt (IDA_mem->ida_ewt) #define kk (IDA_mem->ida_kk) #define hh (IDA_mem->ida_hh) #define h0u (IDA_mem->ida_h0u) #define tn (IDA_mem->ida_tn) #define nbacktr (IDA_mem->ida_nbacktr) #define nst (IDA_mem->ida_nst) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define netf (IDA_mem->ida_netf) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) #define kused (IDA_mem->ida_kused) #define hused (IDA_mem->ida_hused) #define tolsf (IDA_mem->ida_tolsf) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define nge (IDA_mem->ida_nge) #define iroots (IDA_mem->ida_iroots) #define ee (IDA_mem->ida_ee) int IDAGetNumSteps(void *ida_mem, long int *nsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = nst; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumResEvals(void *ida_mem, long int *nrevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumResEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nrevals = nre; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumLinSolvSetups", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nlinsetups = nsetups; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *netfails = netf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumBacktrackOps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nbacktracks = nbacktr; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetConsistentIC(void *ida_mem, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetConsistentIC", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_kused != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAGetConsistentIC", MSG_TOO_LATE); return(IDA_ILL_INPUT); } if(yy0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[0], yy0); if(yp0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[1], yp0); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastOrder(void *ida_mem, int *klast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetLastOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *klast = kused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentOrder(void *ida_mem, int *kcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *kcur = kk; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetActualInitStep(void *ida_mem, realtype *hinused) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetActualInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hinused = h0u; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastStep(void *ida_mem, realtype *hlast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetLastStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hlast = hused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentStep(void *ida_mem, realtype *hcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hcur = hh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentTime(void *ida_mem, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tcur = tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetTolScaleFactor", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tolsfact = tolsf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetErrWeights(void *ida_mem, N_Vector eweight) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetErrWeights", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, ewt, eweight); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetEstLocalErrors", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, ee, ele); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetWorkSpace", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *leniw = liw; *lenrw = lrw; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *klast, int *kcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetIntegratorStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = nst; *nrevals = nre; *nlinsetups = nsetups; *netfails = netf; *klast = kused; *kcur = kk; *hinused = h0u; *hlast = hused; *hcur = hh; *tcur = tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumGEvals(void *ida_mem, long int *ngevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumGEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *ngevals = nge; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetRootInfo(void *ida_mem, int *rootsfound) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetRootInfo", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; for (i=0; iida_quadr) #define nrQe (IDA_mem->ida_nrQe) #define netfQ (IDA_mem->ida_netfQ) #define ewtQ (IDA_mem->ida_ewtQ) #define errconQ (IDA_mem->ida_errconQ) /*-----------------------------------------------------------------*/ int IDAGetQuadNumRhsEvals(void *ida_mem, long int *nrQevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadNumRhsEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr==FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadNumRhsEvals", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nrQevals = nrQe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadNumErrTestFails(void *ida_mem, long int *nQetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr==FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadNumErrTestFails", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nQetfails = netfQ; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadErrWeights(void *ida_mem, N_Vector eQweight) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr==FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadErrWeights", MSG_NO_QUAD); return(IDA_NO_QUAD); } if(errconQ) N_VScale(ONE, ewtQ, eQweight); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadStats(void *ida_mem, long int *nrQevals, long int *nQetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr==FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadStats", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nrQevals = nrQe; *nQetfails = netfQ; return(IDA_SUCCESS); } /* * ================================================================= * Quadrature FSA optional output functions * ================================================================= */ /* * Readability constants */ #define quadr_sensi (IDA_mem->ida_quadr_sensi) #define nrQSe (IDA_mem->ida_nrQSe) #define netfQS (IDA_mem->ida_netfQS) #define ewtQS (IDA_mem->ida_ewtQS) #define errconQS (IDA_mem->ida_errconQS) /*-----------------------------------------------------------------*/ int IDAGetQuadSensNumRhsEvals(void *ida_mem, long int *nrhsQSevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensNumRhsEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr_sensi == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensNumRhsEvals", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } *nrhsQSevals = nrQSe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadSensNumErrTestFails(void *ida_mem, long int *nQSetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr_sensi == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensNumErrTestFails", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } *nQSetfails = netfQS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadSensErrWeights(void *ida_mem, N_Vector *eQSweight) { IDAMem IDA_mem; int is, Ns; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (quadr_sensi == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensErrWeights", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } Ns = IDA_mem->ida_Ns; if (errconQS) for (is=0; isida_sensi) #define Ns (IDA_mem->ida_Ns) #define ism (IDA_mem->ida_ism) #define ewtS (IDA_mem->ida_ewtS) #define nrSe (IDA_mem->ida_nrSe) #define nreS (IDA_mem->ida_nreS) #define nniS (IDA_mem->ida_nniS) #define ncfnS (IDA_mem->ida_ncfnS) #define netfS (IDA_mem->ida_netfS) #define nsetupsS (IDA_mem->ida_nsetupsS) /*-----------------------------------------------------------------*/ int IDAGetSensConsistentIC(void *ida_mem, N_Vector *yyS0, N_Vector *ypS0) { IDAMem IDA_mem; int is; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensConsistentIC", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensConsistentIC", MSG_NO_SENSI); return(IDA_NO_SENS); } if (IDA_mem->ida_kused != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAGetSensConsistentIC", MSG_TOO_LATE); return(IDA_ILL_INPUT); } if(yyS0 != NULL) { for (is=0; isida_phiS[0][is], yyS0[is]); } if(ypS0 != NULL) { for (is=0; isida_phiS[1][is], ypS0[is]); } return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumResEvals(void *ida_mem, long int *nrSevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGeSensNumResEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumResEvals", MSG_NO_SENSI); return(IDA_NO_SENS); } *nrSevals = nrSe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumResEvalsSens(void *ida_mem, long int *nrevalsS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumResEvalsSens", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetNumResEvalsSens", MSG_NO_SENSI); return(IDA_NO_SENS); } *nrevalsS = nreS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumErrTestFails(void *ida_mem, long int *nSetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumErrTestFails", MSG_NO_SENSI); return(IDA_NO_SENS); } *nSetfails = netfS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumLinSolvSetups(void *ida_mem, long int *nlinsetupsS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumLinSolvSetups", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumLinSolvSetups", MSG_NO_SENSI); return(IDA_NO_SENS); } *nlinsetupsS = nsetupsS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensErrWeights(void *ida_mem, N_Vector_S eSweight) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (sensi==FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensErrWeights", MSG_NO_SENSI); return(IDA_NO_SENS); } for (is=0; is #include #include "idas_spils_impl.h" #include "idas_impl.h" /* Private constants */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define PT05 RCONST(0.05) #define ONE RCONST(1.0) /* Algorithmic constants */ #define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static int IDAAspilsPrecSetup(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *idaadj_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int IDAAspilsPrecSolve(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *idaadj_mem, N_Vector tmpB); static int IDAAspilsJacTimesVec(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *idaadj_mem, N_Vector tmp1B, N_Vector tmp2B); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define lmem (IDA_mem->ida_lmem) #define ils_type (idaspils_mem->s_type) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT * ----------------------------------------------------------------- */ int IDASpilsSetGSType(void *ida_mem, int gstype) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetGSType", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetGSType", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type != SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetGSType", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetGSType", MSGS_BAD_GSTYPE); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_gstype = gstype; return(IDASPILS_SUCCESS); } int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetMaxRestarts", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetMaxRestarts", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type != SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetMaxRestarts", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } /* Check for legal maxrs */ if (maxrs < 0) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetMaxRestarts", MSGS_NEG_MAXRS); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_maxrs = maxrs; return(IDASPILS_SUCCESS); } int IDASpilsSetMaxl(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetMaxl", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetMaxl", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type == SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetMaxl", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_maxl = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; return(IDASPILS_SUCCESS); } int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetEpsLin", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetEpsLin", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; /* Check for legal maxrs */ if (eplifac < ZERO) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetEpsLin", MSGS_NEG_EPLIFAC); return(IDASPILS_ILL_INPUT); } if (eplifac == ZERO) idaspils_mem->s_eplifac = PT05; else idaspils_mem->s_eplifac = eplifac; return(IDASPILS_SUCCESS); } int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetIncrementFactor", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetIncrementFactor", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; /* Check for legal maxrs */ if (dqincfac <= ZERO) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetIncrementFactor", MSGS_NEG_DQINCFAC); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_dqincfac = dqincfac; return(IDASPILS_SUCCESS); } int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetPreconditioner", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetPreconditioner", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; idaspils_mem->s_pset = pset; idaspils_mem->s_psolve = psolve; return(IDASPILS_SUCCESS); } int IDASpilsSetJacTimesVecFn(void *ida_mem, IDASpilsJacTimesVecFn jtv) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetJacTimesVecFn", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsSetJacTimesVecFn", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (jtv != NULL) { jtimesDQ = FALSE; jtimes = jtv; } else { jtimesDQ = TRUE; } return(IDASPILS_SUCCESS); } int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int maxl; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetWorkSpace", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetWorkSpace", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: maxl = idaspils_mem->s_maxl; *lenrwLS = lrw1*(maxl + 6) + maxl*(maxl + 4) + 1; *leniwLS = liw1*(maxl + 6); break; case SPILS_SPBCG: *lenrwLS = lrw1 * 10; *leniwLS = liw1 * 10; break; case SPILS_SPTFQMR: *lenrwLS = lrw1*13; *leniwLS = liw1*13; break; } return(IDASPILS_SUCCESS); } int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumPrecEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumPrecEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *npevals = npe; return(IDASPILS_SUCCESS); } int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumPrecSolves", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumPrecSolves", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *npsolves = nps; return(IDASPILS_SUCCESS); } int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumLinIters", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumLinIters", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nliters = nli; return(IDASPILS_SUCCESS); } int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumConvFails", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumConvFails", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nlcfails = ncfl; return(IDASPILS_SUCCESS); } int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumJtimesEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumJtimesEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *njvevals = njtimes; return(IDASPILS_SUCCESS); } int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetNumResEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetNumResEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nrevalsLS = nres; return(IDASPILS_SUCCESS); } int IDASpilsGetLastFlag(void *ida_mem, long int *flag) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsGetLastFlag", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASSPILS", "IDASpilsGetLastFlag", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *flag = last_flag; return(IDASPILS_SUCCESS); } char *IDASpilsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case IDASPILS_SUCCESS: sprintf(name,"IDASPILS_SUCCESS"); break; case IDASPILS_MEM_NULL: sprintf(name,"IDASPILS_MEM_NULL"); break; case IDASPILS_LMEM_NULL: sprintf(name,"IDASPILS_LMEM_NULL"); break; case IDASPILS_ILL_INPUT: sprintf(name,"IDASPILS_ILL_INPUT"); break; case IDASPILS_MEM_FAIL: sprintf(name,"IDASPILS_MEM_FAIL"); break; case IDASPILS_PMEM_NULL: sprintf(name,"IDASPILS_PMEM_NULL"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * IDASPILS private functions * ----------------------------------------------------------------- */ #define psolve (idaspils_mem->s_psolve) #define pdata (idaspils_mem->s_pdata) #define dqincfac (idaspils_mem->s_dqincfac) /* * This routine generates the matrix-vector product z = Jv, where * J is the system Jacobian, by calling either the user provided * routine or the internal DQ routine. */ int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int jtflag; IDA_mem = (IDAMem) ida_mem; idaspils_mem = (IDASpilsMem) lmem; jtflag = jtimes(tn, ycur, ypcur, rcur, v, z, cj, jdata, ytemp, yptemp); njtimes++; return(jtflag); } /* * This routine interfaces between the generic Solve routine and * the user's psolve routine. It passes to psolve all required state * information from ida_mem. Its return value is the same as that * returned by psolve. Note that the generic solver guarantees * that IDASilsPSolve will not be called in the case psolve = NULL. */ int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int retval; IDA_mem = (IDAMem) ida_mem; idaspils_mem = (IDASpilsMem) lmem; retval = psolve(tn, ycur, ypcur, rcur, r, z, cj, epslin, pdata, ytemp); /* This call is counted in nps within the IDASp**Solve routine */ return(retval); } /* * This routine generates the matrix-vector product z = Jv, where * J is the system Jacobian, by using a difference quotient approximation. * The approximation is * Jv = [F(t,y1,yp1) - F(t,y,yp)]/sigma, where * y1 = y + sigma*v, yp1 = yp + cj*sigma*v, * sigma = sqrt(Neq)*dqincfac. * The return value from the call to res is saved in order to set the * return flag from IDASp**Solve. */ int IDASpilsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *data, N_Vector work1, N_Vector work2) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; N_Vector y_tmp, yp_tmp; realtype sig, siginv; int iter, retval; /* data is ida_mem */ IDA_mem = (IDAMem) data; idaspils_mem = (IDASpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: sig = sqrtN*dqincfac; break; case SPILS_SPBCG: sig = dqincfac/N_VWrmsNorm(v, ewt); break; case SPILS_SPTFQMR: sig = dqincfac/N_VWrmsNorm(v, ewt); break; } /* Rename work1 and work2 for readibility */ y_tmp = work1; yp_tmp = work2; for (iter=0; iter 0) return(+1); /* Set Jv to [Jv - rr]/sig and return. */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, rr, Jv); return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Readability replacements */ #define yyTmp (IDAADJ_mem->ia_yyTmp) #define ypTmp (IDAADJ_mem->ia_ypTmp) #define noInterp (IDAADJ_mem->ia_noInterp) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT FUNCTIONS * ----------------------------------------------------------------- */ int IDASpilsSetGSTypeB(void *ida_mem, int which, int gstypeB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetGSTypeB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetGSTypeB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetGSTypeB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Call the corresponding Set* function for the backward problem. */ return IDASpilsSetGSType(ida_memB, gstypeB); } int IDASpilsSetMaxRestartsB(void *ida_mem, int which, int maxrsB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetMaxRestartsB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetMaxRestartsB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetMaxRestartsB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Call the corresponding Set* function for the backward problem. */ return IDASpilsSetMaxRestarts(ida_memB,maxrsB); } int IDASpilsSetEpsLinB(void *ida_mem, int which, realtype eplifacB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetEpsLinB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetEpsLinB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetEpsLinB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Call the corresponding Set* function for the backward problem. */ return IDASpilsSetEpsLin(ida_memB, eplifacB); } int IDASpilsSetMaxlB(void *ida_mem, int which, int maxlB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetMaxlB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetMaxlB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetMaxlB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Call the corresponding Set* function for the backward problem. */ return IDASpilsSetMaxl(ida_memB, maxlB); } int IDASpilsSetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetIncrementFactorB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetIncrementFactorB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetIncrementFactorB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Call the corresponding Set* function for the backward problem. */ return IDASpilsSetIncrementFactor(ida_memB, dqincfacB); } int IDASpilsSetPreconditionerB(void *ida_mem, int which, IDASpilsPrecSetupFnB psetB, IDASpilsPrecSolveFnB psolveB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; IDASpilsMemB idaspilsB_mem; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetPreconditionerB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetPreconditionerB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetPreconditionerB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; if ( IDAB_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEMB_NULL, "IDASSPILS", "IDASpilsSetPreconditionerB", MSGS_LMEMB_NULL); return(IDASPILS_ILL_INPUT); } /* Get the IDASpilsMemB data. */ idaspilsB_mem = (IDASpilsMemB) IDAB_mem->ida_lmem; /* Set preconditioners for the backward problem. */ idaspilsB_mem->s_psetB = psetB; idaspilsB_mem->s_psolveB = psolveB; return IDASpilsSetPreconditioner(ida_memB, IDAAspilsPrecSetup, IDAAspilsPrecSolve); } int IDASpilsSetJacTimesVecFnB(void *ida_mem, int which, IDASpilsJacTimesVecFnB jtvB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDASpilsMemB idaspilsB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASSPILS", "IDASpilsSetJacTimesVecFnB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASSPILS", "IDASpilsSetJacTimesVecFnB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASSPILS", "IDASpilsSetJacTimesVecFnB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; if ( IDAB_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEMB_NULL, "IDASSPILS", "IDASpilsSetJacTimesVecFnB", MSGS_LMEMB_NULL); return(IDASPILS_ILL_INPUT); } idaspilsB_mem = (IDASpilsMemB) IDAB_mem->ida_lmem; /* Call the corresponding Set* function for the backward problem. */ idaspilsB_mem->s_jtimesB = jtvB; if (jtvB != NULL) { flag = IDASpilsSetJacTimesVecFn(IDAB_mem, IDAAspilsJacTimesVec); } else { flag = IDASpilsSetJacTimesVecFn(IDAB_mem, NULL); } return(flag); } /* * ----------------------------------------------------------------- * IDASSPILS private functions * * Those routines are interfaces the routines provided by user for * backward problems. * * ----------------------------------------------------------------- */ static int IDAAspilsPrecSetup(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDASpilsMemB idaspilsB_mem; IDABMem IDAB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; IDAB_mem = IDAADJ_mem->ia_bckpbCrt; idaspilsB_mem = (IDASpilsMemB)IDAB_mem->ida_lmem; /* Get FORWARD solution from interpolation. */ if (noInterp==FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDASSPILS", "IDAAspilsPrecSetup", MSGS_BAD_T); return(-1); } } /* Call user's adjoint precondB routine */ flag = idaspilsB_mem->s_psetB(tt, yyTmp, ypTmp, yyB, ypB, rrB, c_jB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B); return(flag); } static int IDAAspilsPrecSolve(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *ida_mem, N_Vector tmpB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDASpilsMemB idaspilsB_mem; IDABMem IDAB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; IDAB_mem = IDAADJ_mem->ia_bckpbCrt; idaspilsB_mem = (IDASpilsMemB)IDAB_mem->ida_lmem; /* Get FORWARD solution from interpolation. */ if (noInterp==FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDASSPILS", "IDAAspilsPrecSolve", MSGS_BAD_T); return(-1); } } /* Call user's adjoint psolveB routine */ flag = idaspilsB_mem->s_psolveB(tt, yyTmp, ypTmp, yyB, ypB, rrB, rvecB, zvecB, c_jB, deltaB, IDAB_mem->ida_user_data, tmpB); return(flag); } static int IDAAspilsJacTimesVec(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDASpilsMemB idaspilsB_mem; IDABMem IDAB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; IDAB_mem = IDAADJ_mem->ia_bckpbCrt; idaspilsB_mem = (IDASpilsMemB)IDAB_mem->ida_lmem; /* Get FORWARD solution from interpolation. */ if (noInterp==FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDASSPILS", "IDAAspilsJacTimesVec", MSGS_BAD_T); return(-1); } } /* Call user's adjoint psolveB routine */ flag = idaspilsB_mem->s_jtimesB(tt, yyTmp, ypTmp, yyB, ypB, rrB, vB, JvB, c_jB, IDAB_mem->ida_user_data, tmp1B, tmp2B); return(flag); } sundials-2.5.0/src/idas/idas_sptfqmr.c0000600000175000017500000004242411741421242020565 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2007/11/26 16:20:01 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDAS scaled preconditioned * TFQMR linear solver module, IDASPTFQMR. * ----------------------------------------------------------------- */ #include #include #include #include "idas_spils_impl.h" #include "idas_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPTFQMR linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASptfqmrInit(IDAMem IDA_mem); static int IDASptfqmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask); static int IDASptfqmrFree(IDAMem IDA_mem); /* IDASPTFQMR lfree function for backward problem. */ static void IDASptfqmrFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : IDASptfqmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDASPTFQMR linear solver module. * * IDASptfqmr first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASptfqmrInit, IDASptfqmrSetup, * IDASptfqmrSolve, IDASptfqmrPerf, and IDASptfqmrFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then sets various fields * in the IDASpilsMemRec structure. Finally, IDASptfqmr allocates * memory for ytemp, yptemp, and xx, and calls SptfqmrMalloc to * allocate memory for the Sptfqmr solver. * * The return value of IDASptfqmr is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory * allocation failed * IDASPILS_ILL_INPUT = -2 if a required vector operation is not * implemented. * ----------------------------------------------------------------- */ int IDASptfqmr(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPTFQMR", "IDASptfqmr", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPTFQMR", "IDASptfqmr", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASptfqmrInit; lsetup = IDASptfqmrSetup; lsolve = IDASptfqmrSolve; lperf = IDASptfqmrPerf; lfree = IDASptfqmrFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPTFQMR; /* Set SPTFQMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Sptfqmr parameters */ idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ sptfqmr_mem = NULL; sptfqmr_mem = SptfqmrMalloc(maxl1, vec_tmpl); if (sptfqmr_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPTFQMR memory to spils memory structure */ spils_mem = (void *)sptfqmr_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPTFQMR interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define maxl (idaspils_mem->s_maxl) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASptfqmrInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; idaspils_mem = (IDASpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } /* Set maxl in the SPTFQMR memory in case it was changed by the user */ sptfqmr_mem->l_max = maxl; last_flag = IDASPILS_SUCCESS; return(0); } static int IDASptfqmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; if (retval < 0) { IDAProcessError(IDA_mem, SPTFQMR_PSET_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSetup", MSGS_PSET_FAILED); last_flag = SPTFQMR_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPTFQMR_PSET_FAIL_REC; return(+1); } last_flag = SPTFQMR_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : IDASptfqmrSolve * ----------------------------------------------------------------- * Note: The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SptfqmrSolve. * We copy the solution x into b, and update the counters nli, nps, * and ncfl. If SptfqmrSolve returned nli_inc = 0 (hence x = 0), we * take the SPTFQMR vtemp vector (= P_inverse F) as the correction * vector instead. Finally, we set the return value according to the * success of SptfqmrSolve. * ----------------------------------------------------------------- */ static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; sptfqmr_mem = (SptfqmrMem)spils_mem; /* Set SptfqmrSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the TFQMR convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SptfqmrSolve inputs pretype and initial guess xx = 0 */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SptfqmrSolve and copy xx to bb */ retval = SptfqmrSolve(sptfqmr_mem, IDA_mem, xx, bb, pretype, epslin, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); if (nli_inc == 0) N_VScale(ONE, SPTFQMR_VTEMP(sptfqmr_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful */ nli += nli_inc; nps += nps_inc; if (retval != SPTFQMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPTFQMR_SUCCESS: return(0); break; case SPTFQMR_RES_REDUCED: return(1); break; case SPTFQMR_CONV_FAIL: return(1); break; case SPTFQMR_PSOLVE_FAIL_REC: return(1); break; case SPTFQMR_ATIMES_FAIL_REC: return(1); break; case SPTFQMR_MEM_NULL: return(-1); break; case SPTFQMR_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPTFQMR_ATIMES_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPTFQMR_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : IDASptfqmrPerf * ----------------------------------------------------------------- * This routine handles performance monitoring specific to the * IDASPTFQMR linear solver. When perftask = 0, it saves values of * various counters. When perftask = 1, it examines difference * quotients in these counters, and depending on their values, it * prints up to three warning messages. Messages are printed up to * a maximum of 10 times. * ----------------------------------------------------------------- */ static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl)); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASptfqmrFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); sptfqmr_mem = (SptfqmrMem)spils_mem; SptfqmrFree(sptfqmr_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * IDASptfqmrB * * Wrapper for the backward phase * */ int IDASptfqmrB(void *ida_mem, int which, int maxlB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDASpilsMemB idaspilsB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPTFQMR", "IDASptfqmrB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASPTFQMR", "IDASptfqmrB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPTFQMR", "IDASptfqmrB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Get memory for IDASpilsMemRecB */ idaspilsB_mem = NULL; idaspilsB_mem = (IDASpilsMemB) malloc(sizeof(struct IDASpilsMemRecB)); if (idaspilsB_mem == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmrB", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } idaspilsB_mem->s_psetB = NULL; idaspilsB_mem->s_psolveB = NULL; idaspilsB_mem->s_P_dataB = NULL; /* initialize Jacobian function */ idaspilsB_mem->s_jtimesB = NULL; /* attach lmem and lfree */ IDAB_mem->ida_lmem = idaspilsB_mem; IDAB_mem->ida_lfree = IDASptfqmrFreeB; flag = IDASptfqmr(IDAB_mem->IDA_mem, maxlB); if (flag != IDASPILS_SUCCESS) { free(idaspilsB_mem); idaspilsB_mem = NULL; } return(flag); } /* * IDASptfqmrFreeB */ static void IDASptfqmrFreeB(IDABMem IDAB_mem) { IDASpilsMemB idaspilsB_mem; idaspilsB_mem = (IDASpilsMemB) IDAB_mem->ida_lmem; free(idaspilsB_mem); } sundials-2.5.0/src/idas/idas.c0000600000175000017500000061275511741421242017023 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.39 $ * $Date: 2012/03/06 21:58:55 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the main IDAS solver. * It is independent of the linear solver in use. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * Creation, allocation and re-initialization functions * IDACreate * IDAInit * IDAReInit * IDAQuadInit * IDAQuadReInit * IDAQuadSStolerances * IDAQuadSVtolerances * IDASensInit * IDASensReInit * IDASensToggleOff * IDASensSStolerances * IDASensSVtolerances * IDASensEEtolerances * IDAQuadSensInit * IDAQuadSensReInit * IDARootInit * * Main solver function * IDASolve * * Interpolated output and extraction functions * IDAGetDky * IDAGetQuad * IDAGetQuadDky * IDAGetSens * IDAGetSens1 * IDAGetSensDky * IDAGetSensDky1 * * Deallocation functions * IDAFree * IDAQuadFree * IDASensFree * IDAQuadSensFree * * PRIVATE FUNCTIONS * ----------------- * IDACheckNvector * Memory allocation/deallocation * IDAAllocVectors * IDAFreeVectors * IDAQuadAllocVectors * IDAQuadFreeVectors * IDASensAllocVectors * IDASensFreeVectors * IDAQuadSensAllocVectors * IDAQuadSensFreeVectors * Initial setup * IDAInitialSetup * IDAEwtSet * IDAEwtSetSS * IDAEwtSetSV * IDAQuadEwtSet * IDAQuadEwtSetSS * IDAQuadEwtSetSV * IDASensEwtSet * IDASensEwtSetEE * IDASensEwtSetSS * IDASensEwtSetSV * IDAQuadSensEwtSet * IDAQuadSensEwtSetEE * IDAQuadSensEwtSetSS * IDAQuadSensEwtSetSV * Stopping tests * IDAStopTest1 * IDAStopTest2 * Error handler * IDAHandleFailure * Main IDAStep function * IDAStep * IDASetCoeffs * Nonlinear solver functions * IDANls * IDAPredict * IDANewtonIter * IDAQuadNls * IDAQuadSensNls * IDAQuadPredict * IDAQuadSensPredict * IDASensNls * IDASensPredict * IDASensNewtonIter * Error test * IDATestError * IDAQuadTestError * IDASensTestError * IDAQuadSensTestError * IDARestore * Handler for convergence and/or error test failures * IDAHandleNFlag * IDAReset * Function called after a successful step * IDACompleteStep * Get solution * IDAGetSolution * Norm functions * IDAWrmsNorm * IDASensWrmsNorm * IDAQuadSensWrmsNorm * IDAQuadWrmsNormUpdate * IDASensWrmsNormUpdate * IDAQuadSensWrmsNormUpdate * Functions for rootfinding * IDARcheck1 * IDARcheck2 * IDARcheck3 * IDARootfind * IDA Error message handling functions * IDAProcessError * IDAErrHandler * Internal DQ approximations for sensitivity RHS * IDASensResDQ * IDASensRes1DQ * IDAQuadSensResDQ * IDAQuadSensRes1DQ * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include "idas_impl.h" #include #include /* * ================================================================= * MACRO DEFINITIONS * ================================================================= */ /* Macro: loop */ #define loop for(;;) /* * ================================================================= * IDAS PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define QUARTER RCONST(0.25) /* real 0.25 */ #define TWOTHIRDS RCONST(0.667) /* real 2/3 */ #define ONE RCONST(1.0) /* real 1.0 */ #define ONEPT5 RCONST(1.5) /* real 1.5 */ #define TWO RCONST(2.0) /* real 2.0 */ #define FOUR RCONST(4.0) /* real 4.0 */ #define FIVE RCONST(5.0) /* real 5.0 */ #define TEN RCONST(10.0) /* real 10.0 */ #define TWELVE RCONST(12.0) /* real 12.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define PT9 RCONST(0.9) /* real 0.9 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT01 RCONST(0.01) /* real 0.01 */ #define PT001 RCONST(0.001) /* real 0.001 */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ /* * ================================================================= * IDAS ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by IDASolve * ------------------------------------------------------------ */ /* IDAStep control constants */ #define PREDICT_AGAIN 20 /* Return values for lower level routines used by IDASolve */ #define IDA_RES_RECVR +1 #define IDA_LSETUP_RECVR +2 #define IDA_LSOLVE_RECVR +3 #define IDA_NCONV_RECVR +4 #define IDA_CONSTR_RECVR +5 #define IDA_QRHS_RECVR +10 #define IDA_SRES_RECVR +11 #define IDA_QSRHS_RECVR +12 #define CONTINUE_STEPS +99 /* IDACompleteStep constants */ #define UNSET -1 #define LOWER 1 #define RAISE 2 #define MAINTAIN 3 /* IDATestError constants */ #define ERROR_TEST_FAIL +7 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- */ #define RTFOUND 1 #define CLOSERT 3 /* * Control constants for sensitivity DQ * ------------------------------------ */ #define CENTERED1 +1 #define CENTERED2 +2 #define FORWARD1 +3 #define FORWARD2 +4 /* * Algorithmic constants * --------------------- */ #define MXNCF 10 /* max number of convergence failures allowed */ #define MXNEF 10 /* max number of error test failures allowed */ #define MAXNH 5 /* max. number of h tries in IC calc. */ #define MAXNJ 4 /* max. number of J tries in IC calc. */ #define MAXNI 10 /* max. Newton iterations in IC calc. */ #define EPCON RCONST(0.33) /* Newton convergence test constant */ /* IDANewtonIter constants */ #define MAXIT 4 #define RATEMAX RCONST(0.9) #define XRATE RCONST(0.25) /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype IDACheckNvector(N_Vector tmpl); /* Memory allocation/deallocation */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDAFreeVectors(IDAMem IDA_mem); static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDAQuadFreeVectors(IDAMem IDA_mem); static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDASensFreeVectors(IDAMem IDA_mem); static booleantype IDAQuadSensAllocVectors(IDAMem ida_mem, N_Vector tmpl); static void IDAQuadSensFreeVectors(IDAMem ida_mem); /* Initial setup */ int IDAInitialSetup(IDAMem IDA_mem); static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); /* Used in IC for sensitivities. */ int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); int IDAQuadSensEwtSet(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS); static int IDAQuadSensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDAQuadSensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDAQuadSensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); /* Main IDAStep function */ static int IDAStep(IDAMem IDA_mem); /* Function called at beginning of step */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); /* Nonlinear solver functions */ static void IDAPredict(IDAMem IDA_mem); static void IDAQuadPredict(IDAMem IDA_mem); static void IDASensPredict(IDAMem IDA_mem, int is, N_Vector yySens, N_Vector ypSens); static void IDAQuadSensPredict(IDAMem IDA_mem, N_Vector *yQS, N_Vector *ypQS); static int IDANls(IDAMem IDA_mem); static int IDANewtonIter(IDAMem IDA_mem); static int IDASensNls(IDAMem IDA_mem); static int IDASensNewtonIter(IDAMem IDA_mem); static int IDAQuadNls(IDAMem IDA_mem); static int IDAQuadSensNls(IDAMem IDA_mem); /* Error tests */ static int IDATestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDAQuadTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDASensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); /* Handling of convergence and/or error test failures */ static void IDARestore(IDAMem IDA_mem, realtype saved_t); static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr); static void IDAReset(IDAMem IDA_mem); /* Function called after a successful step */ static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1); /* Function called to evaluate the solutions y(t) and y'(t) at t. Also used in IDAA */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); /* Stopping tests and failure handling */ static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAHandleFailure(IDAMem IDA_mem, int sflag); /* Norm functions. Some of them are used also for IC, so they are global.*/ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask); realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask); static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ); static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS); static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS); /* Functions for rootfinding */ static int IDARcheck1(IDAMem IDA_mem); static int IDARcheck2(IDAMem IDA_mem); static int IDARcheck3(IDAMem IDA_mem); static int IDARootfind(IDAMem IDA_mem); /* Sensitivity residual DQ function */ static int IDASensRes1DQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, int iS, N_Vector yyS, N_Vector ypS, N_Vector resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp); static int IDAQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *resvalQS, void *ida_mem, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); static int IDAQuadSensRhs1InternalDQ(IDAMem IDA_mem, int is, realtype t, N_Vector yy, N_Vector y, N_Vector yyS, N_Vector ypS, N_Vector resvalQ, N_Vector resvalQS, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation, allocation and re-initialization functions * ----------------------------------------------------------------- */ /* * IDACreate * * IDACreate creates an internal memory block for a problem to * be solved by IDA. * If successful, IDACreate returns a pointer to the problem memory. * This pointer should be passed to IDAInit. * If an initialization error occurs, IDACreate prints an error * message to standard err and returns NULL. */ void *IDACreate(void) { IDAMem IDA_mem; IDA_mem = NULL; IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); if (IDA_mem == NULL) { IDAProcessError(NULL, 0, "IDAS", "IDACreate", MSG_MEM_FAIL); return (NULL); } /* Zero out ida_mem */ memset(IDA_mem, 0, sizeof(struct IDAMemRec)); /* Set unit roundoff in IDA_mem */ IDA_mem->ida_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ IDA_mem->ida_res = NULL; IDA_mem->ida_user_data = NULL; IDA_mem->ida_itol = IDA_NN; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = NULL; IDA_mem->ida_edata = NULL; IDA_mem->ida_ehfun = IDAErrHandler; IDA_mem->ida_eh_data = IDA_mem; IDA_mem->ida_errfp = stderr; IDA_mem->ida_maxord = MAXORD_DEFAULT; IDA_mem->ida_mxstep = MXSTEP_DEFAULT; IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; IDA_mem->ida_hin = ZERO; IDA_mem->ida_epcon = EPCON; IDA_mem->ida_maxnef = MXNEF; IDA_mem->ida_maxncf = MXNCF; IDA_mem->ida_maxcor = MAXIT; IDA_mem->ida_suppressalg = FALSE; IDA_mem->ida_id = NULL; IDA_mem->ida_constraints = NULL; IDA_mem->ida_constraintsSet = FALSE; IDA_mem->ida_tstopset = FALSE; /* set the saved value maxord_alloc */ IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT; /* Set default values for IC optional inputs */ IDA_mem->ida_epiccon = PT01 * EPCON; IDA_mem->ida_maxnh = MAXNH; IDA_mem->ida_maxnj = MAXNJ; IDA_mem->ida_maxnit = MAXNI; IDA_mem->ida_lsoff = FALSE; IDA_mem->ida_steptol = RPowerR(IDA_mem->ida_uround, TWOTHIRDS); /* Set default values for quad. optional inputs */ IDA_mem->ida_quadr = FALSE; IDA_mem->ida_rhsQ = NULL; IDA_mem->ida_errconQ = FALSE; IDA_mem->ida_itolQ = IDA_NN; /* Set default values for sensi. optional inputs */ IDA_mem->ida_sensi = FALSE; IDA_mem->ida_user_dataS = (void *)IDA_mem; IDA_mem->ida_resS = IDASensResDQ; IDA_mem->ida_resSDQ = TRUE; IDA_mem->ida_DQtype = IDA_CENTERED; IDA_mem->ida_DQrhomax = ZERO; IDA_mem->ida_p = NULL; IDA_mem->ida_pbar = NULL; IDA_mem->ida_plist = NULL; IDA_mem->ida_errconS = FALSE; IDA_mem->ida_maxcorS = MAXIT; IDA_mem->ida_itolS = IDA_EE; /* Defaults for sensi. quadr. optional inputs. */ IDA_mem->ida_quadr_sensi = FALSE; IDA_mem->ida_user_dataQS = (void *)IDA_mem; IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ; IDA_mem->ida_rhsQSDQ = TRUE; IDA_mem->ida_errconQS = FALSE; IDA_mem->ida_itolQS = IDA_EE; /* Set defaults for ASA. */ IDA_mem->ida_adj = FALSE; IDA_mem->ida_adj_mem = NULL; /* Initialize lrw and liw */ IDA_mem->ida_lrw = 25 + 5*MXORDP1; IDA_mem->ida_liw = 38; /* No mallocs have been done yet */ IDA_mem->ida_VatolMallocDone = FALSE; IDA_mem->ida_constraintsMallocDone = FALSE; IDA_mem->ida_idMallocDone = FALSE; IDA_mem->ida_MallocDone = FALSE; IDA_mem->ida_VatolQMallocDone = FALSE; IDA_mem->ida_quadMallocDone = FALSE; IDA_mem->ida_VatolSMallocDone = FALSE; IDA_mem->ida_SatolSMallocDone = FALSE; IDA_mem->ida_sensMallocDone = FALSE; IDA_mem->ida_VatolQSMallocDone = FALSE; IDA_mem->ida_SatolQSMallocDone = FALSE; IDA_mem->ida_quadSensMallocDone = FALSE; IDA_mem->ida_adjMallocDone = FALSE; /* Return pointer to IDA memory block */ return((void *)IDA_mem); } /*-----------------------------------------------------------------*/ #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) /*-----------------------------------------------------------------*/ /* * IDAInit * * IDAInit allocates and initializes memory for a problem. All * problem specification inputs are checked for errors. If any * error occurs during initialization, it is reported to the * error handler function. */ int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; booleantype nvectorOK, allocOK; long int lrw1, liw1; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } if (res == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_RES_NULL); return(IDA_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = IDACheckNvector(yy0); if (!nvectorOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (yy0->ops->nvspace != NULL) { N_VSpace(yy0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } IDA_mem->ida_lrw1 = lrw1; IDA_mem->ida_liw1 = liw1; /* Allocate the vectors (using yy0 as a template) */ allocOK = IDAAllocVectors(IDA_mem, yy0); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* All error checking is complete at this point */ /* Copy the input parameters into IDA memory block */ IDA_mem->ida_res = res; IDA_mem->ida_tn = t0; /* Set the linear solver addresses to NULL */ IDA_mem->ida_linit = NULL; IDA_mem->ida_lsetup = NULL; IDA_mem->ida_lsolve = NULL; IDA_mem->ida_lperf = NULL; IDA_mem->ida_lfree = NULL; IDA_mem->ida_lmem = NULL; /* Set forceSetup to FALSE */ IDA_mem->ida_forceSetup = FALSE; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initialize counters specific to IC calculation. */ IDA_mem->ida_nbacktr = 0; /* Initialize root-finding variables */ IDA_mem->ida_glo = NULL; IDA_mem->ida_ghi = NULL; IDA_mem->ida_grout = NULL; IDA_mem->ida_iroots = NULL; IDA_mem->ida_rootdir = NULL; IDA_mem->ida_gfun = NULL; IDA_mem->ida_nrtfn = 0; IDA_mem->ida_gactive = NULL; IDA_mem->ida_mxgnull = 1; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = FALSE; /* Problem memory has been successfully allocated */ IDA_mem->ida_MallocDone = TRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) /*-----------------------------------------------------------------*/ /* * IDAReInit * * IDAReInit re-initializes IDA's memory for a problem, assuming * it has already beeen allocated in a prior IDAInit call. * All problem specification inputs are checked for errors. * The problem size Neq is assumed to be unchaged since the call * to IDAInit, and the maximum order maxord must not be larger. * If any error occurs during reinitialization, it is reported to * the error handler function. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; /* Check for legal input parameters */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAReInit", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } /* Copy the input parameters into IDA memory block */ IDA_mem->ida_tn = t0; /* Set forceSetup to FALSE */ IDA_mem->ida_forceSetup = FALSE; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = FALSE; /* Problem has been successfully re-initialized */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASStolerances * IDASVtolerances * IDAWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to IDA. * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) * which will be called to set the error weight vector. */ int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASStolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (abstol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_rtol = reltol; IDA_mem->ida_Satol = abstol; IDA_mem->ida_itol = IDA_SS; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ return(IDA_SUCCESS); } int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASVtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(IDA_mem->ida_VatolMallocDone) ) { IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); lrw += lrw1; liw += liw1; IDA_mem->ida_VatolMallocDone = TRUE; } IDA_mem->ida_rtol = reltol; N_VScale(ONE, abstol, IDA_mem->ida_Vatol); IDA_mem->ida_itol = IDA_SV; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ return(IDA_SUCCESS); } int IDAWFtolerances(void *ida_mem, IDAEwtFn efun) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAWFtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAWFtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } IDA_mem->ida_itol = IDA_WF; IDA_mem->ida_user_efun = TRUE; IDA_mem->ida_efun = efun; IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDAQuadMalloc * * IDAQuadMalloc allocates and initializes quadrature related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAQuadInit(void *ida_mem, IDAQuadRhsFn rhsQ, N_Vector yQ0) { IDAMem IDA_mem; booleantype allocOK; long int lrw1Q, liw1Q; int i; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Set space requirements for one N_Vector */ N_VSpace(yQ0, &lrw1Q, &liw1Q); IDA_mem->ida_lrw1Q = lrw1Q; IDA_mem->ida_liw1Q = liw1Q; /* Allocate the vectors (using yQ0 as a template) */ allocOK = IDAQuadAllocVectors(IDA_mem, yQ0); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAQuadInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Initialize phiQ in the history array */ N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]); for(i=1; i<=IDA_mem->ida_maxord; i++) N_VConst(ZERO, IDA_mem->ida_phiQ[i]); /* Copy the input parameters into IDAS state */ IDA_mem->ida_rhsQ = rhsQ; /* Initialize counters */ IDA_mem->ida_nrQe = 0; IDA_mem->ida_netfQ = 0; /* Quadrature integration turned ON */ IDA_mem->ida_quadr = TRUE; IDA_mem->ida_quadMallocDone = TRUE; /* Quadrature initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1Q (IDA_mem->ida_lrw1Q) #define liw1Q (IDA_mem->ida_liw1Q) /*-----------------------------------------------------------------*/ /* * IDAQuadReInit * * IDAQuadReInit re-initializes IDAS's quadrature related memory * for a problem, assuming it has already been allocated in prior * calls to IDAInit and IDAQuadMalloc. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAQuadReInit(void *ida_mem, N_Vector yQ0) { IDAMem IDA_mem; int i; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadReInit", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Initialize phiQ in the history array */ N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]); for(i=1; i<=IDA_mem->ida_maxord; i++) N_VConst(ZERO, IDA_mem->ida_phiQ[i]); /* Initialize counters */ IDA_mem->ida_nrQe = 0; IDA_mem->ida_netfQ = 0; /* Quadrature integration turned ON */ IDA_mem->ida_quadr = TRUE; /* Quadrature re-initialization was successfull */ return(IDA_SUCCESS); } /* * IDAQuadSStolerances * IDAQuadSVtolerances * * * These functions specify the integration tolerances for quadrature * variables. One of them MUST be called before the first call to * IDA IF error control on the quadrature variables is enabled * (see IDASetQuadErrCon). * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). */ int IDAQuadSStolerances(void *ida_mem, realtype reltolQ, realtype abstolQ) { IDAMem IDA_mem; /*Check ida mem*/ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSStolerances", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_RTOLQ); return(IDA_ILL_INPUT); } if (abstolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_ATOLQ); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_itolQ = IDA_SS; IDA_mem->ida_rtolQ = reltolQ; IDA_mem->ida_SatolQ = abstolQ; return (IDA_SUCCESS); } int IDAQuadSVtolerances(void *ida_mem, realtype reltolQ, N_Vector abstolQ) { IDAMem IDA_mem; /*Check ida mem*/ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSVtolerances", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_BAD_RTOLQ); return(IDA_ILL_INPUT); } if (abstolQ == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_NULL_ATOLQ); return(IDA_ILL_INPUT); } if (N_VMin(abstolQ)ida_itolQ = IDA_SV; IDA_mem->ida_rtolQ = reltolQ; /* clone the absolute tolerances vector (if necessary) */ if (FALSE == IDA_mem->ida_VatolQMallocDone) { IDA_mem->ida_VatolQ = N_VClone(abstolQ); lrw += lrw1Q; liw += liw1Q; IDA_mem->ida_VatolQMallocDone = TRUE; } N_VScale(ONE, abstolQ, IDA_mem->ida_VatolQ); return(IDA_SUCCESS); } /* * IDASenMalloc * * IDASensInit allocates and initializes sensitivity related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDASensInit(void *ida_mem, int Ns, int ism, IDASensResFn fS, N_Vector *yS0, N_Vector *ypS0) { IDAMem IDA_mem; booleantype allocOK; int is; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if Ns is legal */ if (Ns<=0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_NS); return(IDA_ILL_INPUT); } IDA_mem->ida_Ns = Ns; /* Check if ism is legal */ if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_ISM); return(IDA_ILL_INPUT); } IDA_mem->ida_ism = ism; /* Check if yS0 and ypS0 are non-null */ if (yS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YYS0); return(IDA_ILL_INPUT); } if (ypS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YPS0); return(IDA_ILL_INPUT); } /* Store sensitivity RHS-related data */ if (fS != NULL) { IDA_mem->ida_resS = fS; IDA_mem->ida_user_dataS = IDA_mem->ida_user_data; IDA_mem->ida_resSDQ = FALSE; } else { IDA_mem->ida_resS = IDASensResDQ; IDA_mem->ida_user_dataS = ida_mem; IDA_mem->ida_resSDQ = TRUE; } /* Allocate the vectors (using yS0[0] as a template) */ allocOK = IDASensAllocVectors(IDA_mem, yS0[0]); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize the phiS array */ for (is=0; isida_phiS[0][is]); N_VScale(ONE, ypS0[is], IDA_mem->ida_phiS[1][is]); } /* Initialize all sensitivity related counters */ IDA_mem->ida_nrSe = 0; IDA_mem->ida_nreS = 0; IDA_mem->ida_ncfnS = 0; IDA_mem->ida_netfS = 0; IDA_mem->ida_nniS = 0; IDA_mem->ida_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; isida_plist[is] = is; IDA_mem->ida_pbar[is] = ONE; } /* Sensitivities will be computed */ IDA_mem->ida_sensi = TRUE; IDA_mem->ida_sensMallocDone = TRUE; /* Sensitivity initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define Ns (IDA_mem->ida_Ns) /*-----------------------------------------------------------------*/ /* * IDASensReInit * * IDASensReInit re-initializes IDAS's sensitivity related memory * for a problem, assuming it has already been allocated in prior * calls to IDAInit and IDASensInit. * All problem specification inputs are checked for errors. * The number of sensitivities Ns is assumed to be unchanged since * the previous call to IDASensInit. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDASensReInit(void *ida_mem, int ism, N_Vector *yS0, N_Vector *ypS0) { IDAMem IDA_mem; int is; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensReInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Check if ism is legal */ if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_BAD_ISM); return(IDA_ILL_INPUT); } IDA_mem->ida_ism = ism; /* Check if yS0 and ypS0 are non-null */ if (yS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_NULL_YYS0); return(IDA_ILL_INPUT); } if (ypS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_NULL_YPS0); return(IDA_ILL_INPUT); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize the phiS array */ for (is=0; isida_phiS[0][is]); N_VScale(ONE, ypS0[is], IDA_mem->ida_phiS[1][is]); } /* Initialize all sensitivity related counters */ IDA_mem->ida_nrSe = 0; IDA_mem->ida_nreS = 0; IDA_mem->ida_ncfnS = 0; IDA_mem->ida_netfS = 0; IDA_mem->ida_nniS = 0; IDA_mem->ida_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; isida_plist[is] = is; IDA_mem->ida_pbar[is] = ONE; } /* Sensitivities will be computed */ IDA_mem->ida_sensi = TRUE; /* Sensitivity re-initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASensSStolerances * IDASensSVtolerances * IDASensEEtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to IDASolve. * * IDASensSStolerances specifies scalar relative and absolute tolerances. * IDASensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * IDASensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. */ int IDASensSStolerances(void *ida_mem, realtype reltolS, realtype *abstolS) { IDAMem IDA_mem; int is; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSStolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_RTOLS); return(IDA_ILL_INPUT); } if (abstolS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_NULL_ATOLS); return(IDA_ILL_INPUT); } for (is=0; isida_itolS = IDA_SS; IDA_mem->ida_rtolS = reltolS; if ( !(IDA_mem->ida_SatolSMallocDone) ) { IDA_mem->ida_SatolS = NULL; IDA_mem->ida_SatolS = (realtype *)malloc(Ns*sizeof(realtype)); lrw += Ns; IDA_mem->ida_SatolSMallocDone = TRUE; } for (is=0; isida_SatolS[is] = abstolS[is]; return(IDA_SUCCESS); } int IDASensSVtolerances(void *ida_mem, realtype reltolS, N_Vector *abstolS) { IDAMem IDA_mem; int is; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSVtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_BAD_RTOLS); return(IDA_ILL_INPUT); } if (abstolS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_NULL_ATOLS); return(IDA_ILL_INPUT); } for (is=0; isida_itolS = IDA_SV; IDA_mem->ida_rtolS = reltolS ; if ( FALSE == IDA_mem->ida_VatolSMallocDone ) { IDA_mem->ida_VatolS = N_VCloneVectorArray(Ns, IDA_mem->ida_tempv1); lrw += Ns*lrw1; liw += Ns*liw1; IDA_mem->ida_VatolSMallocDone = TRUE; } for (is=0; isida_VatolS[is]); return(IDA_SUCCESS); } int IDASensEEtolerances(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensEEtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensEEtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } IDA_mem->ida_itolS = IDA_EE; return(IDA_SUCCESS); } int IDAQuadSensInit(void *ida_mem, IDAQuadSensRhsFn rhsQS, N_Vector *yQS0) { IDAMem IDA_mem; booleantype allocOK; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(NULL, IDA_NO_SENS, "IDAS", "IDAQuadSensInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Verifiy yQS0 parameter. */ if (yQS0==NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensInit", MSG_NULL_YQS0); return(IDA_ILL_INPUT); } /* Allocate vector needed for quadratures' sensitivities. */ allocOK = IDAQuadSensAllocVectors(IDA_mem, yQS0[0]); if (!allocOK) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAQuadSensInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Error checking complete. */ if (rhsQS == NULL) { IDA_mem->ida_rhsQSDQ = TRUE; IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ; IDA_mem->ida_user_dataQS = ida_mem; } else { IDA_mem->ida_rhsQSDQ = FALSE; IDA_mem->ida_rhsQS = rhsQS; IDA_mem->ida_user_dataQS = IDA_mem->ida_user_data; } /* Initialize phiQS[0] in the history array */ for (is=0; isida_phiQS[0][is]); /* Initialize all sensitivities related counters. */ IDA_mem->ida_nrQSe = 0; IDA_mem->ida_nrQeS = 0; IDA_mem->ida_netfQS = 0; /* Everything allright, set the flags and return with success. */ IDA_mem->ida_quadr_sensi = TRUE; IDA_mem->ida_quadSensMallocDone = TRUE; return(IDA_SUCCESS); } int IDAQuadSensReInit(void *ida_mem, N_Vector *yQS0) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensReInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensReInit", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Verifiy yQS0 parameter. */ if (yQS0==NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensReInit", MSG_NULL_YQS0); return(IDA_ILL_INPUT); } /* Error checking complete at this point. */ /* Initialize phiQS[0] in the history array */ for (is=0; isida_phiQS[0][is]); /* Initialize all sensitivities related counters. */ IDA_mem->ida_nrQSe = 0; IDA_mem->ida_nrQeS = 0; IDA_mem->ida_netfQS = 0; /* Everything allright, set the flags and return with success. */ IDA_mem->ida_quadr_sensi = TRUE; return(IDA_SUCCESS); } /* * IDAQuadSensSStolerances * IDAQuadSensSVtolerances * IDAQuadSensEEtolerances * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to IDAS IF these variables are included in the error test. * * IDAQuadSensSStolerances specifies scalar relative and absolute tolerances. * IDAQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * IDAQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of IDAQuad**tolerances. */ int IDAQuadSensSStolerances(void *ida_mem, realtype reltolQS, realtype *abstolQS) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_BAD_RELTOLQS); return(IDA_ILL_INPUT); } if (abstolQS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_NULL_ABSTOLQS); return(IDA_ILL_INPUT); } for (is=0; isida_itolQS = IDA_SS; IDA_mem->ida_rtolQS = reltolQS; if ( !(IDA_mem->ida_SatolQSMallocDone) ) { IDA_mem->ida_SatolQS = (realtype *)malloc(Ns*sizeof(realtype)); lrw += Ns; IDA_mem->ida_SatolQSMallocDone = TRUE; } for (is=0; isida_SatolQS[is] = abstolQS[is]; return(IDA_SUCCESS); } int IDAQuadSensSVtolerances(void *ida_mem, realtype reltolQS, N_Vector *abstolQS) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_BAD_RELTOLQS); return(IDA_ILL_INPUT); } if (abstolQS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_NULL_ABSTOLQS); return(IDA_ILL_INPUT); } for (is=0; isida_itolQS = IDA_SV; IDA_mem->ida_rtolQS = reltolQS; if ( !(IDA_mem->ida_VatolQSMallocDone) ) { IDA_mem->ida_VatolQS = N_VCloneVectorArray(Ns, abstolQS[0]); lrw += Ns*lrw1Q; liw += Ns*liw1Q; IDA_mem->ida_VatolQSMallocDone = TRUE; } for (is=0; isida_VatolQS[is]); return(IDA_SUCCESS); } int IDAQuadSensEEtolerances(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } IDA_mem->ida_itolQS = IDA_EE; return(IDA_SUCCESS); } /* * IDASensToggleOff * * IDASensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory. */ int IDASensToggleOff(void *ida_mem) { IDAMem IDA_mem; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensToggleOff", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Disable sensitivities */ IDA_mem->ida_sensi = FALSE; IDA_mem->ida_quadr_sensi = FALSE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define gfun (IDA_mem->ida_gfun) #define glo (IDA_mem->ida_glo) #define ghi (IDA_mem->ida_ghi) #define grout (IDA_mem->ida_grout) #define iroots (IDA_mem->ida_iroots) #define rootdir (IDA_mem->ida_rootdir) #define gactive (IDA_mem->ida_gactive) /*-----------------------------------------------------------------*/ /* * IDARootInit * * IDARootInit initializes a rootfinding problem to be solved * during the integration of the DAE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is IDA_SUCCESS = 0 if no * errors occurred, or a negative value otherwise. */ int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g) { IDAMem IDA_mem; int i, nrt; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDARootInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning IDARootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); iroots = NULL; free(gactive); gactive = NULL; lrw -= 3 * (IDA_mem->ida_nrtfn); liw -= 3 * (IDA_mem->ida_nrtfn); } /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to zero and ida_gfun to NULL before returning */ if (nrt == 0) { IDA_mem->ida_nrtfn = nrt; gfun = NULL; return(IDA_SUCCESS); } /* If rerunning IDARootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == IDA_mem->ida_nrtfn) { if (g != gfun) { if (g == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); iroots = NULL; free(gactive); gactive = NULL; lrw -= 3*nrt; liw -= 3*nrt; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else { gfun = g; return(IDA_SUCCESS); } } else return(IDA_SUCCESS); } /* Set variable values in IDA memory block */ IDA_mem->ida_nrtfn = nrt; if (g == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else gfun = g; /* Allocate necessary memory and return */ glo = NULL; glo = (realtype *) malloc(nrt*sizeof(realtype)); if (glo == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } ghi = NULL; ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (ghi == NULL) { free(glo); glo = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } grout = NULL; grout = (realtype *) malloc(nrt*sizeof(realtype)); if (grout == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } iroots = NULL; iroots = (int *) malloc(nrt*sizeof(int)); if (iroots == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } rootdir = NULL; rootdir = (int *) malloc(nrt*sizeof(int)); if (rootdir == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } gactive = NULL; gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (gactive == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; iida_res) #define user_data (IDA_mem->ida_user_data) #define y0 (IDA_mem->ida_y0) #define yp0 (IDA_mem->ida_yp0) #define itol (IDA_mem->ida_itol) #define rtol (IDA_mem->ida_rtol) #define Satol (IDA_mem->ida_Satol) #define Vatol (IDA_mem->ida_Vatol) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define maxord (IDA_mem->ida_maxord) #define mxstep (IDA_mem->ida_mxstep) #define hin (IDA_mem->ida_hin) #define hmax_inv (IDA_mem->ida_hmax_inv) #define tstop (IDA_mem->ida_tstop) #define tstopset (IDA_mem->ida_tstopset) #define epcon (IDA_mem->ida_epcon) #define maxnef (IDA_mem->ida_maxnef) #define maxncf (IDA_mem->ida_maxncf) #define maxcor (IDA_mem->ida_maxcor) #define suppressalg (IDA_mem->ida_suppressalg) #define id (IDA_mem->ida_id) #define constraints (IDA_mem->ida_constraints) #define epiccon (IDA_mem->ida_epiccon) #define maxnh (IDA_mem->ida_maxnh) #define maxnj (IDA_mem->ida_maxnj) #define maxnit (IDA_mem->ida_maxnit) #define lsoff (IDA_mem->ida_lsoff) #define steptol (IDA_mem->ida_steptol) #define uround (IDA_mem->ida_uround) #define phi (IDA_mem->ida_phi) #define ewt (IDA_mem->ida_ewt) #define yy (IDA_mem->ida_yy) #define yp (IDA_mem->ida_yp) #define delta (IDA_mem->ida_delta) #define mm (IDA_mem->ida_mm) #define ee (IDA_mem->ida_ee) #define savres (IDA_mem->ida_savres) #define tempv1 (IDA_mem->ida_tempv1) #define tempv2 (IDA_mem->ida_tempv2) #define kk (IDA_mem->ida_kk) #define hh (IDA_mem->ida_hh) #define h0u (IDA_mem->ida_h0u) #define tn (IDA_mem->ida_tn) #define tretlast (IDA_mem->ida_tretlast) #define cj (IDA_mem->ida_cj) #define cjold (IDA_mem->ida_cjold) #define cjratio (IDA_mem->ida_cjratio) #define cjlast (IDA_mem->ida_cjlast) #define nbacktr (IDA_mem->ida_nbacktr) #define nst (IDA_mem->ida_nst) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define netf (IDA_mem->ida_netf) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define ns (IDA_mem->ida_ns) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define setupNonNull (IDA_mem->ida_setupNonNull) #define forceSetup (IDA_mem->ida_forceSetup) #define knew (IDA_mem->ida_knew) #define kused (IDA_mem->ida_kused) #define hused (IDA_mem->ida_hused) #define tolsf (IDA_mem->ida_tolsf) #define phase (IDA_mem->ida_phase) #define epsNewt (IDA_mem->ida_epsNewt) #define toldel (IDA_mem->ida_toldel) #define ss (IDA_mem->ida_ss) #define rr (IDA_mem->ida_rr) #define psi (IDA_mem->ida_psi) #define alpha (IDA_mem->ida_alpha) #define beta (IDA_mem->ida_beta) #define sigma (IDA_mem->ida_sigma) #define gamma (IDA_mem->ida_gamma) #define constraintsSet (IDA_mem->ida_constraintsSet) #define nrtfn (IDA_mem->ida_nrtfn) #define tlo (IDA_mem->ida_tlo) #define thi (IDA_mem->ida_thi) #define toutc (IDA_mem->ida_toutc) #define trout (IDA_mem->ida_trout) #define ttol (IDA_mem->ida_ttol) #define taskc (IDA_mem->ida_taskc) #define irfnd (IDA_mem->ida_irfnd) #define nge (IDA_mem->ida_nge) /* Quadrature variables */ #define quadr (IDA_mem->ida_quadr) #define rhsQ (IDA_mem->ida_rhsQ) #define errconQ (IDA_mem->ida_errconQ) #define itolQ (IDA_mem->ida_itolQ) #define rtolQ (IDA_mem->ida_rtolQ) #define SatolQ (IDA_mem->ida_SatolQ) #define VatolQ (IDA_mem->ida_VatolQ) #define phiQ (IDA_mem->ida_phiQ) #define yyQ (IDA_mem->ida_yyQ) #define ypQ (IDA_mem->ida_ypQ) #define ewtQ (IDA_mem->ida_ewtQ) #define eeQ (IDA_mem->ida_eeQ) #define nrQe (IDA_mem->ida_nrQe) #define netfQ (IDA_mem->ida_netfQ) #define ncfnQ (IDA_mem->ida_ncfnQ) #define lrw1Q (IDA_mem->ida_lrw1Q) #define liw1Q (IDA_mem->ida_liw1Q) #define quadMallocDone (IDA_mem->ida_quadMallocDone) /* Sensitivity variables */ #define sensi (IDA_mem->ida_sensi) #define ism (IDA_mem->ida_ism) #define resS (IDA_mem->ida_resS) #define user_dataS (IDA_mem->ida_user_dataS) #define resSDQ (IDA_mem->ida_resSDQ) #define errconS (IDA_mem->ida_errconS) #define itolS (IDA_mem->ida_itolS) #define rtolS (IDA_mem->ida_rtolS) #define SatolS (IDA_mem->ida_SatolS) #define VatolS (IDA_mem->ida_VatolS) #define sensMallocDone (IDA_mem->ida_sensMallocDone) /* Sensitivities for quadratures */ #define quadr_sensi (IDA_mem->ida_quadr_sensi) #define yyQS (IDA_mem->ida_yyQS) #define phiQS (IDA_mem->ida_phiQS) #define tempvQS (IDA_mem->ida_tempvQS) #define errconQS (IDA_mem->ida_errconQS) #define ewtQS (IDA_mem->ida_ewtQS) #define itolQS (IDA_mem->ida_itolQS) #define rtolQS (IDA_mem->ida_rtolQS) #define SatolQS (IDA_mem->ida_SatolQS) #define VatolQS (IDA_mem->ida_VatolQS) #define eeQS (IDA_mem->ida_eeQS) #define nrQeS (IDA_mem->ida_nrQeS) #define nrQSe (IDA_mem->ida_nrQSe) #define netfQS (IDA_mem->ida_netfQS) #define quadSensMallocDone (IDA_mem->ida_quadSensMallocDone) #define user_dataQS (IDA_mem->ida_user_dataQS) #define rhsQS (IDA_mem->ida_rhsQS) #define rhsQSDQ (IDA_mem->ida_rhsQSDQ) #define savrhsQ (IDA_mem->ida_savrhsQ) #define DQtype (IDA_mem->ida_DQtype) #define DQrhomax (IDA_mem->ida_DQrhomax) #define pbar (IDA_mem->ida_pbar) #define p (IDA_mem->ida_p) #define plist (IDA_mem->ida_plist) #define maxcorS (IDA_mem->ida_maxcorS) #define Ns (IDA_mem->ida_Ns) #define phiS (IDA_mem->ida_phiS) #define ewtS (IDA_mem->ida_ewtS) #define yyS (IDA_mem->ida_yyS) #define ypS (IDA_mem->ida_ypS) #define deltaS (IDA_mem->ida_deltaS) #define eeS (IDA_mem->ida_eeS) #define tmpS1 (IDA_mem->ida_tmpS1) #define tmpS2 (IDA_mem->ida_tmpS2) #define tmpS3 (IDA_mem->ida_tmpS3) #define ssS (IDA_mem->ida_ssS) #define nrSe (IDA_mem->ida_nrSe) #define nreS (IDA_mem->ida_nreS) #define nniS (IDA_mem->ida_nniS) #define ncfnS (IDA_mem->ida_ncfnS) #define netfS (IDA_mem->ida_netfS) #define nsetupsS (IDA_mem->ida_nsetupsS) /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * IDASolve * * This routine is the main driver of the IDA package. * * It integrates over an independent variable interval defined by the user, * by calling IDAStep to take internal independent variable steps. * * The first time that IDASolve is called for a successfully initialized * problem, it computes a tentative initial step size. * * IDASolve supports two modes, specified by itask: * In the IDA_NORMAL mode, the solver steps until it passes tout and then * interpolates to obtain y(tout) and yp(tout). * In the IDA_ONE_STEP mode, it takes one internal step and returns. * * IDASolve returns integer values corresponding to success and failure as below: * * successful returns: * * IDA_SUCCESS * IDA_TSTOP_RETURN * * failed returns: * * IDA_ILL_INPUT * IDA_TOO_MUCH_WORK * IDA_MEM_NULL * IDA_TOO_MUCH_ACC * IDA_CONV_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL * IDA_CONSTR_FAIL * IDA_ERR_FAIL * IDA_REP_RES_ERR * IDA_RES_FAIL */ int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { long int nstloc; int sflag, istate, ier, irfndp, is, ir; realtype tdist, troundoff, ypnorm, rh, nrm; IDAMem IDA_mem; booleantype inactive_roots; /* Check for legal inputs in all cases. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASolve", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASolve", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal arguments */ if (yret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YRET_NULL); return(IDA_ILL_INPUT); } yy = yret; if (ypret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YPRET_NULL); return(IDA_ILL_INPUT); } yp = ypret; if (tret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TRET_NULL); return(IDA_ILL_INPUT); } if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } if (itask == IDA_NORMAL) toutc = tout; taskc = itask; /* Sensitivity-specific tests (if using internal DQ functions) */ if (sensi && resSDQ) { /* Make sure we have the right 'user data' */ user_dataS = ida_mem; /* Test if we have the problem parameters */ if(p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (quadr_sensi && rhsQSDQ) { user_dataQS = ida_mem; /* Test if we have the problem parameters */ if(p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (nst == 0) { /* This is the first call */ /* Check inputs to IDA for correctness and consistency */ if (IDA_mem->ida_SetupDone == FALSE) { ier = IDAInitialSetup(IDA_mem); if (ier != IDA_SUCCESS) return(ier); IDA_mem->ida_SetupDone = TRUE; } /* On first call, check for tout - tn too small, set initial hh, check for approach to tstop, and scale phi[1], phiQ[1], and phiS[1] by hh. Also check for zeros of root function g at and near t0. */ tdist = ABS(tout - tn); if (tdist == ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } troundoff = TWO*uround*(ABS(tn) + ABS(tout)); if (tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } hh = hin; if ( (hh != ZERO) && ((tout-tn)*hh < ZERO) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_HINIT); return(IDA_ILL_INPUT); } if (hh == ZERO) { hh = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, phi[1], ewt, suppressalg); if (errconQ) ypnorm = IDAQuadWrmsNormUpdate(IDA_mem, ypnorm, phiQ[1], ewtQ); if (errconS) ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, phiS[1], ewtS, suppressalg); if (errconQS) ypnorm = IDAQuadSensWrmsNormUpdate(IDA_mem, ypnorm, phiQS[1], ewtQS); if (ypnorm > HALF/hh) hh = HALF/ypnorm; if (tout < tn) hh = -hh; } rh = ABS(hh)*hmax_inv; if (rh > ONE) hh /= rh; if (tstopset) { if ( (tstop - tn)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } if ( (tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } h0u = hh; kk = 0; kused = 0; /* set in case of an error return before a step */ /* Check for exact zeros of the root functions at or near t0. */ if (nrtfn > 0) { ier = IDARcheck1(IDA_mem); if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck1", MSG_RTFUNC_FAILED, tn); return(IDA_RTFUNC_FAIL); } } N_VScale(hh, phi[1], phi[1]); /* set phi[1] = hh*y' */ if (quadr) N_VScale(hh, phiQ[1], phiQ[1]); /* set phiQ[1] = hh*yQ' */ if (sensi) for (is=0; is 0) { /* First, check for a root in the last step taken, other than the last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (nrtfn > 0) { irfndp = irfnd; ier = IDARcheck2(IDA_mem); if (ier == CLOSERT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARcheck2", MSG_CLOSE_ROOTS, tlo); return(IDA_ILL_INPUT); } else if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck2", MSG_RTFUNC_FAILED, tlo); return(IDA_RTFUNC_FAIL); } else if (ier == RTFOUND) { tretlast = *tret = tlo; return(IDA_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if ( ABS(tn - tretlast) > troundoff ) { ier = IDARcheck3(IDA_mem); if (ier == IDA_SUCCESS) { /* no root found */ irfnd = 0; if ((irfndp == 1) && (itask == IDA_ONE_STEP)) { tretlast = *tret = tn; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); return(IDA_SUCCESS); } } else if (ier == RTFOUND) { /* a new root was found */ irfnd = 1; tretlast = *tret = tlo; return(IDA_ROOT_RETURN); } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); return(IDA_RTFUNC_FAIL); } } } /* end of root stop check */ /* Now test for all other stop conditions. */ istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) return(istate); } /* Looping point for internal steps. */ loop { /* Check for too many steps taken. */ if ( (mxstep>0) && (nstloc >= mxstep) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_MAX_STEPS, tn); istate = IDA_TOO_MUCH_WORK; *tret = tretlast = tn; break; /* Here yy=yret and yp=ypret already have the current solution. */ } /* Call lperf to generate warnings of poor performance. */ if (lperf != NULL) lperf(IDA_mem, 1); /* Reset and check ewt, ewtQ, ewtS and ewtQS (if not first call). */ if (nst > 0) { ier = efun(phi[0], ewt, edata); if (ier != 0) { if (itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWT_NOW_FAIL, tn); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWT_NOW_BAD, tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; break; } if (quadr && errconQ) { ier = IDAQuadEwtSet(IDA_mem, phiQ[0], ewtQ); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTQ_NOW_BAD, tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; break; } } if (sensi) { ier = IDASensEwtSet(IDA_mem, phiS[0], ewtS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTS_NOW_BAD, tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; break; } } if (quadr_sensi && errconQS) { ier = IDAQuadSensEwtSet(IDA_mem, phiQS[0], ewtQS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTQS_NOW_BAD, tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); tretlast = *tret = tn; break; } } } /* Check for too much accuracy requested. */ nrm = IDAWrmsNorm(IDA_mem, phi[0], ewt, suppressalg); if (errconQ) nrm = IDAQuadWrmsNormUpdate(IDA_mem, nrm, phiQ[0], ewtQ); if (errconS) nrm = IDASensWrmsNormUpdate(IDA_mem, nrm, phiS[0], ewtS, suppressalg); if (errconQS) nrm = IDAQuadSensWrmsNormUpdate(IDA_mem, nrm, phiQS[0], ewtQS); tolsf = uround * nrm; if (tolsf > ONE) { tolsf *= TEN; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_MUCH_ACC, tn); istate = IDA_TOO_MUCH_ACC; *tret = tretlast = tn; if (nst > 0) ier = IDAGetSolution(IDA_mem, tn, yret, ypret); break; } /* Call IDAStep to take a step. */ sflag = IDAStep(IDA_mem); /* Process all failed-step cases, and exit loop. */ if (sflag != IDA_SUCCESS) { istate = IDAHandleFailure(IDA_mem, sflag); *tret = tretlast = tn; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); break; } nstloc++; /* If tstop is set and was reached, reset tn = tstop */ if (tstopset) { troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) tn = tstop; } /* After successful step, check for stop conditions; continue or break. */ /* First check for root in the last step taken. */ if (nrtfn > 0) { ier = IDARcheck3(IDA_mem); if (ier == RTFOUND) { /* A new root was found */ irfnd = 1; istate = IDA_ROOT_RETURN; tretlast = *tret = tlo; break; } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); istate = IDA_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (nst==1) { inactive_roots = FALSE; for (ir=0; irida_mxgnull > 0) && inactive_roots) { IDAProcessError(IDA_mem, IDA_WARNING, "IDAS", "IDASolve", MSG_INACTIVE_ROOTS); } } } /* Now check all other stop conditions. */ istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) break; } /* End of step loop */ return(istate); } /* * ----------------------------------------------------------------- * Interpolated output and extraction functions * ----------------------------------------------------------------- */ /* * IDAGetDky * * This routine evaluates the k-th derivative of y(t) as the value of * the k-th derivative of the interpolating polynomial at the independent * variable t, and stores the results in the vector dky. It uses the current * independent variable value, tn, and the method order last used, kused. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. * IDA_BAD_DKY if the dky vector is NULL. * IDA_BAD_K if the requested k is not in the range 0,1,...,order used * */ int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (dky == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetDky", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetDky", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; i0, the following conventions were adopted: - c_0(t) = 1 , c_0^(-1)(t)=0 - psij_1 stands for psi[-1]=0 when j=1 for psi[j-2] when j>1 */ if(i==0) { cjk[i] = 1; psij_1 = 0; }else { /* i i-1 1 c_i^(i) can be always updated since c_i^(i) = ----- -------- ... ----- psi_j psi_{j-1} psi_1 */ cjk[i] = cjk[i-1]*i/psi[i-1]; psij_1 = psi[i-1]; } /* update c_j^(i) */ /*j does not need to go till kused */ for(j=i+1; j<=kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / psi[j-1]; psij_1 = psi[j-1]; } /* save existing c_j^(i)'s */ for(j=i+1; j<=kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ N_VConst(ZERO, dky); for(j=k; j<=kused; j++) { N_VLinearSum(ONE, dky, cjk[j], phi[j], dky); } return(IDA_SUCCESS); } /* * IDAGetQuad * * The following function can be called to obtain the quadrature * variables after a successful integration step. * * This is just a wrapper that calls IDAGetQuadDky with k=0. */ int IDAGetQuad(void *ida_mem, realtype *ptret, N_Vector yQout) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuad", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; *ptret = tretlast; return IDAGetQuadDky(ida_mem, tretlast, 0, yQout); } /* * IDAGetQuadDky * * Returns the quadrature variables (or their * derivatives up to the current method order) at any time within * the last integration step (dense output). */ int IDAGetQuadDky(void *ida_mem, realtype t, int k, N_Vector dkyQ) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (quadr != TRUE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadDky", MSG_NO_QUAD); return(IDA_NO_QUAD); } if (dkyQ == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadDky", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (tn + hh); tp = tn - hused - tfuzz; if ( (t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadDky", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; i kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky", MSG_BAD_K); return(IDA_BAD_K); } for (is=0; is= Ns) { IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetSensDky1", MSG_BAD_IS); } /* Is the requested order valid? */ if ((k < 0) || (k > kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky1", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSensDky1", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; i kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky", MSG_BAD_K); return(IDA_BAD_K); } for (is=0; is= Ns) { IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_IS); } /* Is the requested order valid? */ if ((k < 0) || (k > kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; i 0) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; } free(*ida_mem); *ida_mem = NULL; } /* * IDAQuadFree * * IDAQuadFree frees the problem memory in ida_mem allocated * for quadrature integration. Its only argument is the pointer * ida_mem returned by IDACreate. */ void IDAQuadFree(void *ida_mem) { IDAMem IDA_mem; if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(quadMallocDone) { IDAQuadFreeVectors(IDA_mem); quadMallocDone = FALSE; quadr = FALSE; } } /* * IDASensFree * * IDASensFree frees the problem memory in ida_mem allocated * for sensitivity analysis. Its only argument is the pointer * ida_mem returned by IDACreate. */ void IDASensFree(void *ida_mem) { IDAMem IDA_mem; if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(sensMallocDone) { IDASensFreeVectors(IDA_mem); sensMallocDone = FALSE; sensi = FALSE; } } /* * IDAQuadSensFree * * IDAQuadSensFree frees the problem memory in ida_mem allocated * for quadrature sensitivity analysis. Its only argument is the * pointer ida_mem returned by IDACreate. */ void IDAQuadSensFree(void* ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) return; IDA_mem = (IDAMem) ida_mem; if (quadSensMallocDone) { IDAQuadSensFreeVectors(IDA_mem); quadSensMallocDone=FALSE; quadr_sensi = FALSE; } } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * IDACheckNvector * * This routine checks if all required vector operations are present. * If any of them is missing it returns FALSE. */ static booleantype IDACheckNvector(N_Vector tmpl) { if ((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(FALSE); else return(TRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * IDAAllocVectors * * This routine allocates the IDA vectors ewt, tempv1, tempv2, and * phi[0], ..., phi[maxord]. * If all memory allocations are successful, IDAAllocVectors returns * TRUE. Otherwise all allocated memory is freed and IDAAllocVectors * returns FALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j, maxcol; /* Allocate ewt, ee, delta, tempv1, tempv2 */ ewt = N_VClone(tmpl); if (ewt == NULL) return(FALSE); ee = N_VClone(tmpl); if (ee == NULL) { N_VDestroy(ewt); return(FALSE); } delta = N_VClone(tmpl); if (delta == NULL) { N_VDestroy(ewt); N_VDestroy(ee); return(FALSE); } tempv1 = N_VClone(tmpl); if (tempv1 == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); return(FALSE); } tempv2= N_VClone(tmpl); if (tempv2 == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); N_VDestroy(tempv1); return(FALSE); } savres = tempv1; /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are allocated (for use as temporary vectors), regardless of maxord. */ maxcol = MAX(maxord,3); for (j=0; j <= maxcol; j++) { phi[j] = N_VClone(tmpl); if (phi[j] == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); N_VDestroy(tempv1); N_VDestroy(tempv2); for (i=0; i < j; i++) N_VDestroy(phi[i]); return(FALSE); } } /* Update solver workspace lengths */ lrw += (maxcol + 6)*lrw1; liw += (maxcol + 6)*liw1; /* Store the value of maxord used here */ IDA_mem->ida_maxord_alloc = maxord; return(TRUE); } /* * IDAfreeVectors * * This routine frees the IDA vectors allocated for IDA. */ static void IDAFreeVectors(IDAMem IDA_mem) { int j, maxcol; N_VDestroy(ewt); ewt = NULL; N_VDestroy(ee); ee = NULL; N_VDestroy(delta); delta = NULL; N_VDestroy(tempv1); tempv1 = NULL; N_VDestroy(tempv2); tempv2 = NULL; maxcol = MAX(IDA_mem->ida_maxord_alloc,3); for(j=0; j <= maxcol; j++) { N_VDestroy(phi[j]); phi[j] = NULL;} lrw -= (maxcol + 6)*lrw1; liw -= (maxcol + 6)*liw1; if (IDA_mem->ida_VatolMallocDone) { N_VDestroy(Vatol); Vatol = NULL; lrw -= lrw1; liw -= liw1; } if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(constraints); constraints = NULL; lrw -= lrw1; liw -= liw1; } if (IDA_mem->ida_idMallocDone) { N_VDestroy(id); id = NULL; lrw -= lrw1; liw -= liw1; } } /* * IDAQuadAllocVectors * * NOTE: Space for ewtQ is allocated even when errconQ=FALSE, * although in this case, ewtQ is never used. The reason for this * decision is to allow the user to re-initialize the quadrature * computation with errconQ=TRUE, after an initialization with * errconQ=FALSE, without new memory allocation within * IDAQuadReInit. */ static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j; /* Allocate yyQ */ yyQ = N_VClone(tmpl); if (yyQ == NULL) { return (FALSE); } /* Allocate ypQ */ ypQ = N_VClone(tmpl); if (ypQ == NULL) { N_VDestroy(yyQ); return (FALSE); } /* Allocate ewtQ */ ewtQ = N_VClone(tmpl); if (ewtQ == NULL) { N_VDestroy(yyQ); N_VDestroy(ypQ); return (FALSE); } /* Allocate eeQ */ eeQ = N_VClone(tmpl); if (eeQ == NULL) { N_VDestroy(yyQ); N_VDestroy(ypQ); N_VDestroy(ewtQ); return (FALSE); } for (j=0; j <= maxord; j++) { phiQ[j] = N_VClone(tmpl); if (phiQ[j] == NULL) { N_VDestroy(yyQ); N_VDestroy(ypQ); N_VDestroy(ewtQ); N_VDestroy(eeQ); for (i=0; i < j; i++) N_VDestroy(phiQ[i]); return(FALSE); } } lrw += (maxord+4)*lrw1Q; liw += (maxord+4)*liw1Q; return(TRUE); } /* * IDAQuadFreeVectors * * This routine frees the IDAS vectors allocated in IDAQuadAllocVectors. */ static void IDAQuadFreeVectors(IDAMem IDA_mem) { int j; N_VDestroy(yyQ); yyQ = NULL; N_VDestroy(ypQ); ypQ = NULL; N_VDestroy(ewtQ); ewtQ = NULL; N_VDestroy(eeQ); eeQ = NULL; for(j=0; j <= maxord; j++) { N_VDestroy(phiQ[j]); phiQ[j] = NULL;} lrw -= (maxord+5)*lrw1Q; liw -= (maxord+5)*liw1Q; if (IDA_mem->ida_VatolQMallocDone) { N_VDestroy(VatolQ); VatolQ = NULL; lrw -= lrw1Q; liw -= liw1Q; } IDA_mem->ida_VatolQMallocDone = FALSE; } /* * IDASensAllocVectors * * Allocates space for the N_Vectors, plist, and pbar required for FSA. */ static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int j, maxcol; tmpS1 = tempv1; tmpS2 = tempv2; /* Allocate space for workspace vectors */ tmpS3 = N_VClone(tmpl); if (tmpS3==NULL) { return(FALSE); } ewtS = N_VCloneVectorArray(Ns, tmpl); if (ewtS==NULL) { N_VDestroy(tmpS3); return(FALSE); } eeS = N_VCloneVectorArray(Ns, tmpl); if (eeS==NULL) { N_VDestroy(tmpS3); N_VDestroyVectorArray(ewtS, Ns); return(FALSE); } yyS = N_VCloneVectorArray(Ns, tmpl); if (yyS==NULL) { N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroy(tmpS3); return(FALSE); } ypS = N_VCloneVectorArray(Ns, tmpl); if (ypS==NULL) { N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroy(tmpS3); return(FALSE); } deltaS = N_VCloneVectorArray(Ns, tmpl); if (deltaS==NULL) { N_VDestroyVectorArray(ypS, Ns); N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroy(tmpS3); return(FALSE); } /* Update solver workspace lengths */ lrw += (3*Ns+1)*lrw1; liw += (3*Ns+1)*liw1; /* Allocate space for phiS */ /* Make sure phiS[2], phiS[3] and phiS[4] are allocated (for use as temporary vectors), regardless of maxord.*/ maxcol = MAX(maxord,4); for (j=0; j <= maxcol; j++) { phiS[j] = N_VCloneVectorArray(Ns, tmpl); if (phiS[j] == NULL) { N_VDestroy(tmpS3); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(ypS, Ns); N_VDestroyVectorArray(deltaS, Ns); return(FALSE); } } /* Update solver workspace lengths */ lrw += maxcol*Ns*lrw1; liw += maxcol*Ns*liw1; /* Allocate space for pbar and plist */ pbar = NULL; pbar = (realtype *)malloc(Ns*sizeof(realtype)); if (pbar == NULL) { N_VDestroy(tmpS3); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(ypS, Ns); N_VDestroyVectorArray(deltaS, Ns); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(phiS[j], Ns); return(FALSE); } plist = NULL; plist = (int *)malloc(Ns*sizeof(int)); if (plist == NULL) { N_VDestroy(tmpS3); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(ypS, Ns); N_VDestroyVectorArray(deltaS, Ns); free(pbar); pbar = NULL; return(FALSE); } /* Update solver workspace lengths */ lrw += Ns; liw += Ns; return(TRUE); } /* * IDASensFreeVectors * * Frees memory allocated by IDASensAllocVectors. */ static void IDASensFreeVectors(IDAMem IDA_mem) { int j, maxcol; N_VDestroyVectorArray(deltaS, Ns); N_VDestroyVectorArray(ypS, Ns); N_VDestroyVectorArray(yyS, Ns); N_VDestroyVectorArray(eeS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroy(tmpS3); maxcol = MAX(IDA_mem->ida_maxord_alloc, 4); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(phiS[j], Ns); free(pbar); pbar = NULL; free(plist); plist = NULL; lrw -= ( (maxcol+3)*Ns + 1 ) * lrw1 + Ns; liw -= ( (maxcol+3)*Ns + 1 ) * liw1 + Ns; if (IDA_mem->ida_VatolSMallocDone) { N_VDestroyVectorArray(VatolS, Ns); lrw -= Ns*lrw1; liw -= Ns*liw1; IDA_mem->ida_VatolSMallocDone = FALSE; } if (IDA_mem->ida_SatolSMallocDone) { free(SatolS); SatolS = NULL; lrw -= Ns; IDA_mem->ida_SatolSMallocDone = FALSE; } } /* * IDAQuadSensAllocVectors * * Create (through duplication) N_Vectors used for quadrature sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype IDAQuadSensAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j, maxcol; /* Allocate yQS */ yyQS = N_VCloneVectorArray(Ns, tmpl); if (yyQS == NULL) { return(FALSE); } /* Allocate ewtQS */ ewtQS = N_VCloneVectorArray(Ns, tmpl); if (ewtQS == NULL) { N_VDestroyVectorArray(yyQS, Ns); return(FALSE); } /* Allocate tempvQS */ tempvQS = N_VCloneVectorArray(Ns, tmpl); if (tempvQS == NULL) { N_VDestroyVectorArray(yyQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); return(FALSE); } eeQS = N_VCloneVectorArray(Ns, tmpl); if (eeQS == NULL) { N_VDestroyVectorArray(yyQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(tempvQS, Ns); return(FALSE); } savrhsQ = N_VClone(tmpl); if (savrhsQ == NULL) { N_VDestroyVectorArray(yyQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(tempvQS, Ns); N_VDestroyVectorArray(eeQS, Ns); } maxcol = MAX(maxord,4); /* Allocate phiQS */ for (j=0; j<=maxcol; j++) { phiQS[j] = N_VCloneVectorArray(Ns, tmpl); if (phiQS[j] == NULL) { N_VDestroyVectorArray(yyQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(tempvQS, Ns); N_VDestroyVectorArray(eeQS, Ns); N_VDestroy(savrhsQ); for (i=0; iida_VatolQSMallocDone) { N_VDestroyVectorArray(VatolQS, Ns); lrw -= Ns*lrw1Q; liw -= Ns*liw1Q; } if (IDA_mem->ida_SatolQSMallocDone) { free(SatolQS); SatolQS = NULL; lrw -= Ns; } IDA_mem->ida_VatolQSMallocDone = FALSE; IDA_mem->ida_SatolQSMallocDone = FALSE; } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * IDAInitialSetup * * This routine is called by IDASolve once at the first step. * It performs all checks on optional inputs and inputs to * IDAInit/IDAReInit that could not be done before. * * If no merror is encountered, IDAInitialSetup returns IDA_SUCCESS. * Otherwise, it returns an error flag and reported to the error * handler function. */ int IDAInitialSetup(IDAMem IDA_mem) { booleantype conOK; int ier, retval; /* Test for more vector operations, depending on options */ if (suppressalg) if (id->ops->nvwrmsnormmask == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Test id vector for legality */ if (suppressalg && (id==NULL)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_MISSING_ID); return(IDA_ILL_INPUT); } /* Did the user specify tolerances? */ if (itol == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLS); return(IDA_ILL_INPUT); } /* Set data for efun */ if (IDA_mem->ida_user_efun) edata = user_data; else edata = IDA_mem; /* Initial error weight vectors */ ier = efun(phi[0], ewt, edata); if (ier != 0) { if (itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_FAIL_EWT); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWT); return(IDA_ILL_INPUT); } if (quadr) { /* Evaluate quadrature rhs and set phiQ[1] */ retval = rhsQ(tn, phi[0], phi[1], phiQ[1], user_data); nrQe++; if (retval < 0) { IDAProcessError(IDA_mem, IDA_QRHS_FAIL, "IDAS", "IDAInitialSetup", MSG_QRHSFUNC_FAILED); return(IDA_QRHS_FAIL); } else if (retval > 0) { IDAProcessError(IDA_mem, IDA_FIRST_QRHS_ERR, "IDAS", "IDAInitialSetup", MSG_QRHSFUNC_FIRST); return(IDA_FIRST_QRHS_ERR); } if (errconQ) { /* Did the user specify tolerances? */ if (itolQ == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQ); return(IDA_ILL_INPUT); } /* Load ewtQ */ ier = IDAQuadEwtSet(IDA_mem, phiQ[0], ewtQ); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTQ); return(IDA_ILL_INPUT); } } } else { errconQ = FALSE; } if (sensi) { /* Did the user specify tolerances? */ if (itolS == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLS); return(IDA_ILL_INPUT); } /* Load ewtS */ ier = IDASensEwtSet(IDA_mem, phiS[0], ewtS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTS); return(IDA_ILL_INPUT); } } else { errconS = FALSE; } if (quadr_sensi) { /* store the quadrature sensitivity residual. */ retval = rhsQS(Ns, tn, phi[0], phi[1], phiS[0], phiS[1], phiQ[1], phiQS[1], user_dataQS, tmpS1, tmpS2, tmpS3); nrQSe++; if (retval < 0) { IDAProcessError(IDA_mem, IDA_QSRHS_FAIL, "IDAS", "IDAInitialSetup", MSG_QSRHSFUNC_FAILED); return(IDA_QRHS_FAIL); } else if (retval > 0) { IDAProcessError(IDA_mem, IDA_FIRST_QSRHS_ERR, "IDAS", "IDAInitialSetup", MSG_QSRHSFUNC_FIRST); return(IDA_FIRST_QSRHS_ERR); } /* If using the internal DQ functions, we must have access to fQ * (i.e. quadrature integration must be enabled) and to the problem parameters */ if (rhsQSDQ) { /* Test if quadratures are defined, so we can use fQ */ if (!quadr) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NULL_RHSQ); return(IDA_ILL_INPUT); } /* Test if we have the problem parameters */ if (p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (errconQS) { /* Did the user specify tolerances? */ if (itolQS == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQS); return(IDA_ILL_INPUT); } /* If needed, did the user provide quadrature tolerances? */ if ( (itolQS == IDA_EE) && (itolQ == IDA_NN) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQ); return(IDA_ILL_INPUT); } /* Load ewtS */ ier = IDAQuadSensEwtSet(IDA_mem, phiQS[0], ewtQS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTQS); return(IDA_ILL_INPUT); } } } else { errconQS = FALSE; } /* Check to see if y0 satisfies constraints. */ if (constraintsSet) { if (sensi && (ism==IDA_SIMULTANEOUS)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_ISM_CONSTR); return(IDA_ILL_INPUT); } conOK = N_VConstrMask(constraints, phi[0], tempv2); if (!conOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_Y0_FAIL_CONSTR); return(IDA_ILL_INPUT); } } /* Check that lsolve exists and call linit function if it exists. */ if (lsolve == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_LSOLVE_NULL); return(IDA_ILL_INPUT); } if (linit != NULL) { retval = linit(IDA_mem); if (retval != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_LINIT_FAIL); return(IDA_LINIT_FAIL); } } return(IDA_SUCCESS); } /* * IDAEwtSet * * This routine is responsible for loading the error weight vector * ewt, according to itol, as follows: * (1) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol), i=0,...,Neq-1 * if itol = IDA_SS * (2) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol[i]), i=0,...,Neq-1 * if itol = IDA_SV * * IDAEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data) { IDAMem IDA_mem; int flag = 0; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; switch(itol) { case IDA_SS: flag = IDAEwtSetSS(IDA_mem, ycur, weight); break; case IDA_SV: flag = IDAEwtSetSV(IDA_mem, ycur, weight); break; } return(flag); } /* * IDAEwtSetSS * * This routine sets ewt as decribed above in the case itol=IDA_SS. * It tests for non-positive components before inverting. IDAEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv1); N_VScale(rtol, tempv1, tempv1); N_VAddConst(tempv1, Satol, tempv1); if (N_VMin(tempv1) <= ZERO) return(-1); N_VInv(tempv1, weight); return(0); } /* * IDAEwtSetSV * * This routine sets ewt as decribed above in the case itol=IDA_SV. * It tests for non-positive components before inverting. IDAEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv1); N_VLinearSum(rtol, tempv1, ONE, Vatol, tempv1); if (N_VMin(tempv1) <= ZERO) return(-1); N_VInv(tempv1, weight); return(0); } /* * IDAQuadEwtSet * */ static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { int flag=0; switch (itolQ) { case IDA_SS: flag = IDAQuadEwtSetSS(IDA_mem, qcur, weightQ); break; case IDA_SV: flag = IDAQuadEwtSetSV(IDA_mem, qcur, weightQ); break; } return(flag); } /* * IDAQuadEwtSetSS * */ static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = ypQ; N_VAbs(qcur, tempvQ); N_VScale(rtolQ, tempvQ, tempvQ); N_VAddConst(tempvQ, SatolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * IDAQuadEwtSetSV * */ static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = ypQ; N_VAbs(qcur, tempvQ); N_VLinearSum(rtolQ, tempvQ, ONE, VatolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * IDASensEwtSet * */ int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int flag=0; switch (itolS) { case IDA_EE: flag = IDASensEwtSetEE(IDA_mem, yScur, weightS); break; case IDA_SS: flag = IDASensEwtSetSS(IDA_mem, yScur, weightS); break; case IDA_SV: flag = IDASensEwtSetSV(IDA_mem, yScur, weightS); break; } return(flag); } /* * IDASensEwtSetEE * * In this case, the error weight vector for the i-th sensitivity is set to * * ewtS_i = pbar_i * efun(pbar_i*yS_i) * * In other words, the scaled sensitivity pbar_i * yS_i has the same error * weight vector calculation as the solution vector. * */ static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int is; N_Vector pyS; int flag; /* Use tempv1 as temporary storage for the scaled sensitivity */ pyS = tempv1; for (is=0; is ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } } /* Test for tout = tretlast, and for tn past tout. */ if (tout == tretlast) { *tret = tretlast = tout; return(IDA_SUCCESS); } if ((tn - tout)*hh >= ZERO) { ier = IDAGetSolution(IDA_mem, tout, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout); return(IDA_ILL_INPUT); } *tret = tretlast = tout; return(IDA_SUCCESS); } if (tstopset) { troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (tstopset) { /* Test for tn past tstop, tn past tretlast, and tn near tstop. */ if ((tn - tstop)*hh > ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } } /* Test for tn past tretlast. */ if ((tn - tretlast)*hh > ZERO) { ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; return(IDA_SUCCESS); } if (tstopset) { troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); } return(-99); } /* * IDAStopTest2 * * This routine tests for stop conditions after taking a step. * The tests depend on the value of itask. * * The return values are: * CONTINUE_STEPS if no stop conditions were found * IDA_SUCCESS for a normal return to the user * IDA_TSTOP_RETURN for a tstop-reached return to the user * * In the two cases with tstop, this routine may reset the stepsize hh * to cause the next step to reach tstop exactly. * * In the two cases with ONE_STEP mode, no interpolation to tn is needed * because yret and ypret already contain the current y and y' values. * * Note: No test is made for an error return from IDAGetSolution here, * because the same test was made prior to the step. */ static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { int ier; realtype troundoff; switch (itask) { case IDA_NORMAL: /* Test for tn past tout. */ if ((tn - tout)*hh >= ZERO) { ier = IDAGetSolution(IDA_mem, tout, yret, ypret); *tret = tretlast = tout; return(IDA_SUCCESS); } if (tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } *tret = tretlast = tn; return(IDA_SUCCESS); } return -99; } /* * ----------------------------------------------------------------- * Error handler * ----------------------------------------------------------------- */ /* * IDAHandleFailure * * This routine prints error messages for all cases of failure by * IDAStep. It returns to IDASolve the value that it is to return to * the user. */ static int IDAHandleFailure(IDAMem IDA_mem, int sflag) { /* Depending on sflag, print error message and return error flag */ switch (sflag) { case IDA_ERR_FAIL: IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDAS", "IDASolve", MSG_ERR_FAILS, tn, hh); return(IDA_ERR_FAIL); case IDA_CONV_FAIL: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDAS", "IDASolve", MSG_CONV_FAILS, tn, hh); return(IDA_CONV_FAIL); case IDA_LSETUP_FAIL: IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDAS", "IDASolve", MSG_SETUP_FAILED, tn); return(IDA_LSETUP_FAIL); case IDA_LSOLVE_FAIL: IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDAS", "IDASolve", MSG_SOLVE_FAILED, tn); return(IDA_LSOLVE_FAIL); case IDA_REP_RES_ERR: IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDAS", "IDASolve", MSG_REP_RES_ERR, tn); return(IDA_REP_RES_ERR); case IDA_RES_FAIL: IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDAS", "IDASolve", MSG_RES_NONRECOV, tn); return(IDA_RES_FAIL); case IDA_CONSTR_FAIL: IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDAS", "IDASolve", MSG_FAILED_CONSTR, tn); return(IDA_CONSTR_FAIL); } return -99; } /* * ----------------------------------------------------------------- * Main IDAStep function * ----------------------------------------------------------------- */ /* * IDAStep * * This routine performs one internal IDA step, from tn to tn + hh. * It calls other routines to do all the work. * * It solves a system of differential/algebraic equations of the form * F(t,y,y') = 0, for one step. In IDA, tt is used for t, * yy is used for y, and yp is used for y'. The function F is supplied as 'res' * by the user. * * The methods used are modified divided difference, fixed leading * coefficient forms of backward differentiation formulas. * The code adjusts the stepsize and order to control the local error per step. * * The main operations done here are as follows: * * initialize various quantities; * * setting of multistep method coefficients; * * solution of the nonlinear system for yy at t = tn + hh; * * deciding on order reduction and testing the local error; * * attempting to recover from failure in nonlinear solver or error test; * * resetting stepsize and order for the next step. * * updating phi and other state data if successful; * * On a failure in the nonlinear system solution or error test, the * step may be reattempted, depending on the nature of the failure. * * Variables or arrays (all in the IDAMem structure) used in IDAStep are: * * tt -- Independent variable. * yy -- Solution vector at tt. * yp -- Derivative of solution vector after successful stelp. * res -- User-supplied function to evaluate the residual. See the * description given in file ida.h . * lsetup -- Routine to prepare for the linear solver call. It may either * save or recalculate quantities used by lsolve. (Optional) * lsolve -- Routine to solve a linear system. A prior call to lsetup * may be required. * hh -- Appropriate step size for next step. * ewt -- Vector of weights used in all convergence tests. * phi -- Array of divided differences used by IDAStep. This array is composed * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum * order for the problem, maxord, plus 1. * * Return values are: * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR * IDA_LSOLVE_FAIL IDA_ERR_FAIL * IDA_CONSTR_FAIL IDA_CONV_FAIL * IDA_REP_RES_ERR */ static int IDAStep(IDAMem IDA_mem) { realtype saved_t, ck; realtype err_k, err_km1, err_km2; int ncf, nef; int nflag, kflag; int retval; booleantype sensi_stg; /* Are we computing sensitivities with the staggered approach? */ sensi_stg = (sensi && (ism==IDA_STAGGERED)); saved_t = tn; ncf = nef = 0; if (nst == ZERO){ kk = 1; kused = 0; hused = ZERO; psi[0] = hh; cj = ONE/hh; phase = 0; ns = 0; } /* To prevent 'unintialized variable' warnings */ err_k = ZERO; err_km1 = ZERO; err_km2 = ZERO; /* Looping point for attempts to take a step */ loop { /*----------------------- Set method coefficients -----------------------*/ IDASetCoeffs(IDA_mem, &ck); kflag = IDA_SUCCESS; /*---------------------------------------------------- If tn is past tstop (by roundoff), reset it to tstop. -----------------------------------------------------*/ tn = tn + hh; if (tstopset) { if ((tn - tstop)*hh > ZERO) tn = tstop; } /*----------------------- Advance state variables -----------------------*/ /* Nonlinear system solution */ nflag = IDANls(IDA_mem); /* If NLS was successful, perform error test */ if (nflag == IDA_SUCCESS) nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &ncfn, &ncf, &netf, &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(nst==0) IDAReset(IDA_mem); continue; } /*---------------------------- Advance quadrature variables ----------------------------*/ if (quadr) { nflag = IDAQuadNls(IDA_mem); /* If NLS was successful, perform error test */ if (errconQ && (nflag == IDA_SUCCESS)) nflag = IDAQuadTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &ncfnQ, &ncf, &netfQ, &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(nst==0) IDAReset(IDA_mem); continue; } } /*-------------------------------------------------- Advance sensitivity variables (Staggered approach) --------------------------------------------------*/ if (sensi_stg) { /* Evaluate res at converged y, needed for future evaluations of sens. RHS If res() fails recoverably, treat it as a convergence failure and attempt the step again */ retval = res(tn, yy, yp, delta, user_data); if (retval < 0) return(IDA_RES_FAIL); else if (retval > 0) continue; nflag = IDASensNls(IDA_mem); /* If NLS was successful, perform error test */ if (errconS && (nflag == IDA_SUCCESS)) nflag = IDASensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &ncfnQ, &ncf, &netfQ, &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(nst==0) IDAReset(IDA_mem); continue; } } /*------------------------------------------- Advance quadrature sensitivity variables -------------------------------------------*/ if (quadr_sensi) { nflag = IDAQuadSensNls(IDA_mem); /* If NLS was successful, perform error test */ if (errconQS && (nflag == IDA_SUCCESS)) nflag = IDAQuadSensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &ncfnQ, &ncf, &netfQ, &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(nst==0) IDAReset(IDA_mem); continue; } } /* kflag == IDA_SUCCESS */ break; } /* end loop */ /* Nonlinear system solve and error test were both successful; update data, and consider change of step and/or order */ IDACompleteStep(IDA_mem, err_k, err_km1); /* Rescale ee vector to be the estimated local error Notes: (1) altering the value of ee is permissible since it will be re-initialized to the zero vector by IDASolve()->IDAStep()->IDANls()->IDANewtonIter() before it is needed again (2) the value of ee is only valid if IDAHandleNFlag() returns either PREDICT_AGAIN or IDA_SUCCESS */ N_VScale(ck, ee, ee); return(IDA_SUCCESS); } /* * IDAGetSolution * * This routine evaluates y(t) and y'(t) as the value and derivative of * the interpolating polynomial at the independent variable t, and stores * the results in the vectors yret and ypret. It uses the current * independent variable value, tn, and the method order last used, kused. * This function is called by IDASolve with t = tout, t = tn, or t = tstop. * * If kused = 0 (no step has been taken), or if t = tn, then the order used * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0]. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret) { IDAMem IDA_mem; realtype tfuzz, tp, delt, c, d, gam; int j, kord; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSolution", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSolution", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize yret = phi[0], ypret = 0, and kord = (kused or 1). */ N_VScale (ONE, phi[0], yret); N_VConst (ZERO, ypret); kord = kused; if (kused == 0) kord = 1; /* Accumulate multiples of columns phi[j] into yret and ypret. */ delt = t - tn; c = ONE; d = ZERO; gam = delt/psi[0]; for (j=1; j <= kord; j++) { d = d*gam + c/psi[j-1]; c = c*gam; gam = (delt + psi[j-1])/psi[j]; N_VLinearSum(ONE, yret, c, phi[j], yret); N_VLinearSum(ONE, ypret, d, phi[j], ypret); } return(IDA_SUCCESS); } /* * IDASetCoeffs * * This routine computes the coefficients relevant to the current step. * The counter ns counts the number of consecutive steps taken at * constant stepsize h and order k, up to a maximum of k + 2. * Then the first ns components of beta will be one, and on a step * with ns = k + 2, the coefficients alpha, etc. need not be reset here. * Also, IDACompleteStep prohibits an order increase until ns = k + 2. */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck) { int i, is; realtype temp1, temp2, alpha0, alphas; /* Set coefficients for the current stepsize h */ if (hh != hused || kk != kused) ns = 0; ns = MIN(ns+1,kused+2); if (kk+1 >= ns) { beta[0] = ONE; alpha[0] = ONE; temp1 = hh; gamma[0] = ZERO; sigma[0] = ONE; for(i=1;i<=kk;i++){ temp2 = psi[i-1]; psi[i-1] = temp1; beta[i] = beta[i-1] * psi[i-1] / temp2; temp1 = temp2 + hh; alpha[i] = hh / temp1; sigma[i] = i * sigma[i-1] * alpha[i]; gamma[i] = gamma[i-1] + alpha[i-1] / hh; } psi[kk] = temp1; } /* compute alphas, alpha0 */ alphas = ZERO; alpha0 = ZERO; for(i=0;i temp2) callSetup = TRUE; if (forceSetup) callSetup = TRUE; if (cj != cjlast) {ss = HUNDRED; ssS = HUNDRED;} } /* Begin the main loop. This loop is traversed at most twice. The second pass only occurs when the first pass had a recoverable failure with old Jacobian data */ loop{ /* Compute predicted values for yy and yp, and compute residual there. */ IDAPredict(IDA_mem); retval = res(tn, yy, yp, delta, user_data); nre++; if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); if (sensi_sim) { for(is=0;is 0) return(IDA_SRES_RECVR); } /* If indicated, call linear solver setup function and reset parameters. */ if (callSetup){ nsetups++; forceSetup = FALSE; retval = lsetup(IDA_mem, yy, yp, delta, tempv1, tempv2, tempv3); cjold = cj; cjratio = ONE; ss = TWENTY; ssS = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); } /* Call the Newton iteration routine. */ retval = IDANewtonIter(IDA_mem); /* Retry the current step on recoverable failure with old Jacobian data. */ tryAgain = (retval>0)&&(setupNonNull) &&(!callSetup); if (tryAgain){ callSetup = TRUE; continue; } else break; } /* end of loop */ if (retval != IDA_SUCCESS) return(retval); /* If otherwise successful, check and enforce inequality constraints. */ if (constraintsSet){ /* Check constraints and get mask vector mm, set where constraints failed */ constraintsPassed = N_VConstrMask(constraints,yy,mm); if (constraintsPassed) return(IDA_SUCCESS); else { N_VCompare(ONEPT5, constraints, tempv1); /* a , where a[i] =1. when |c[i]| = 2 , c the vector of constraints */ N_VProd(tempv1, constraints, tempv1); /* a * c */ N_VDiv(tempv1, ewt, tempv1); /* a * c * wt */ N_VLinearSum(ONE, yy, -PT1, tempv1, tempv1);/* y - 0.1 * a * c * wt */ N_VProd(tempv1, mm, tempv1); /* v = mm*(y-.1*a*c*wt) */ vnorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, FALSE); /* ||v|| */ /* If vector v of constraint corrections is small in norm, correct and accept this step */ if (vnorm <= epsNewt){ N_VLinearSum(ONE, ee, -ONE, tempv1, ee); /* ee <- ee - v */ return(IDA_SUCCESS); } else { /* Constraints not met -- reduce h by computing rr = h'/h */ N_VLinearSum(ONE, phi[0], -ONE, yy, tempv1); N_VProd(mm, tempv1, tempv1); rr = PT9*N_VMinQuotient(phi[0], tempv1); rr = MAX(rr,PT1); return(IDA_CONSTR_RECVR); } } } return(IDA_SUCCESS); } /* * IDAPredict * * This routine predicts the new values for vectors yy and yp. */ static void IDAPredict(IDAMem IDA_mem) { int j; N_VScale(ONE, phi[0], yy); N_VConst(ZERO, yp); for(j=1; j<=kk; j++) { N_VLinearSum(ONE, phi[j], ONE, yy, yy); N_VLinearSum(gamma[j], phi[j], ONE, yp, yp); } } /* * IDANewtonIter * * This routine performs the Newton iteration. * It assumes that delta contains the initial residual vector on entry. * If the iteration succeeds, it returns the value IDA_SUCCESS = 0. * If not, it returns either: * a positive value (for a recoverable failure), namely one of: * IDA_RES_RECVR * IDA_SRES_RECVR * IDA_LSOLVE_RECVR * IDA_NCONV_RECVR * or * a negative value (for a nonrecoverable failure), namely one of: * IDA_RES_FAIL * IDA_SRES_FAIL * IDA_LSOLVE_FAIL * * NOTE: This routine uses N_Vector savres, which is preset to tempv1. */ static int IDANewtonIter(IDAMem IDA_mem) { int mnewt, retval, is; realtype delnrm, oldnrm, rate; booleantype sensi_sim; sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS)); /* Initialize counter mnewt and cumulative correction vectors ee and eeS. */ mnewt = 0; N_VConst(ZERO, ee); if (sensi_sim) for(is=0;is 0) return(IDA_LSOLVE_RECVR); /* Call the lsolve function to get correction vectors deltaS. */ if (sensi_sim) { for(is=0;is 0) return(IDA_LSOLVE_RECVR); } } /* Apply delta to yy, yp, and ee, and get norm(delta). */ N_VLinearSum(ONE, yy, -ONE, delta, yy); N_VLinearSum(ONE, ee, -ONE, delta, ee); N_VLinearSum(ONE, yp, -cj, delta, yp); delnrm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); /* Apply deltaS to yys, ypS, and ees, and get update norm(delta). */ if (sensi_sim) { for(is=0;is RATEMAX) return(IDA_NCONV_RECVR); ss = rate/(ONE - rate); } if (ss*delnrm <= epsNewt) return(IDA_SUCCESS); /* Not yet converged. Increment mnewt and test for max allowed. */ mnewt++; if (mnewt >= maxcor) {retval = IDA_NCONV_RECVR; break;} /* Call res for new residual and check error flag from res. */ retval = res(tn, yy, yp, delta, user_data); nre++; if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); if (sensi_sim) { retval = resS(Ns, tn, yy, yp, delta, yyS, ypS, deltaS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if(retval < 0) return(IDA_SRES_FAIL); if(retval > 0) return(IDA_SRES_RECVR); } /* Loop for next iteration. */ } /* end of Newton iteration loop */ /* All error returns exit here. */ return(retval); } /* * IDAQuadNls * * This routine solves for the quadrature variables at the new step. * It does not solve a nonlinear system, but rather updates the * quadrature variables. The name for this function is just for * uniformity purposes. * */ static int IDAQuadNls(IDAMem IDA_mem) { int retval; /* Predict: load yyQ and ypQ */ IDAQuadPredict(IDA_mem); /* Compute correction eeQ */ retval = rhsQ(tn, yy, yp, eeQ, user_data); nrQe++; if (retval < 0) return(IDA_QRHS_FAIL); else if (retval > 0) return(IDA_QRHS_RECVR); if (quadr_sensi) N_VScale(ONE, eeQ, savrhsQ); N_VLinearSum(ONE, eeQ, -ONE, ypQ, eeQ); N_VScale(ONE/cj, eeQ, eeQ); /* Apply correction: yyQ = yyQ + eeQ */ N_VLinearSum(ONE, yyQ, ONE, eeQ, yyQ); return(IDA_SUCCESS); } /* * IDAQuadPredict * * This routine predicts the new value for vectors yyQ and ypQ */ static void IDAQuadPredict(IDAMem IDA_mem) { int j; N_VScale(ONE, phiQ[0], yyQ); N_VConst(ZERO, ypQ); for(j=1; j<=kk; j++) { N_VLinearSum(ONE, phiQ[j], ONE, yyQ, yyQ); N_VLinearSum(gamma[j], phiQ[j], ONE, ypQ, ypQ); } } /* * IDASensNls * * This routine attempts to solve, one by one, all the sensitivity * linear systems using nonlinear iterations and the linear solver * specified (Staggered approach). */ static int IDASensNls(IDAMem IDA_mem) { booleantype callSetup, tryAgain; int is, retval; callSetup = FALSE; /* Begin the main loop. This loop is traversed at most twice. The second pass only occurs when the first pass had a recoverable failure with old Jacobian data */ loop{ for(is=0;is in deltaS */ retval = resS(Ns, tn, yy, yp, delta, yyS, ypS, deltaS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if(retval < 0) return(IDA_SRES_FAIL); if(retval > 0) return(IDA_SRES_RECVR); /* If indicated, call the linear solver setup function */ if (callSetup) { retval = lsetup(IDA_mem, yy, yp, delta, tmpS1, tmpS2, tmpS3); nsetupsS++; cjold = cj; cjratio = ONE; ss = TWENTY; ssS = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); } /* Call the Newton iteration routine */ retval = IDASensNewtonIter(IDA_mem); /* Retry the current step on recoverable failure with old Jacobian data */ tryAgain = (retval>0) && (setupNonNull) && (!callSetup); if (tryAgain) { callSetup = TRUE; continue; } else break; } if (retval != IDA_SUCCESS) ncfnS++; return(retval); } /* * IDASensPredict * * This routine loads the predicted values for the is-th sensitivity * in the vectors yySens and ypSens. * * When ism=IDA_STAGGERED, yySens = yyS[is] and ypSens = ypS[is] */ static void IDASensPredict(IDAMem IDA_mem, int is, N_Vector yySens, N_Vector ypSens) { int j; N_VScale(ONE, phiS[0][is], yySens); N_VConst(ZERO, ypSens); for(j=1; j<=kk; j++) { N_VLinearSum(ONE, phiS[j][is], ONE, yySens, yySens); N_VLinearSum(gamma[j], phiS[j][is], ONE, ypSens, ypSens); } } /* * IDASensNewtonIter * * This routine performs the Newton iteration for sensitivity variables * in the staggered case. * It assumes that deltaS contains the initial sensitivity residual * vectors on entry. * * If the iteration succeeds, it returns the value IDA_SUCCESS = 0. * If not, it returns either: * a positive value (for a recoverable failure), namely one of: * IDA_RES_RECVR * IDA_LSOLVE_RECVR * IDA_NCONV_RECVR * or * a negative value (for a nonrecoverable failure), namely one of: * IDA_RES_FAIL * IDA_LSOLVE_FAIL */ static int IDASensNewtonIter(IDAMem IDA_mem) { int mnewt, is, retval; realtype delSnrm, delSnrm1, rateS; mnewt = 0; /* local Newton iteration counter */ for(is=0;is 0) return(IDA_LSOLVE_RECVR); N_VLinearSum(ONE, eeS[is], -ONE, deltaS[is], eeS[is]); N_VLinearSum(ONE, yyS[is], -ONE, deltaS[is], yyS[is]); N_VLinearSum(ONE, ypS[is], -cj, deltaS[is], ypS[is]); } delSnrm = IDASensWrmsNorm(IDA_mem, deltaS, ewtS, FALSE); if (mnewt == 0) { if (delSnrm <= toldel) return(IDA_SUCCESS); delSnrm1 = delSnrm; } else { rateS = RPowerR(delSnrm/delSnrm1, ONE/mnewt); if (rateS > RATEMAX) return(IDA_NCONV_RECVR); ssS = rateS/(ONE - rateS); } if (ssS * delSnrm <= epsNewt) return(IDA_SUCCESS); mnewt++; if(mnewt >= maxcorS) return(IDA_NCONV_RECVR); retval = resS(Ns, tn, yy, yp, delta, yyS, ypS, deltaS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if (retval < 0) return(IDA_SRES_FAIL); if (retval > 0) return(IDA_SRES_RECVR); } return(retval); } /* * IDAQuadSensNls * * This routine solves for the snesitivity quadrature variables at the * new step. It does not solve a nonlinear system, but rather updates * the sensitivity variables. The name for this function is just for * uniformity purposes. * */ static int IDAQuadSensNls(IDAMem IDA_mem) { int retval, is; N_Vector *ypQS; /* Predict: load yyQS and ypQS for each sensitivity. Store 1st order information in tempvQS. */ ypQS = tempvQS; IDAQuadSensPredict(IDA_mem, yyQS, ypQS); /* Compute correction eeQS */ retval = rhsQS(Ns, tn, yy, yp, yyS, ypS, savrhsQ, eeQS, user_dataQS, tmpS1, tmpS2, tmpS3); nrQSe++; if (retval < 0) return(IDA_QSRHS_FAIL); else if (retval > 0) return(IDA_QSRHS_RECVR); for (is=0; is 1 ) { /* Compute error at order k-1 */ N_VLinearSum(ONE, phi[kk], ONE, ee, delta); enorm_km1 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); *err_km1 = sigma[kk-1] * enorm_km1; terr_km1 = kk * (*err_km1); if ( kk > 2 ) { /* Compute error at order k-2 */ N_VLinearSum(ONE, phi[kk-1], ONE, delta, delta); enorm_km2 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); *err_km2 = sigma[kk-2] * enorm_km2; terr_km2 = (kk-1) * (*err_km2); /* Reduce order if errors are reduced */ if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; } else { /* Reduce order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; } } /* Perform error test */ if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDAQuadTestError * * This routine estimates quadrature errors and updates errors at * orders k, k-1, k-2, decides whether or not to suggest an order reduction, * and performs the local error test. * * IDAQuadTestError returns the updated local error estimate at orders k, * k-1, and k-2. These are norms of type MAX(|err|,|errQ|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDAQuadTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormQ; realtype errQ_k, errQ_km1, errQ_km2; realtype terr_k, terr_km1, terr_km2; N_Vector tempv; booleantype check_for_reduction = FALSE; /* Rename ypQ */ tempv = ypQ; /* Update error for order k. */ enormQ = N_VWrmsNorm(eeQ, ewtQ); errQ_k = sigma[kk] * enormQ; if (errQ_k > *err_k) { *err_k = errQ_k; check_for_reduction = TRUE; } terr_k = (kk+1) * (*err_k); if ( kk > 1 ) { /* Update error at order k-1 */ N_VLinearSum(ONE, phiQ[kk], ONE, eeQ, tempv); errQ_km1 = sigma[kk-1] * N_VWrmsNorm(tempv, ewtQ); if (errQ_km1 > *err_km1) { *err_km1 = errQ_km1; check_for_reduction = TRUE; } terr_km1 = kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (knew != kk) check_for_reduction = FALSE; if (check_for_reduction) { if ( kk > 2 ) { /* Update error at order k-2 */ N_VLinearSum(ONE, phiQ[kk-1], ONE, tempv, tempv); errQ_km2 = sigma[kk-2] * N_VWrmsNorm(tempv, ewtQ); if (errQ_km2 > *err_km2) { *err_km2 = errQ_km2; } terr_km2 = (kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; } } } /* Perform error test */ if (ck * enormQ > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDASensTestError * * This routine estimates sensitivity errors and updates errors at * orders k, k-1, k-2, decides whether or not to suggest an order reduction, * and performs the local error test. (Used only in staggered approach). * * IDASensTestError returns the updated local error estimate at orders k, * k-1, and k-2. These are norms of type MAX(|err|,|errQ|,|errS|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDASensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormS; realtype errS_k, errS_km1, errS_km2; realtype terr_k, terr_km1, terr_km2; N_Vector *tempv; booleantype check_for_reduction = FALSE; int is; /* Rename deltaS */ tempv = deltaS; /* Update error for order k. */ enormS = IDASensWrmsNorm(IDA_mem, eeS, ewtS, suppressalg); errS_k = sigma[kk] * enormS; if (errS_k > *err_k) { *err_k = errS_k; check_for_reduction = TRUE; } terr_k = (kk+1) * (*err_k); if ( kk > 1 ) { /* Update error at order k-1 */ for(is=0;is *err_km1) { *err_km1 = errS_km1; check_for_reduction = TRUE; } terr_km1 = kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (knew != kk) check_for_reduction = FALSE; if (check_for_reduction) { if ( kk > 2 ) { /* Update error at order k-2 */ for(is=0;is *err_km2) { *err_km2 = errS_km2; } terr_km2 = (kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; } } } /* Perform error test */ if (ck * enormS > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDAQuadSensTestError * * This routine estimates quadrature sensitivity errors and updates * errors at orders k, k-1, k-2, decides whether or not to suggest * an order reduction and performs the local error test. (Used * only in staggered approach). * * IDAQuadSensTestError returns the updated local error estimate at * orders k, k-1, and k-2. These are norms of type * MAX(|err|,|errQ|,|errS|,|errQS|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormQS; realtype errQS_k, errQS_km1, errQS_km2; realtype terr_k, terr_km1, terr_km2; N_Vector *tempv; booleantype check_for_reduction = FALSE; int is; tempv = yyQS; enormQS = IDAQuadSensWrmsNorm(IDA_mem, eeQS, ewtQS); errQS_k = sigma[kk] * enormQS; if (errQS_k > *err_k) { *err_k = errQS_k; check_for_reduction = TRUE; } terr_k = (kk+1) * (*err_k); if ( kk > 1 ) { /* Update error at order k-1 */ for(is=0;is *err_km1) { *err_km1 = errQS_km1; check_for_reduction = TRUE; } terr_km1 = kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (knew != kk) check_for_reduction = FALSE; if (check_for_reduction) { if ( kk > 2 ) { /* Update error at order k-2 */ for(is=0;is *err_km2) { *err_km2 = errQS_km2; } terr_km2 = (kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; } } } /* Perform error test */ if (ck * enormQS > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDARestore * * This routine restores tn, psi, and phi in the event of a failure. * It changes back phi-star to phi (changed in IDASetCoeffs) */ static void IDARestore(IDAMem IDA_mem, realtype saved_t) { int j; int is; tn = saved_t; for (j = 1; j <= kk; j++) psi[j-1] = psi[j] - hh; for (j = ns; j <= kk; j++) N_VScale(ONE/beta[j], phi[j], phi[j]); if (quadr) for (j = ns; j <= kk; j++) N_VScale(ONE/beta[j], phiQ[j], phiQ[j]); if (sensi) for (is = 0; is < Ns; is++) for (j = ns; j<=kk; j++) N_VScale(ONE/beta[j], phiS[j][is], phiS[j][is]); if (quadr_sensi) for (is = 0; is < Ns; is++) for (j = ns; j<=kk; j++) N_VScale(ONE/beta[j], phiQS[j][is], phiQS[j][is]); } /* * ----------------------------------------------------------------- * Handler for convergence and/or error test failures * ----------------------------------------------------------------- */ /* * IDAHandleNFlag * * This routine handles failures indicated by the input variable nflag. * Positive values indicate various recoverable failures while negative * values indicate nonrecoverable failures. This routine adjusts the * step size for recoverable failures. * * Possible nflag values (input): * * --convergence failures-- * IDA_RES_RECVR > 0 * IDA_LSOLVE_RECVR > 0 * IDA_CONSTR_RECVR > 0 * IDA_NCONV_RECVR > 0 * IDA_QRHS_RECVR > 0 * IDA_QSRHS_RECVR > 0 * IDA_RES_FAIL < 0 * IDA_LSOLVE_FAIL < 0 * IDA_LSETUP_FAIL < 0 * IDA_QRHS_FAIL < 0 * * --error test failure-- * ERROR_TEST_FAIL > 0 * * Possible kflag values (output): * * --recoverable-- * PREDICT_AGAIN * * --nonrecoverable-- * IDA_CONSTR_FAIL * IDA_REP_RES_ERR * IDA_ERR_FAIL * IDA_CONV_FAIL * IDA_RES_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL * IDA_QRHS_FAIL * IDA_REP_QRHS_ERR */ static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr) { realtype err_knew; phase = 1; if (nflag != ERROR_TEST_FAIL) { /*----------------------- Nonlinear solver failed -----------------------*/ (*ncfPtr)++; /* local counter for convergence failures */ (*ncfnPtr)++; /* global counter for convergence failures */ if (nflag < 0) { /* nonrecoverable failure */ return(nflag); } else { /* recoverable failure */ /* Reduce step size for a new prediction Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */ if (nflag != IDA_CONSTR_RECVR) rr = QUARTER; hh *= rr; /* Test if there were too many convergence failures */ if (*ncfPtr < maxncf) return(PREDICT_AGAIN); else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); else if (nflag == IDA_SRES_RECVR) return(IDA_REP_SRES_ERR); else if (nflag == IDA_QRHS_RECVR) return(IDA_REP_QRHS_ERR); else if (nflag == IDA_QSRHS_RECVR) return(IDA_REP_QSRHS_ERR); else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); else return(IDA_CONV_FAIL); } } else { /*----------------- Error Test failed -----------------*/ (*nefPtr)++; /* local counter for error test failures */ (*netfPtr)++; /* global counter for error test failures */ if (*nefPtr == 1) { /* On first error test failure, keep current order or lower order by one. Compute new stepsize based on differences of the solution. */ err_knew = (kk==knew)? err_k : err_km1; kk = knew; rr = PT9 * RPowerR( TWO * err_knew + PT0001,(-ONE/(kk+1)) ); rr = MAX(QUARTER, MIN(PT9,rr)); hh *=rr; return(PREDICT_AGAIN); } else if (*nefPtr == 2) { /* On second error test failure, use current order or decrease order by one. Reduce stepsize by factor of 1/4. */ kk = knew; rr = QUARTER; hh *= rr; return(PREDICT_AGAIN); } else if (*nefPtr < maxnef) { /* On third and subsequent error test failures, set order to 1. Reduce stepsize by factor of 1/4. */ kk = 1; rr = QUARTER; hh *= rr; return(PREDICT_AGAIN); } else { /* Too many error test failures */ return(IDA_ERR_FAIL); } } } /* * IDAReset * * This routine is called only if we need to predict again at the * very first step. In such a case, reset phi[1] and psi[0]. */ static void IDAReset(IDAMem IDA_mem) { int is; psi[0] = hh; N_VScale(rr, phi[1], phi[1]); if (quadr) N_VScale(rr, phiQ[1], phiQ[1]); if (sensi) for(is=0;is 1) { kk++; hnew = TWO * hh; if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; hh = hnew; } } else { action = UNSET; /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ if (knew == kk-1) {action = LOWER; goto takeaction;} if (kk == maxord) {action = MAINTAIN; goto takeaction;} if ( (kk+1 >= ns ) || (kdiff == 1)) {action = MAINTAIN; goto takeaction;} /* Estimate the error at order k+1, unless already decided to reduce order, or already using maximum order, or stepsize has not been constant, or order was just raised. */ N_VLinearSum (ONE, ee, -ONE, phi[kk+1], tempv1); enorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, suppressalg); if (errconQ) { tempvQ = ypQ; N_VLinearSum (ONE, eeQ, -ONE, phiQ[kk+1], tempvQ); enorm = IDAQuadWrmsNormUpdate(IDA_mem, enorm, tempvQ, ewtQ); } if (errconS) { tempvS = ypS; for (is=0; is= HALF * terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } else { terr_km1 = kk * err_km1; if (terr_km1 <= MIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;} else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } takeaction: /* Set the estimated error norm and, on change of order, reset kk. */ if (action == RAISE) { kk++; err_knew = err_kp1; } else if (action == LOWER) { kk--; err_knew = err_km1; } else { err_knew = err_k; } /* Compute rr = tentative ratio hnew/hh from error norm. Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is. If hh is reduced, hnew/hh is restricted to be between .5 and .9. */ hnew = hh; rr = RPowerR( (TWO * err_knew + PT0001) , (-ONE/(kk+1) ) ); if (rr >= TWO) { hnew = TWO * hh; if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; } else if (rr <= ONE ) { rr = MAX(HALF, MIN(PT9,rr)); hnew = hh * rr; } hh = hnew; } /* end of phase if block */ /* Save ee etc. for possible order increase on next step */ if (kused < maxord) { N_VScale(ONE, ee, phi[kused+1]); if (quadr) N_VScale(ONE, eeQ, phiQ[kused+1]); if (sensi) for (is=0; is=0; j--) N_VLinearSum(ONE, phi[j], ONE, phi[j+1], phi[j]); if (quadr) { N_VLinearSum(ONE, eeQ, ONE, phiQ[kused], phiQ[kused]); for (j= kused-1; j>=0; j--) N_VLinearSum(ONE, phiQ[j], ONE, phiQ[j+1], phiQ[j]); } if (sensi) { for (is=0; is=0; j--) N_VLinearSum(ONE, phiS[j][is], ONE, phiS[j+1][is], phiS[j][is]); } } if (quadr_sensi) { for (is=0; is=0; j--) N_VLinearSum(ONE, phiQS[j][is], ONE, phiQS[j+1][is], phiQS[j][is]); } } } /* * ----------------------------------------------------------------- * Norm functions * ----------------------------------------------------------------- */ /* * IDAWrmsNorm * * Returns the WRMS norm of vector x with weights w. * If mask = TRUE, the weight vector w is masked by id, i.e., * nrm = N_VWrmsNormMask(x,w,id); * Otherwise, * nrm = N_VWrmsNorm(x,w); * * mask = FALSE when the call is made from the nonlinear solver. * mask = suppressalg otherwise. */ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask) { realtype nrm; if (mask) nrm = N_VWrmsNormMask(x, w, id); else nrm = N_VWrmsNorm(x, w); return(nrm); } /* * IDASensWrmsNorm * * This routine returns the maximum over the weighted root mean * square norm of xS with weight vectors wS: * * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } * * Called by IDASensUpdateNorm or directly in the IDA_STAGGERED approach * during the NLS solution and before the error test. * * Declared global for use in the computation of IC for sensitivities. */ realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask) { int is; realtype nrm, snrm; nrm = IDAWrmsNorm(IDA_mem, xS[0], wS[0], mask); for (is=1; is nrm ) nrm = snrm; } return (nrm); } /* * IDAQuadSensWrmsNorm * * This routine returns the maximum over the weighted root mean * square norm of xQS with weight vectors wQS: * * max { wrms(xQS[0],wQS[0]) ... wrms(xQS[Ns-1],wQS[Ns-1]) } */ static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS) { int is; realtype nrm, snrm; nrm = N_VWrmsNorm(xQS[0], wQS[0]); for (is=1; is nrm ) nrm = snrm; } return (nrm); } /* * IDAQuadWrmsNormUpdate * * Updates the norm old_nrm to account for all quadratures. */ static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ) { realtype qnrm; qnrm = N_VWrmsNorm(xQ, wQ); if (old_nrm > qnrm) return(old_nrm); else return(qnrm); } /* * IDASensWrmsNormUpdate * * Updates the norm old_nrm to account for all sensitivities. * * This function is declared global since it is used for finding * IC for sensitivities, */ realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask) { realtype snrm; snrm = IDASensWrmsNorm(IDA_mem, xS, wS, mask); if (old_nrm > snrm) return(old_nrm); else return(snrm); } static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS) { realtype qsnrm; int is; qsnrm = old_nrm; for (is=0; is qsnrm) qsnrm = old_nrm; } return(qsnrm); } /* * ----------------------------------------------------------------- * Functions for rootfinding * ----------------------------------------------------------------- */ /* * IDARcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * IDA_SUCCESS = 0 otherwise. */ static int IDARcheck1(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < nrtfn; i++) iroots[i] = 0; tlo = tn; ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; /* Evaluate g at initial t and check for zero values. */ retval = gfun (tlo, phi[0], phi[1], glo, user_data); nge = 1; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(glo[i]) == ZERO) { zroot = TRUE; gactive[i] = FALSE; } } if (!zroot) return(IDA_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = MAX(ttol/ABS(hh), PT1); smallh = hratio*hh; tplus = tlo + smallh; N_VLinearSum(ONE, phi[0], smallh, phi[1], yy); retval = gfun (tplus, yy, phi[1], ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < nrtfn; i++) { if (!gactive[i] && ABS(ghi[i]) != ZERO) { gactive[i] = TRUE; glo[i] = ghi[i]; } } return(IDA_SUCCESS); } /* * IDARcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * IDASolve. This may be the previous tn, the previous tout value, * or the last root location. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * CLOSERT (>0) if a close pair of zeros was found, or * RTFOUND (>0) if a new zero of g was found near tlo, or * IDA_SUCCESS (=0) otherwise. */ static int IDARcheck2(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (irfnd == 0) return(IDA_SUCCESS); (void) IDAGetSolution(IDA_mem, tlo, yy, yp); retval = gfun (tlo, yy, yp, glo, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) iroots[i] = 0; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(glo[i]) == ZERO) { zroot = TRUE; iroots[i] = 1; } } if (!zroot) return(IDA_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; smallh = (hh > ZERO) ? ttol : -ttol; tplus = tlo + smallh; if ( (tplus - tn)*hh >= ZERO) { hratio = smallh/hh; N_VLinearSum(ONE, yy, hratio, phi[1], yy); } else { (void) IDAGetSolution(IDA_mem, tplus, yy, yp); } retval = gfun (tplus, yy, yp, ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if (iroots[i] == 1) return(CLOSERT); zroot = TRUE; iroots[i] = 1; } else { if (iroots[i] == 1) glo[i] = ghi[i]; } } if (zroot) return(RTFOUND); return(IDA_SUCCESS); } /* * IDARcheck3 * * This routine interfaces to IDARootfind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * RTFOUND (>0) if a root of g was found, or * IDA_SUCCESS (=0) otherwise. */ static int IDARcheck3(IDAMem IDA_mem) { int i, ier, retval; /* Set thi = tn or tout, whichever comes first. */ if (taskc == IDA_ONE_STEP) thi = tn; if (taskc == IDA_NORMAL) { thi = ( (toutc - tn)*hh >= ZERO) ? tn : toutc; } /* Get y and y' at thi. */ (void) IDAGetSolution(IDA_mem, thi, yy, yp); /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */ retval = gfun (thi, yy, yp, ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; ier = IDARootfind(IDA_mem); if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL); for(i=0; i 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to TRUE for all i=0,...,nrtfn-1, but it may be * reset to FALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on TRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (ABS(tlo), ABS(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, and must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * RTFOUND = 1 if a root of g was found, or * IDA_SUCCESS = 0 otherwise. * */ static int IDARootfind(IDAMem IDA_mem) { realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { trout = thi; for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; if (!zroot) return(IDA_SUCCESS); for (i = 0; i < nrtfn; i++) { iroots[i] = 0; if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alph to avoid compiler warning */ alph = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; loop { /* Looping point */ /* Set weight alph. On the first two passes, set alph = 1. Thereafter, reset alph according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alph = 1. If the sides were the same, then double alph (if high side), or halve alph (if low side). The next guess tmid is the secant method value if alph = 1, but is closer to tlo if alph < 1, and closer to thi if alph > 1. */ if (sideprev == side) { alph = (side == 2) ? alph*TWO : alph*HALF; } else { alph = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alph*glo[imax]); if (ABS(tmid - tlo) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = tlo + fracsub*(thi - tlo); } if (ABS(thi - tmid) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = thi - fracsub*(thi - tlo); } (void) IDAGetSolution(IDA_mem, tmid, yy, yp); retval = gfun (tmid, yy, yp, grout, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; sideprev = side; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(grout[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(grout[i]/(grout[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (ABS(thi - tlo) <= ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ tlo = tmid; for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (ABS(thi - tlo) <= ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ trout = thi; for (i = 0; i < nrtfn; i++) { grout[i] = ghi[i]; iroots[i] = 0; if(!gactive[i]) continue; if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ================================================================= * Internal DQ approximations for sensitivity RHS * ================================================================= */ #undef Ns #undef yy #undef yp #undef yyS #undef ypS #undef user_dataS /* * IDASensResDQ * * IDASensRhsDQ computes the residuals of the sensitivity equations * by finite differences. It is of type IDASensResFn. * Returns 0 if successful, <0 if an unrecoverable failure occurred, * >0 for a recoverable error. */ int IDASensResDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp) { int retval, is; for (is=0; is0 if res has a recoverable error). */ static int IDASensRes1DQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, int is, N_Vector yyS, N_Vector ypS, N_Vector resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp) { IDAMem IDA_mem; int method; int which; int retval; realtype psave, pbari; realtype del , rdel; realtype Delp, rDelp, r2Delp; realtype Dely, rDely, r2Dely; realtype Del , rDel , r2Del ; realtype norms, ratio; /* user_dataS points to IDA_mem */ IDA_mem = (IDAMem) user_dataS; /* Set base perturbation del */ del = RSqrt(MAX(rtol, uround)); rdel = ONE/del; pbari = pbar[is]; which = plist[is]; psave = p[which]; Delp = pbari * del; rDelp = ONE/Delp; norms = N_VWrmsNorm(yyS, ewt) * pbari; rDely = MAX(norms, rdel) / pbari; Dely = ONE/rDely; if (DQrhomax == ZERO) { /* No switching */ method = (DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1; } else { /* switch between simultaneous/separate DQ */ ratio = Dely * rDelp; if ( MAX(ONE/ratio, ratio) <= DQrhomax ) method = (DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1; else method = (DQtype==IDA_CENTERED) ? CENTERED2 : FORWARD2; } switch (method) { case CENTERED1: Del = MIN(Dely, Delp); r2Del = HALF/Del; /* Forward perturb y, y' and parameter */ N_VLinearSum(Del, yyS, ONE, yy, ytemp); N_VLinearSum(Del, ypS, ONE, yp, yptemp); p[which] = psave + Del; /* Save residual in resvalS */ retval = res(t, ytemp, yptemp, resvalS, user_data); nreS++; if (retval != 0) return(retval); /* Backward perturb y, y' and parameter */ N_VLinearSum(-Del, yyS, ONE, yy, ytemp); N_VLinearSum(-Del, ypS, ONE, yp, yptemp); p[which] = psave - Del; /* Save residual in restemp */ retval = res(t, ytemp, yptemp, restemp, user_data); nreS++; if (retval != 0) return(retval); /* Estimate the residual for the i-th sensitivity equation */ N_VLinearSum(r2Del, resvalS, -r2Del, restemp, resvalS); break; case CENTERED2: r2Delp = HALF/Delp; r2Dely = HALF/Dely; /* Forward perturb y and y' */ N_VLinearSum(Dely, yyS, ONE, yy, ytemp); N_VLinearSum(Dely, ypS, ONE, yp, yptemp); /* Save residual in resvalS */ retval = res(t, ytemp, yptemp, resvalS, user_data); nreS++; if (retval != 0) return(retval); /* Backward perturb y and y' */ N_VLinearSum(-Dely, yyS, ONE, yy, ytemp); N_VLinearSum(-Dely, ypS, ONE, yp, yptemp); /* Save residual in restemp */ retval = res(t, ytemp, yptemp, restemp, user_data); nreS++; if (retval != 0) return(retval); /* Save the first difference quotient in resvalS */ N_VLinearSum(r2Dely, resvalS, -r2Dely, restemp, resvalS); /* Forward perturb parameter */ p[which] = psave + Delp; /* Save residual in ytemp */ retval = res(t, yy, yp, ytemp, user_data); nreS++; if (retval != 0) return(retval); /* Backward perturb parameter */ p[which] = psave - Delp; /* Save residual in yptemp */ retval = res(t, yy, yp, yptemp, user_data); nreS++; if (retval != 0) return(retval); /* Save the second difference quotient in restemp */ N_VLinearSum(r2Delp, ytemp, -r2Delp, yptemp, restemp); /* Add the difference quotients for the sensitivity residual */ N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS); break; case FORWARD1: Del = MIN(Dely, Delp); rDel = ONE/Del; /* Forward perturb y, y' and parameter */ N_VLinearSum(Del, yyS, ONE, yy, ytemp); N_VLinearSum(Del, ypS, ONE, yp, yptemp); p[which] = psave + Del; /* Save residual in resvalS */ retval = res(t, ytemp, yptemp, resvalS, user_data); nreS++; if (retval != 0) return(retval); /* Estimate the residual for the i-th sensitivity equation */ N_VLinearSum(rDel, resvalS, -rDel, resval, resvalS); break; case FORWARD2: /* Forward perturb y and y' */ N_VLinearSum(Dely, yyS, ONE, yy, ytemp); N_VLinearSum(Dely, ypS, ONE, yp, yptemp); /* Save residual in resvalS */ retval = res(t, ytemp, yptemp, resvalS, user_data); nreS++; if (retval != 0) return(retval); /* Save the first difference quotient in resvalS */ N_VLinearSum(rDely, resvalS, -rDely, resval, resvalS); /* Forward perturb parameter */ p[which] = psave + Delp; /* Save residual in restemp */ retval = res(t, yy, yp, restemp, user_data); nreS++; if (retval != 0) return(retval); /* Save the second difference quotient in restemp */ N_VLinearSum(rDelp, restemp, -rDelp, resval, restemp); /* Add the difference quotients for the sensitivity residual */ N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS); break; } /* Restore original value of parameter */ p[which] = psave; return(0); } /* IDAQuadSensRhsInternalDQ - internal IDAQuadSensRhsFn * * IDAQuadSensRhsInternalDQ computes right hand side of all quadrature * sensitivity equations by finite differences. All work is actually * done in IDAQuadSensRhs1InternalDQ. */ static int IDAQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *resvalQS, void *ida_mem, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS) { IDAMem IDA_mem; int is, retval; /* cvode_mem is passed here as user data */ IDA_mem = (IDAMem) ida_mem; for (is=0; isida_ehfun) #define eh_data (IDA_mem->ida_eh_data) void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to IDAProcessError) */ va_start(ap, msgfmt); if (IDA_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, msgfmt); fprintf(stderr, "\n\n"); #endif } else { /* We can call ehfun */ /* Compose the message */ vsprintf(msg, msgfmt, ap); /* Call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* IDAErrHandler is the default error handling function. It sends the error message to the stream pointed to by ida_errfp */ #define errfp (IDA_mem->ida_errfp) void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { IDAMem IDA_mem; char err_type[10]; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; if (error_code == IDA_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (errfp!=NULL) { fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(errfp," %s\n\n",msg); } #endif return; } sundials-2.5.0/src/idas/idas_ic.c0000600000175000017500000012544311741421242017467 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2011/04/26 22:51:51 $ * ----------------------------------------------------------------- * Programmers: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the implementation file for the IC calculation for IDAS. * It is independent of the linear solver in use. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include /* Macro: loop */ #define loop for(;;) /* * ================================================================= * IDA Constants * ================================================================= */ /* Private Constants */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT001 RCONST(0.001) /* real 0.001 */ /* IDACalcIC control constants */ #define ICRATEMAX RCONST(0.9) /* max. Newton conv. rate */ #define ALPHALS RCONST(0.0001) /* alpha in linesearch conv. test */ /* Return values for lower level routines used by IDACalcIC */ #define IC_FAIL_RECOV 1 #define IC_CONSTR_FAILED 2 #define IC_LINESRCH_FAILED 3 #define IC_CONV_FAIL 4 #define IC_SLOW_CONVRG 5 /* * ================================================================= * Private Helper Functions Prototypes * ================================================================= */ extern int IDAInitialSetup(IDAMem IDA_mem); extern realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); extern realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask); extern realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask); extern int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDANlsIC(IDAMem IDA_mem); static int IDANewtonIC(IDAMem IDA_mem); static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm); static int IDANewyyp(IDAMem IDA_mem, realtype lambda); static int IDANewy(IDAMem IDA_mem); static int IDASensNewtonIC(IDAMem IDA_mem); static int IDASensLineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); static int IDASensNewyyp(IDAMem IDA_mem, realtype lambda); static int IDASensfnorm(IDAMem IDA_mem, realtype *fnorm); static int IDASensNlsIC(IDAMem IDA_mem); static int IDAICFailFlag(IDAMem IDA_mem, int retval); /* * ================================================================= * Readibility Constants * ================================================================= */ #define t0 (IDA_mem->ida_t0) #define yy0 (IDA_mem->ida_yy0) #define yp0 (IDA_mem->ida_yp0) #define user_data (IDA_mem->ida_user_data) #define res (IDA_mem->ida_res) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define uround (IDA_mem->ida_uround) #define phi (IDA_mem->ida_phi) #define ewt (IDA_mem->ida_ewt) #define delta (IDA_mem->ida_delta) #define ee (IDA_mem->ida_ee) #define savres (IDA_mem->ida_savres) #define tempv2 (IDA_mem->ida_tempv2) #define hh (IDA_mem->ida_hh) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define nbacktr (IDA_mem->ida_nbacktr) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define ns (IDA_mem->ida_ns) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define hused (IDA_mem->ida_hused) #define epsNewt (IDA_mem->ida_epsNewt) #define id (IDA_mem->ida_id) #define setupNonNull (IDA_mem->ida_setupNonNull) #define suppressalg (IDA_mem->ida_suppressalg) #define constraints (IDA_mem->ida_constraints) #define constraintsSet (IDA_mem->ida_constraintsSet) #define epiccon (IDA_mem->ida_epiccon) #define maxnh (IDA_mem->ida_maxnh) #define maxnj (IDA_mem->ida_maxnj) #define maxnit (IDA_mem->ida_maxnit) #define lsoff (IDA_mem->ida_lsoff) #define steptol (IDA_mem->ida_steptol) #define sensi (IDA_mem->ida_sensi) #define Ns (IDA_mem->ida_Ns) #define resS (IDA_mem->ida_resS) #define phiS (IDA_mem->ida_phiS) #define ism (IDA_mem->ida_ism) #define ewtS (IDA_mem->ida_ewtS) #define ncfnS (IDA_mem->ida_ncfnS) #define nniS (IDA_mem->ida_nniS) #define nsetupsS (IDA_mem->ida_nsetupsS) #define yyS0 (IDA_mem->ida_yyS0) #define ypS0 (IDA_mem->ida_ypS0) #define delnewS (IDA_mem->ida_delnewS) #define savresS (IDA_mem->ida_savresS) #define yyS0new (IDA_mem->ida_yyS0new) #define ypS0new (IDA_mem->ida_ypS0new) #define eeS (IDA_mem->ida_eeS) /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDACalcIC * ----------------------------------------------------------------- * IDACalcIC computes consistent initial conditions, given the * user's initial guess for unknown components of yy0 and/or yp0. * * The return value is IDA_SUCCESS = 0 if no error occurred. * * The error return values (fully described in ida.h) are: * IDA_MEM_NULL ida_mem is NULL * IDA_NO_MALLOC ida_mem was not allocated * IDA_ILL_INPUT bad value for icopt, tout1, or id * IDA_LINIT_FAIL the linear solver linit routine failed * IDA_BAD_EWT zero value of some component of ewt * IDA_RES_FAIL res had a non-recoverable error * IDA_FIRST_RES_FAIL res failed recoverably on the first call * IDA_LSETUP_FAIL lsetup had a non-recoverable error * IDA_LSOLVE_FAIL lsolve had a non-recoverable error * IDA_NO_RECOVERY res, lsetup, or lsolve had a recoverable * error, but IDACalcIC could not recover * IDA_CONSTR_FAIL the inequality constraints could not be met * IDA_LINESEARCH_FAIL the linesearch failed (on steptol test) * IDA_CONV_FAIL the Newton iterations failed to converge * ----------------------------------------------------------------- */ int IDACalcIC(void *ida_mem, int icopt, realtype tout1) { int ewtsetOK; int ier, nwt, nh, mxnh, icret, retval=0; int is; realtype tdist, troundoff, minid, hic, ypnorm; IDAMem IDA_mem; booleantype sensi_stg, sensi_sim; /* Check if IDA memory exists */ if(ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDACalcIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if(IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDACalcIC", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs to IDA for correctness and consistency */ ier = IDAInitialSetup(IDA_mem); if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = TRUE; /* Check legality of input arguments, and set IDA memory copies. */ if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ICOPT); return(IDA_ILL_INPUT); } IDA_mem->ida_icopt = icopt; if(icopt == IDA_YA_YDP_INIT && (id == NULL)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_MISSING_ID); return(IDA_ILL_INPUT); } tdist = ABS(tout1 - tn); troundoff = TWO*uround*(ABS(tn) + ABS(tout1)); if(tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_TOO_CLOSE); return(IDA_ILL_INPUT); } /* Are we computing sensitivities? */ sensi_stg = (sensi && (ism==IDA_STAGGERED)); sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS)); /* Allocate space and initialize temporary vectors */ yy0 = N_VClone(ee); yp0 = N_VClone(ee); t0 = tn; N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); if (sensi) { /* Allocate temporary space required for sensitivity IC: yyS0 and ypS0. */ yyS0 = N_VCloneVectorArray(Ns, ee); ypS0 = N_VCloneVectorArray(Ns, ee); /* Initialize sensitivity vector. */ for (is=0; isida_sysindex = 1; IDA_mem->ida_tscale = tdist; if(icopt == IDA_YA_YDP_INIT) { minid = N_VMin(id); if(minid < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ID); return(IDA_ILL_INPUT); } if(minid > HALF) IDA_mem->ida_sysindex = 0; } /* Set the test constant in the Newton convergence test */ IDA_mem->ida_epsNewt = epiccon; /* Initializations: cjratio = 1 (for use in direct linear solvers); set nbacktr = 0; */ cjratio = ONE; nbacktr = 0; /* Set hic, hh, cj, and mxnh. */ hic = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); if (sensi_sim) ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, ypS0, ewtS, FALSE); if(ypnorm > HALF/hic) hic = HALF/ypnorm; if(tout1 < tn) hic = -hic; hh = hic; if(icopt == IDA_YA_YDP_INIT) { cj = ONE/hic; mxnh = maxnh; } else { cj = ZERO; mxnh = 1; } /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { /* Call the IC nonlinear solver function. */ retval = IDANlsIC(IDA_mem); /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ if(retval == IDA_SUCCESS) break; ncfn++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yy0 and yp0 if not converging. */ if(retval != IC_SLOW_CONVRG) { N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); if (sensi_sim) { /* Reset yyS0 and ypS0. */ /* Copy phiS[0] and phiS[1] into yyS0 and ypS0. */ for (is=0; is 0) /* res function failed recoverably but no recovery possible. */ return(IDA_FIRST_RES_FAIL); /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { retval = IDASensNlsIC(IDA_mem); if(retval == IDA_SUCCESS) break; /* Increment the number of the sensitivity related corrector convergence failures. */ ncfnS++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yyS0 and ypS0 if not converging. */ if(retval != IC_SLOW_CONVRG) { for (is=0; isida_icopt) #define sysindex (IDA_mem->ida_sysindex) #define tscale (IDA_mem->ida_tscale) #define ynew (IDA_mem->ida_ynew) #define ypnew (IDA_mem->ida_ypnew) #define delnew (IDA_mem->ida_delnew) #define dtemp (IDA_mem->ida_dtemp) #define user_dataS (IDA_mem->ida_user_dataS) #define deltaS (IDA_mem->ida_deltaS) #define tmpS1 (IDA_mem->ida_tmpS1) #define tmpS2 (IDA_mem->ida_tmpS2) #define tmpS3 (IDA_mem->ida_tmpS3) #define nrSe (IDA_mem->ida_nrSe) /* * ----------------------------------------------------------------- * IDANlsIC * ----------------------------------------------------------------- * IDANlsIC solves a nonlinear system for consistent initial * conditions. It calls IDANewtonIC to do most of the work. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations are converging slowly * (failed the convergence test, but showed * norm reduction or convergence rate < 1) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_FIRST_RES_FAIL if res failed recoverably on the first call * IDA_LSETUP_FAIL if lsetup had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDANlsIC(IDAMem IDA_mem) { int retval, nj, is; N_Vector tv1, tv2, tv3; booleantype sensi_sim; /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */ sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS)); tv1 = ee; tv2 = tempv2; tv3 = phi[2]; /* Evaluate RHS. */ retval = res(t0, yy0, yp0, delta, user_data); nre++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); /* Save the residual. */ N_VScale(ONE, delta, savres); if(sensi_sim) { /*Evaluate sensitivity RHS and save it in savresS. */ retval = resS(Ns, t0, yy0, yp0, delta, yyS0, ypS0, deltaS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); for(is=0; is 0) return(IC_FAIL_RECOV); } /* Call the Newton iteration routine, and return if successful. */ retval = IDANewtonIC(IDA_mem); if(retval == IDA_SUCCESS) return(IDA_SUCCESS); /* If converging slowly and lsetup is nontrivial, retry. */ if(retval == IC_SLOW_CONVRG && setupNonNull) { N_VScale(ONE, savres, delta); if(sensi_sim) for(is=0; is 0) return(IC_FAIL_RECOV); /* Compute the norm of the step. */ fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); /* Call the lsolve function to get correction vectors deltaS. */ if (sensi_sim) { for(is=0;is 0) return(IC_FAIL_RECOV); } /* Update the norm of delta. */ fnorm = IDASensWrmsNormUpdate(IDA_mem, fnorm, deltaS, ewtS, FALSE); } /* Test for convergence. Return now if the norm is small. */ if(sysindex == 0) fnorm *= tscale*ABS(cj); if(fnorm <= epsNewt) return(IDA_SUCCESS); fnorm0 = fnorm; /* Initialize rate to avoid compiler warning message */ rate = ZERO; /* Newton iteration loop */ for(mnewt = 0; mnewt < maxnit; mnewt++) { nni++; delnorm = fnorm; oldfnrm = fnorm; /* Call the Linesearch function and return if it failed. */ retval = IDALineSrch(IDA_mem, &delnorm, &fnorm); if(retval != IDA_SUCCESS) return(retval); /* Set the observed convergence rate and test for convergence. */ rate = fnorm/oldfnrm; if(fnorm <= epsNewt) return(IDA_SUCCESS); /* If not converged, copy new step vector, and loop. */ N_VScale(ONE, delnew, delta); if(sensi_sim) { /* Update the iteration's step for sensitivities. */ for(is=0; is 0) return(IC_FAIL_RECOV); N_VScale(ONE, delnew, savres); /* Call the linear solve function to get J-inverse F; return if failed. */ retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Compute the WRMS-norm. */ *fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE); /* Are we computing SENSITIVITIES with the IDA_SIMULTANEOUS approach? */ if(sensi && (ism==IDA_SIMULTANEOUS)) { /* Evaluate the residual for sensitivities. */ retval = resS(Ns, t0, ynew, ypnew, savres, yyS0new, ypS0new, delnewS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Save delnewS in savresS. */ for(is=0; is 0) return(IC_FAIL_RECOV); } /* Include sensitivities in norm. */ *fnorm = IDASensWrmsNormUpdate(IDA_mem, *fnorm, delnewS, ewtS, FALSE); } /* Rescale norm if index = 0. */ if(sysindex == 0) (*fnorm) *= tscale*ABS(cj); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDANewyyp * ----------------------------------------------------------------- * IDANewyyp updates the vectors ynew and ypnew from yy0 and yp0, * using the current step vector lambda*delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewyyp(IDAMem IDA_mem, realtype lambda) { int retval; retval = IDA_SUCCESS; /* IDA_YA_YDP_INIT case: ynew = yy0 - lambda*delta where id_i = 0 ypnew = yp0 - cj*lambda*delta where id_i = 1. */ if(icopt == IDA_YA_YDP_INIT) { N_VProd(id, delta, dtemp); N_VLinearSum(ONE, yp0, -cj*lambda, dtemp, ypnew); N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); N_VLinearSum(ONE, yy0, -lambda, dtemp, ynew); }else if(icopt == IDA_Y_INIT) { /* IDA_Y_INIT case: ynew = yy0 - lambda*delta. (ypnew = yp0 preset.) */ N_VLinearSum(ONE, yy0, -lambda, delta, ynew); } if(sensi && (ism==IDA_SIMULTANEOUS)) retval = IDASensNewyyp(IDA_mem, lambda); return(retval); } /* * ----------------------------------------------------------------- * IDANewy * ----------------------------------------------------------------- * IDANewy updates the vector ynew from yy0, * using the current step vector delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewy(IDAMem IDA_mem) { /* IDA_YA_YDP_INIT case: ynew = yy0 - delta where id_i = 0. */ if(icopt == IDA_YA_YDP_INIT) { N_VProd(id, delta, dtemp); N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); N_VLinearSum(ONE, yy0, -ONE, dtemp, ynew); return(IDA_SUCCESS); } /* IDA_Y_INIT case: ynew = yy0 - delta. */ N_VLinearSum(ONE, yy0, -ONE, delta, ynew); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Sensitivity I.C. functions * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * IDASensNlsIC * ----------------------------------------------------------------- * IDASensNlsIC solves nonlinear systems forsensitivities consistent * initial conditions. It mainly relies on IDASensNewtonIC. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations are converging slowly * (failed the convergence test, but showed * norm reduction or convergence rate < 1) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_FIRST_RES_FAIL if res failed recoverably on the first call * IDA_LSETUP_FAIL if lsetup had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDASensNlsIC(IDAMem IDA_mem) { int retval; int is, nj; retval = resS(Ns, t0, yy0, yp0, delta, yyS0, ypS0, deltaS, user_dataS, tmpS1, tmpS2, tmpS3); nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); /* Save deltaS */ for(is=0; is 0) return(IC_FAIL_RECOV); continue; } else { return(retval); } } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDASensNewtonIC * ----------------------------------------------------------------- * IDANewtonIC performs the Newton iteration to solve for * sensitivities consistent initial conditions. It calls * IDASensLineSrch within each iteration. * On return, savresS contains the current residual vectors. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations appear to be converging slowly. * They failed the convergence test, but showed * an overall norm reduction (by a factor of < 0.1) * or a convergence rate <= ICRATEMAX). * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDASensNewtonIC(IDAMem IDA_mem) { int retval, is, mnewt; realtype delnorm, fnorm, fnorm0, oldfnrm, rate; for(is=0;is 0) return(IC_FAIL_RECOV); } /* Compute the norm of the step and return if it is small enough */ fnorm = IDASensWrmsNorm(IDA_mem, deltaS, ewtS, FALSE); if(sysindex == 0) fnorm *= tscale*ABS(cj); if(fnorm <= epsNewt) return(IDA_SUCCESS); fnorm0 = fnorm; rate = ZERO; /* Newton iteration loop */ for(mnewt = 0; mnewt < maxnit; mnewt++) { nniS++; delnorm = fnorm; oldfnrm = fnorm; /* Call the Linesearch function and return if it failed. */ retval = IDASensLineSrch(IDA_mem, &delnorm, &fnorm); if(retval != IDA_SUCCESS) return(retval); /* Set the observed convergence rate and test for convergence. */ rate = fnorm/oldfnrm; if(fnorm <= epsNewt) return(IDA_SUCCESS); /* If not converged, copy new step vectors, and loop. */ for(is=0; is 0) return(IC_FAIL_RECOV); for(is=0; is 0) return(IC_FAIL_RECOV); } /* Compute the WRMS-norm; rescale if index = 0. */ *fnorm = IDASensWrmsNorm(IDA_mem, delnewS, ewtS, FALSE); if(sysindex == 0) (*fnorm) *= tscale*ABS(cj); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDASensNewyyp * ----------------------------------------------------------------- * IDASensNewyyp computes the Newton updates for each of the * sensitivities systems using the current step vector lambda*delta, * in a manner depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDASensNewyyp(IDAMem IDA_mem, realtype lambda) { int is; if(icopt == IDA_YA_YDP_INIT) { /* IDA_YA_YDP_INIT case: - ySnew = yS0 - lambda*deltaS where id_i = 0 - ypSnew = ypS0 - cj*lambda*delta where id_i = 1. */ for(is=0; is #include #include #include /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* Basic IDA constants */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MAXORD_DEFAULT 5 /* maxord default value */ #define MXORDP1 6 /* max. number of N_Vectors in phi */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* itol */ #define IDA_NN 0 #define IDA_SS 1 #define IDA_SV 2 #define IDA_WF 3 #define IDA_EE 4 /* * ----------------------------------------------------------------- * Types: struct IDAMemRec, IDAMem * ----------------------------------------------------------------- * The type IDAMem is type pointer to struct IDAMemRec. * This structure contains fields to keep track of problem state. * ----------------------------------------------------------------- */ typedef struct IDAMemRec { realtype ida_uround; /* machine unit roundoff */ /*-------------------------- Problem Specification Data --------------------------*/ IDAResFn ida_res; /* F(t,y(t),y'(t))=0; the function F */ void *ida_user_data; /* user pointer passed to res */ int ida_itol; /* itol = IDA_SS, IDA_SV, IDA_WF, IDA_NN */ realtype ida_rtol; /* relative tolerance */ realtype ida_Satol; /* scalar absolute tolerance */ N_Vector ida_Vatol; /* vector absolute tolerance */ booleantype ida_user_efun; /* TRUE if user provides efun */ IDAEwtFn ida_efun; /* function to set ewt */ void *ida_edata; /* user pointer passed to efun */ /*----------------------- Quadrature Related Data -----------------------*/ booleantype ida_quadr; IDAQuadRhsFn ida_rhsQ; void *ida_user_dataQ; booleantype ida_errconQ; int ida_itolQ; realtype ida_rtolQ; realtype ida_SatolQ; /* scalar absolute tolerance for quadratures */ N_Vector ida_VatolQ; /* vector absolute tolerance for quadratures */ /*------------------------ Sensitivity Related Data ------------------------*/ booleantype ida_sensi; int ida_Ns; int ida_ism; IDASensResFn ida_resS; void *ida_user_dataS; booleantype ida_resSDQ; realtype *ida_p; realtype *ida_pbar; int *ida_plist; int ida_DQtype; realtype ida_DQrhomax; booleantype ida_errconS; /* TRUE if sensitivities in err. control */ int ida_itolS; realtype ida_rtolS; /* relative tolerance for sensitivities */ realtype *ida_SatolS; /* scalar absolute tolerances for sensi. */ N_Vector *ida_VatolS; /* vector absolute tolerances for sensi. */ /*----------------------------------- Quadrature Sensitivity Related Data -----------------------------------*/ booleantype ida_quadr_sensi; /* TRUE if computing sensitivities of quadrs.*/ IDAQuadSensRhsFn ida_rhsQS; /* fQS = (dfQ/dy)*yS + (dfQ/dp) */ void *ida_user_dataQS; /* data pointer passed to fQS */ booleantype ida_rhsQSDQ; /* TRUE if using internal DQ functions */ booleantype ida_errconQS; /* TRUE if yQS are considered in err. con. */ int ida_itolQS; realtype ida_rtolQS; /* relative tolerance for yQS */ realtype *ida_SatolQS; /* scalar absolute tolerances for yQS */ N_Vector *ida_VatolQS; /* vector absolute tolerances for yQS */ /*----------------------------------------------- Divided differences array and associated arrays -----------------------------------------------*/ N_Vector ida_phi[MXORDP1]; /* phi = (maxord+1) arrays of divided differences */ realtype ida_psi[MXORDP1]; /* differences in t (sums of recent step sizes) */ realtype ida_alpha[MXORDP1]; /* ratios of current stepsize to psi values */ realtype ida_beta[MXORDP1]; /* ratios of current to previous product of psi's */ realtype ida_sigma[MXORDP1]; /* product successive alpha values and factorial */ realtype ida_gamma[MXORDP1]; /* sum of reciprocals of psi values */ /*------------------------- N_Vectors for integration -------------------------*/ N_Vector ida_ewt; /* error weight vector */ N_Vector ida_yy; /* work space for y vector (= user's yret) */ N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ N_Vector ida_delta; /* residual vector */ N_Vector ida_id; /* bit vector for diff./algebraic components */ N_Vector ida_constraints; /* vector of inequality constraint options */ N_Vector ida_savres; /* saved residual vector (= tempv1) */ N_Vector ida_ee; /* accumulated corrections to y vector, but set equal to estimated local errors upon successful return */ N_Vector ida_mm; /* mask vector in constraints tests (= tempv2) */ N_Vector ida_tempv1; /* work space vector */ N_Vector ida_tempv2; /* work space vector */ N_Vector ida_ynew; /* work vector for y in IDACalcIC (= tempv2) */ N_Vector ida_ypnew; /* work vector for yp in IDACalcIC (= ee) */ N_Vector ida_delnew; /* work vector for delta in IDACalcIC (= phi[2]) */ N_Vector ida_dtemp; /* work vector in IDACalcIC (= phi[3]) */ /*---------------------------- Quadrature Related N_Vectors ----------------------------*/ N_Vector ida_phiQ[MXORDP1]; N_Vector ida_yyQ; N_Vector ida_ypQ; N_Vector ida_ewtQ; N_Vector ida_eeQ; /*--------------------------- Sensitivity Related Vectors ---------------------------*/ N_Vector *ida_phiS[MXORDP1]; N_Vector *ida_ewtS; N_Vector *ida_eeS; /* cumulative sensitivity corrections */ N_Vector *ida_yyS; /* allocated and used for: */ N_Vector *ida_ypS; /* ism = SIMULTANEOUS */ N_Vector *ida_deltaS; /* ism = STAGGERED */ N_Vector ida_tmpS1; /* work space vectors | tmpS1 = tempv1 */ N_Vector ida_tmpS2; /* for resS | tmpS2 = tempv2 */ N_Vector ida_tmpS3; /* | tmpS3 = allocated */ N_Vector *ida_savresS; /* work vector in IDACalcIC for stg (= phiS[2]) */ N_Vector *ida_delnewS; /* work vector in IDACalcIC for stg (= phiS[3]) */ N_Vector *ida_yyS0; /* initial yS, ypS vectors allocated and */ N_Vector *ida_ypS0; /* deallocated in IDACalcIC function */ N_Vector *ida_yyS0new; /* work vector in IDASensLineSrch (= phiS[4]) */ N_Vector *ida_ypS0new; /* work vector in IDASensLineSrch (= eeS) */ /*-------------------------------------- Quadrature Sensitivity Related Vectors --------------------------------------*/ N_Vector *ida_phiQS[MXORDP1];/* Mod. div. diffs. for quadr. sensitivities */ N_Vector *ida_ewtQS; /* error weight vectors for sensitivities */ N_Vector *ida_eeQS; /* cumulative quadr.sensi.corrections */ N_Vector *ida_yyQS; /* Unlike yS, yQS is not allocated by the user */ N_Vector *ida_tempvQS; /* temporary storage vector (~ tempv) */ N_Vector ida_savrhsQ; /* saved quadr. rhs (needed for rhsQS calls) */ /*------------------------------ Variables for use by IDACalcIC ------------------------------*/ realtype ida_t0; /* initial t */ N_Vector ida_yy0; /* initial y vector (user-supplied). */ N_Vector ida_yp0; /* initial y' vector (user-supplied). */ int ida_icopt; /* IC calculation user option */ booleantype ida_lsoff; /* IC calculation linesearch turnoff option */ int ida_maxnh; /* max. number of h tries in IC calculation */ int ida_maxnj; /* max. number of J tries in IC calculation */ int ida_maxnit; /* max. number of Netwon iterations in IC calc. */ int ida_nbacktr; /* number of IC linesearch backtrack operations */ int ida_sysindex; /* computed system index (0 or 1) */ realtype ida_epiccon; /* IC nonlinear convergence test constant */ realtype ida_steptol; /* minimum Newton step size in IC calculation */ realtype ida_tscale; /* time scale factor = abs(tout1 - t0) */ /* Tstop information */ booleantype ida_tstopset; realtype ida_tstop; /* Step Data */ int ida_kk; /* current BDF method order */ int ida_knew; /* order for next step from order decrease decision */ int ida_phase; /* flag to trigger step doubling in first few steps */ int ida_ns; /* counts steps at fixed stepsize and order */ realtype ida_hin; /* initial step */ realtype ida_hh; /* current step size h */ realtype ida_rr; /* rr = hnext / hused */ realtype ida_tn; /* current internal value of t */ realtype ida_tretlast; /* value of tret previously returned by IDASolve */ realtype ida_cj; /* current value of scalar (-alphas/hh) in Jacobian */ realtype ida_cjlast; /* cj value saved from last successful step */ realtype ida_cjold; /* cj value saved from last call to lsetup */ realtype ida_cjratio; /* ratio of cj values: cj/cjold */ realtype ida_ss; /* scalar used in Newton iteration convergence test */ realtype ida_epsNewt; /* test constant in Newton convergence test */ realtype ida_epcon; /* coeficient of the Newton covergence test */ realtype ida_toldel; /* tolerance in direct test on Newton corrections */ realtype ida_ssS; /* scalar ss for staggered sensitivities */ /*------ Limits ------*/ int ida_maxncf; /* max numer of convergence failures */ int ida_maxcor; /* max number of Newton corrections */ int ida_maxnef; /* max number of error test failures */ int ida_maxord; /* max value of method order k: */ int ida_maxord_alloc; /* value of maxord used when allocating memory */ long int ida_mxstep; /* max number of internal steps for one user call */ realtype ida_hmax_inv; /* inverse of max. step size hmax (default = 0.0) */ int ida_maxcorS; /* max number of Newton corrections for sensitivity systems (staggered method) */ /*-------- Counters --------*/ long int ida_nst; /* number of internal steps taken */ long int ida_nre; /* number of function (res) calls */ long int ida_nrQe; long int ida_nrSe; long int ida_nrQSe; /* number of fQS calls */ long int ida_nreS; long int ida_nrQeS; /* number of fQ calls from sensi DQ */ long int ida_ncfn; /* number of corrector convergence failures */ long int ida_ncfnQ; long int ida_ncfnS; long int ida_netf; /* number of error test failures */ long int ida_netfQ; long int ida_netfS; long int ida_netfQS; /* number of quadr. sensi. error test failures */ long int ida_nni; /* number of Newton iterations performed */ long int ida_nniS; long int ida_nsetups; /* number of lsetup calls */ long int ida_nsetupsS; /*--------------------------- Space requirements for IDAS ---------------------------*/ long int ida_lrw1; /* no. of realtype words in 1 N_Vector */ long int ida_liw1; /* no. of integer words in 1 N_Vector */ long int ida_lrw1Q; long int ida_liw1Q; long int ida_lrw; /* number of realtype words in IDA work vectors */ long int ida_liw; /* no. of integer words in IDA work vectors */ /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ IDAErrHandlerFn ida_ehfun; /* Error messages are handled by ehfun */ void *ida_eh_data; /* dats pointer passed to ehfun */ FILE *ida_errfp; /* IDA error messages are sent to errfp */ /* Flags to verify correct calling sequence */ booleantype ida_SetupDone; /* set to FALSE by IDAInit and IDAReInit set to TRUE by IDACalcIC or IDASolve */ booleantype ida_VatolMallocDone; booleantype ida_constraintsMallocDone; booleantype ida_idMallocDone; booleantype ida_MallocDone; /* set to FALSE by IDACreate set to TRUE by IDAInit tested by IDAReInit and IDASolve */ booleantype ida_VatolQMallocDone; booleantype ida_quadMallocDone; booleantype ida_VatolSMallocDone; booleantype ida_SatolSMallocDone; booleantype ida_sensMallocDone; booleantype ida_VatolQSMallocDone; booleantype ida_SatolQSMallocDone; booleantype ida_quadSensMallocDone; /*------------------ Linear Solver Data ------------------*/ /* Linear Solver functions to be called */ int (*ida_linit)(struct IDAMemRec *idamem); int (*ida_lsetup)(struct IDAMemRec *idamem, N_Vector yyp, N_Vector ypp, N_Vector resp, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); int (*ida_lsolve)(struct IDAMemRec *idamem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rescur); int (*ida_lperf)(struct IDAMemRec *idamem, int perftask); int (*ida_lfree)(struct IDAMemRec *idamem); /* Linear Solver specific memory */ void *ida_lmem; /* Flag to request a call to the setup routine */ booleantype ida_forceSetup; /* Flag to indicate successful ida_linit call */ booleantype ida_linitOK; /*------------ Saved Values ------------*/ booleantype ida_setupNonNull; /* Does setup do something? */ booleantype ida_constraintsSet; /* constraints vector present */ booleantype ida_suppressalg; /* TRUE if suppressing algebraic vars. in local error tests */ int ida_kused; /* method order used on last successful step */ realtype ida_h0u; /* actual initial stepsize */ realtype ida_hused; /* step size used on last successful step */ realtype ida_tolsf; /* tolerance scale factor (saved value) */ /*---------------- Rootfinding Data ----------------*/ IDARootFn ida_gfun; /* Function g for roots sought */ int ida_nrtfn; /* number of components of g */ int *ida_iroots; /* array for root information */ int *ida_rootdir; /* array specifying direction of zero-crossing */ realtype ida_tlo; /* nearest endpoint of interval in root search */ realtype ida_thi; /* farthest endpoint of interval in root search */ realtype ida_trout; /* t return value from rootfinder routine */ realtype *ida_glo; /* saved array of g values at t = tlo */ realtype *ida_ghi; /* saved array of g values at t = thi */ realtype *ida_grout; /* array of g values at t = trout */ realtype ida_toutc; /* copy of tout (if NORMAL mode) */ realtype ida_ttol; /* tolerance on root location */ int ida_taskc; /* copy of parameter itask */ int ida_irfnd; /* flag showing whether last step had a root */ long int ida_nge; /* counter for g evaluations */ booleantype *ida_gactive; /* array with active/inactive event functions */ int ida_mxgnull; /* number of warning messages about possible g==0 */ /*------------------------ Adjoint sensitivity data ------------------------*/ booleantype ida_adj; /* TRUE if performing ASA */ struct IDAadjMemRec *ida_adj_mem; /* Pointer to adjoint memory structure */ booleantype ida_adjMallocDone; } *IDAMem; /* * ================================================================= * A D J O I N T M O D U L E M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Forward references for pointers to various structures * ----------------------------------------------------------------- */ typedef struct IDAadjMemRec *IDAadjMem; typedef struct CkpntMemRec *CkpntMem; typedef struct DtpntMemRec *DtpntMem; typedef struct IDABMemRec *IDABMem; /* * ----------------------------------------------------------------- * Types for functions provided by an interpolation module * ----------------------------------------------------------------- * IDAAMMallocFn: Type for a function that initializes the content * field of the structures in the dt array * IDAAMFreeFn: Type for a function that deallocates the content * field of the structures in the dt array * IDAAGetYFn: Function type for a function that returns the * interpolated forward solution. * IDAAStorePnt: Function type for a function that stores a new * point in the structure d * ----------------------------------------------------------------- */ typedef booleantype (*IDAAMMallocFn)(IDAMem IDA_mem); typedef void (*IDAAMFreeFn)(IDAMem IDA_mem); typedef int (*IDAAGetYFn)(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); typedef int (*IDAAStorePntFn)(IDAMem IDA_mem, DtpntMem d); /* * ----------------------------------------------------------------- * Types : struct CkpntMemRec, CkpntMem * ----------------------------------------------------------------- * The type CkpntMem is type pointer to struct CkpntMemRec. * This structure contains fields to store all information at a * check point that is needed to 'hot' start IDAS. * ----------------------------------------------------------------- */ struct CkpntMemRec { /* Integration limits */ realtype ck_t0; realtype ck_t1; /* Modified divided difference array */ N_Vector ck_phi[MXORDP1]; /* Do we need to carry quadratures? */ booleantype ck_quadr; /* Modified divided difference array for quadratures */ N_Vector ck_phiQ[MXORDP1]; /* Do we need to carry sensitivities? */ booleantype ck_sensi; /* number of sensitivities */ int ck_Ns; /* Modified divided difference array for sensitivities */ N_Vector *ck_phiS[MXORDP1]; /* Do we need to carry quadrature sensitivities? */ booleantype ck_quadr_sensi; /* Modified divided difference array for quadrature sensitivities */ N_Vector *ck_phiQS[MXORDP1]; /* Step data */ long int ck_nst; realtype ck_tretlast; long int ck_ns; int ck_kk; int ck_kused; int ck_knew; int ck_phase; realtype ck_hh; realtype ck_hused; realtype ck_rr; realtype ck_cj; realtype ck_cjlast; realtype ck_cjold; realtype ck_cjratio; realtype ck_ss; realtype ck_ssS; realtype ck_psi[MXORDP1]; realtype ck_alpha[MXORDP1]; realtype ck_beta[MXORDP1]; realtype ck_sigma[MXORDP1]; realtype ck_gamma[MXORDP1]; /* How many phi, phiS, phiQ and phiQS were allocated? */ int ck_phi_alloc; /* Pointer to next structure in list */ struct CkpntMemRec *ck_next; }; /* * ----------------------------------------------------------------- * Type : struct DtpntMemRec * ----------------------------------------------------------------- * This structure contains fields to store all information at a * data point that is needed to interpolate solution of forward * simulations. Its content field is interpType-dependent. * ----------------------------------------------------------------- */ struct DtpntMemRec { realtype t; /* time */ void *content; /* interpType-dependent content */ }; /* Data for cubic Hermite interpolation */ typedef struct HermiteDataMemRec { N_Vector y; N_Vector yd; N_Vector *yS; N_Vector *ySd; } *HermiteDataMem; /* Data for polynomial interpolation */ typedef struct PolynomialDataMemRec { N_Vector y; N_Vector *yS; /* yd and ySd store the derivative(s) only for the first dt point. NULL otherwise. */ N_Vector yd; N_Vector *ySd; int order; } *PolynomialDataMem; /* * ----------------------------------------------------------------- * Type : struct IDABMemRec * ----------------------------------------------------------------- * The type IDABMemRec is a pointer to a structure which stores all * information for ONE backward problem. * The IDAadjMem struct contains a linked list of IDABMem pointers * ----------------------------------------------------------------- */ struct IDABMemRec { /* Index of this backward problem */ int ida_index; /* Time at which the backward problem is initialized. */ realtype ida_t0; /* Memory for this backward problem */ IDAMem IDA_mem; /* Flags to indicate that this backward problem's RHS or quad RHS * require forward sensitivities */ booleantype ida_res_withSensi; booleantype ida_rhsQ_withSensi; /* Residual function for backward run */ IDAResFnB ida_res; IDAResFnBS ida_resS; /* Right hand side quadrature function (fQB) for backward run */ IDAQuadRhsFnB ida_rhsQ; IDAQuadRhsFnBS ida_rhsQS; /* User user_data */ void *ida_user_data; /* Linear solver's data and functions */ /* Memory block for a linear solver's interface to IDAA */ void *ida_lmem; /* Function to free any memory allocated by the linear solver */ void (*ida_lfree)(IDABMem IDAB_mem); /* Memory block for a preconditioner's module interface to IDAA */ void *ida_pmem; /* Function to free any memory allocated by the preconditioner module */ void (*ida_pfree)(IDABMem IDAB_mem); /* Time at which to extract solution / quadratures */ realtype ida_tout; /* Workspace Nvectors */ N_Vector ida_yy; N_Vector ida_yp; /* Link to next structure in list. */ struct IDABMemRec *ida_next; }; /* * ----------------------------------------------------------------- * Type : struct IDAadjMemRec * ----------------------------------------------------------------- * The type IDAadjMem is type pointer to struct IDAadjMemRec. * This structure contins fields to store all information * necessary for adjoint sensitivity analysis. * ----------------------------------------------------------------- */ struct IDAadjMemRec { /* -------------------- * Forward problem data * -------------------- */ /* Integration interval */ realtype ia_tinitial, ia_tfinal; /* Flag for first call to IDASolveF */ booleantype ia_firstIDAFcall; /* Flag if IDASolveF was called with TSTOP */ booleantype ia_tstopIDAFcall; realtype ia_tstopIDAF; /* ---------------------- * Backward problems data * ---------------------- */ /* Storage for backward problems */ struct IDABMemRec *IDAB_mem; /* Number of backward problems. */ int ia_nbckpbs; /* Address of current backward problem (iterator). */ struct IDABMemRec *ia_bckpbCrt; /* Flag for first call to IDASolveB */ booleantype ia_firstIDABcall; /* ---------------- * Check point data * ---------------- */ /* Storage for check point information */ struct CkpntMemRec *ck_mem; /* address of the check point structure for which data is available */ struct CkpntMemRec *ia_ckpntData; /* Number of checkpoints. */ int ia_nckpnts; /* ------------------ * Interpolation data * ------------------ */ /* Number of steps between 2 check points */ long int ia_nsteps; /* Storage for data from forward runs */ struct DtpntMemRec **dt_mem; /* Actual number of data points saved in current dt_mem */ /* Commonly, np = nsteps+1 */ long int ia_np; /* Interpolation type */ int ia_interpType; /* Functions set by the interpolation module */ IDAAStorePntFn ia_storePnt; /* store a new interpolation point */ IDAAGetYFn ia_getY; /* interpolate forward solution */ IDAAMMallocFn ia_malloc; /* allocate new data point */ IDAAMFreeFn ia_free; /* destroys data point */ /* Flags controlling the interpolation module */ booleantype ia_mallocDone; /* IM initialized? */ booleantype ia_newData; /* new data available in dt_mem? */ booleantype ia_storeSensi; /* store sensitivities? */ booleantype ia_interpSensi; /* interpolate sensitivities? */ booleantype ia_noInterp; /* interpolations are temporarly */ /* disabled ( IDACalcICB ) */ /* Workspace for polynomial interpolation */ N_Vector ia_Y[MXORDP1]; /* pointers phi[i] */ N_Vector *ia_YS[MXORDP1]; /* pointers phiS[i] */ realtype ia_T[MXORDP1]; /* Workspace for wrapper functions */ N_Vector ia_yyTmp, ia_ypTmp; N_Vector *ia_yySTmp, *ia_ypSTmp; }; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * int (*ida_linit)(IDAMem IDA_mem); * ----------------------------------------------------------------- * The purpose of ida_linit is to allocate memory for the * solver-specific fields in the structure *(idamem->ida_lmem) and * perform any needed initializations of solver-specific memory, * such as counters/statistics. An (*ida_linit) should return * 0 if it has successfully initialized the IDA linear solver and * a non-zero value otherwise. If an error does occur, an * appropriate message should be issued. * ---------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsetup)(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, * N_Vector resp, * N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); * ----------------------------------------------------------------- * The job of ida_lsetup is to prepare the linear solver for * subsequent calls to ida_lsolve. Its parameters are as follows: * * idamem - problem memory pointer of type IDAMem. See the big * typedef earlier in this file. * * * yyp - the predicted y vector for the current IDA internal * step. * * ypp - the predicted y' vector for the current IDA internal * step. * * resp - F(tn, yyp, ypp). * * tempv1, tempv2, tempv3 - temporary N_Vectors provided for use * by ida_lsetup. * * The ida_lsetup routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsolve)(IDAMem IDA_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector ypcur, N_Vector rescur); * ----------------------------------------------------------------- * ida_lsolve must solve the linear equation P x = b, where * P is some approximation to the system Jacobian * J = (dF/dy) + cj (dF/dy') * evaluated at (tn,ycur,ypcur) and the RHS vector b is input. * The N-vector ycur contains the solver's current approximation * to y(tn), ypcur contains that for y'(tn), and the vector rescur * contains the N-vector residual F(tn,ycur,ypcur). * The solution is to be returned in the vector b. * * The ida_lsolve routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lperf)(IDAMem IDA_mem, int perftask); * ----------------------------------------------------------------- * ida_lperf is called two places in IDAS where linear solver * performance data is required by IDAS. For perftask = 0, an * initialization of performance variables is performed, while for * perftask = 1, the performance is evaluated. * ----------------------------------------------------------------- */ /* * ================================================================= * I D A S I N T E R N A L F U N C T I O N S * ================================================================= */ /* Prototype of internal ewtSet function */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* Prototype for internal sensitivity residual DQ function */ int IDASensResDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp); /* * ================================================================= * I D A S E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg, " #define MSG_TIME_H "t = %Lg and h = %Lg, " #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg, " #define MSG_TIME_H "t = %lg and h = %lg, " #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g, " #define MSG_TIME_H "t = %g and h = %g, " #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* General errors */ #define MSG_MEM_FAIL "A memory request failed." #define MSG_NO_MEM "ida_mem = NULL illegal." #define MSG_NO_MALLOC "Attempt to call before IDAMalloc." #define MSG_BAD_NVECTOR "A required vector operation is not implemented." /* Initialization errors */ #define MSG_Y0_NULL "y0 = NULL illegal." #define MSG_YP0_NULL "yp0 = NULL illegal." #define MSG_BAD_ITOL "Illegal value for itol. The legal values are IDA_SS, IDA_SV, and IDA_WF." #define MSG_RES_NULL "res = NULL illegal." #define MSG_BAD_RTOL "rtol < 0 illegal." #define MSG_ATOL_NULL "atol = NULL illegal." #define MSG_BAD_ATOL "Some atol component < 0.0 illegal." #define MSG_ROOT_FUNC_NULL "g = NULL illegal." #define MSG_MISSING_ID "id = NULL but suppressalg option on." #define MSG_NO_TOLS "No integration tolerances have been specified." #define MSG_FAIL_EWT "The user-provide EwtSet function failed." #define MSG_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." #define MSG_BAD_ISM_CONSTR "Constraints can not be enforced while forward sensitivity is used with simultaneous method." #define MSG_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSG_LINIT_FAIL "The linear solver's init routine failed." #define MSG_NO_QUAD "Illegal attempt to call before calling IDAQuadInit." #define MSG_BAD_EWTQ "Initial ewtQ has component(s) equal to zero (illegal)." #define MSG_BAD_ITOLQ "Illegal value for itolQ. The legal values are IDA_SS and IDA_SV." #define MSG_NO_TOLQ "No integration tolerances for quadrature variables have been specified." #define MSG_NULL_ATOLQ "atolQ = NULL illegal." #define MSG_BAD_RTOLQ "rtolQ < 0 illegal." #define MSG_BAD_ATOLQ "atolQ has negative component(s) (illegal)." #define MSG_NO_SENSI "Illegal attempt to call before calling IDASensInit." #define MSG_BAD_EWTS "Initial ewtS has component(s) equal to zero (illegal)." #define MSG_BAD_ITOLS "Illegal value for itolS. The legal values are IDA_SS, IDA_SV, and IDA_EE." #define MSG_NULL_ATOLS "atolS = NULL illegal." #define MSG_BAD_RTOLS "rtolS < 0 illegal." #define MSG_BAD_ATOLS "atolS has negative component(s) (illegal)." #define MSG_BAD_PBAR "pbar has zero component(s) (illegal)." #define MSG_BAD_PLIST "plist has negative component(s) (illegal)." #define MSG_BAD_NS "NS <= 0 illegal." #define MSG_NULL_YYS0 "yyS0 = NULL illegal." #define MSG_NULL_YPS0 "ypS0 = NULL illegal." #define MSG_BAD_ISM "Illegal value for ism. Legal values are: IDA_SIMULTANEOUS and IDA_STAGGERED." #define MSG_BAD_IS "Illegal value for is." #define MSG_NULL_DKYA "dkyA = NULL illegal." #define MSG_BAD_DQTYPE "Illegal value for DQtype. Legal values are: IDA_CENTERED and IDA_FORWARD." #define MSG_BAD_DQRHO "DQrhomax < 0 illegal." #define MSG_NULL_ABSTOLQS "abstolQS = NULL illegal parameter." #define MSG_BAD_RELTOLQS "reltolQS < 0 illegal parameter." #define MSG_BAD_ABSTOLQS "abstolQS has negative component(s) (illegal)." #define MSG_NO_QUADSENSI "Forward sensitivity analysis for quadrature variables was not activated." #define MSG_NULL_YQS0 "yQS0 = NULL illegal parameter." /* IDACalcIC error messages */ #define MSG_IC_BAD_ICOPT "icopt has an illegal value." #define MSG_IC_MISSING_ID "id = NULL conflicts with icopt." #define MSG_IC_TOO_CLOSE "tout1 too close to t0 to attempt initial condition calculation." #define MSG_IC_BAD_ID "id has illegal values." #define MSG_IC_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_IC_RES_NONREC "The residual function failed unrecoverably. " #define MSG_IC_RES_FAIL "The residual function failed at the first call. " #define MSG_IC_SETUP_FAIL "The linear solver setup failed unrecoverably." #define MSG_IC_SOLVE_FAIL "The linear solver solve failed unrecoverably." #define MSG_IC_NO_RECOVERY "The residual routine or the linear setup or solve routine had a recoverable error, but IDACalcIC was unable to recover." #define MSG_IC_FAIL_CONSTR "Unable to satisfy the inequality constraints." #define MSG_IC_FAILED_LINS "The linesearch algorithm failed with too small a step." #define MSG_IC_CONV_FAILED "Newton/Linesearch algorithm failed to converge." /* IDASolve error messages */ #define MSG_YRET_NULL "yret = NULL illegal." #define MSG_YPRET_NULL "ypret = NULL illegal." #define MSG_TRET_NULL "tret = NULL illegal." #define MSG_BAD_ITASK "itask has an illegal value." #define MSG_TOO_CLOSE "tout too close to t0 to start integration." #define MSG_BAD_HINIT "Initial step is not towards tout." #define MSG_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME "in the direction of integration." #define MSG_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSG_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSG_EWT_NOW_FAIL "At " MSG_TIME "the user-provide EwtSet function failed." #define MSG_EWT_NOW_BAD "At " MSG_TIME "some ewt component has become <= 0.0." #define MSG_TOO_MUCH_ACC "At " MSG_TIME "too much accuracy requested." #define MSG_BAD_T "Illegal value for t. " MSG_TIME_INT #define MSG_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration." #define MSG_BAD_K "Illegal value for k." #define MSG_NULL_DKY "dky = NULL illegal." #define MSG_NULL_DKYP "dkyp = NULL illegal." #define MSG_ERR_FAILS "At " MSG_TIME_H "the error test failed repeatedly or with |h| = hmin." #define MSG_CONV_FAILS "At " MSG_TIME_H "the corrector convergence failed repeatedly or with |h| = hmin." #define MSG_SETUP_FAILED "At " MSG_TIME "the linear solver setup failed unrecoverably." #define MSG_SOLVE_FAILED "At " MSG_TIME "the linear solver solve failed unrecoverably." #define MSG_REP_RES_ERR "At " MSG_TIME "repeated recoverable residual errors." #define MSG_RES_NONRECOV "At " MSG_TIME "the residual function failed unrecoverably." #define MSG_FAILED_CONSTR "At " MSG_TIME "unable to satisfy inequality constraints." #define MSG_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSG_NO_ROOT "Rootfinding was not initialized." #define MSG_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." #define MSG_EWTQ_NOW_BAD "At " MSG_TIME ", a component of ewtQ has become <= 0." #define MSG_QRHSFUNC_FAILED "At " MSG_TIME ", the quadrature right-hand side routine failed in an unrecoverable manner." #define MSG_QRHSFUNC_UNREC "At " MSG_TIME ", the quadrature right-hand side failed in a recoverable manner, but no recovery is possible." #define MSG_QRHSFUNC_REPTD "At " MSG_TIME "repeated recoverable quadrature right-hand side function errors." #define MSG_QRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." #define MSG_NULL_P "p = NULL when using internal DQ for sensitivity residual is illegal." #define MSG_EWTS_NOW_BAD "At " MSG_TIME ", a component of ewtS has become <= 0." #define MSG_SRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity residual routine failed in an unrecoverable manner." #define MSG_SRHSFUNC_UNREC "At " MSG_TIME ", the sensitivity residual failed in a recoverable manner, but no recovery is possible." #define MSG_SRHSFUNC_REPTD "At " MSG_TIME "repeated recoverable sensitivity residual function errors." #define MSG_NO_TOLQS "No integration tolerances for quadrature sensitivity variables have been specified." #define MSG_NULL_RHSQ "IDAS is expected to use DQ to evaluate the RHS of quad. sensi., but quadratures were not initialized." #define MSG_BAD_EWTQS "Initial ewtQS has component(s) equal to zero (illegal)." #define MSG_EWTQS_NOW_BAD "At " MSG_TIME ", a component of ewtQS has become <= 0." #define MSG_QSRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity quadrature right-hand side routine failed in an unrecoverable manner." #define MSG_QSRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." /* IDASet* / IDAGet* error messages */ #define MSG_NEG_MAXORD "maxord<=0 illegal." #define MSG_BAD_MAXORD "Illegal attempt to increase maximum order." #define MSG_NEG_HMAX "hmax < 0 illegal." #define MSG_NEG_EPCON "epcon <= 0.0 illegal." #define MSG_BAD_CONSTR "Illegal values in constraints vector." #define MSG_BAD_EPICCON "epiccon <= 0.0 illegal." #define MSG_BAD_MAXNH "maxnh <= 0 illegal." #define MSG_BAD_MAXNJ "maxnj <= 0 illegal." #define MSG_BAD_MAXNIT "maxnit <= 0 illegal." #define MSG_BAD_STEPTOL "steptol <= 0.0 illegal." #define MSG_TOO_LATE "IDAGetConsistentIC can only be called before IDASolve." /* * ================================================================= * I D A A E R R O R M E S S A G E S * ================================================================= */ #define MSGAM_NULL_IDAMEM "ida_mem = NULL illegal." #define MSGAM_NO_ADJ "Illegal attempt to call before calling IDAadjInit." #define MSGAM_BAD_INTERP "Illegal value for interp." #define MSGAM_BAD_STEPS "Steps nonpositive illegal." #define MSGAM_BAD_WHICH "Illegal value for which." #define MSGAM_NO_BCK "No backward problems have been defined yet." #define MSGAM_NO_FWD "Illegal attempt to call before calling IDASolveF." #define MSGAM_BAD_TB0 "The initial time tB0 is outside the interval over which the forward problem was solved." #define MSGAM_BAD_SENSI "At least one backward problem requires sensitivities, but they were not stored for interpolation." #define MSGAM_BAD_ITASKB "Illegal value for itaskB. Legal values are IDA_NORMAL and IDA_ONE_STEP." #define MSGAM_BAD_TBOUT "The final time tBout is outside the interval over which the forward problem was solved." #define MSGAM_BACK_ERROR "Error occured while integrating backward problem # %d" #define MSGAM_BAD_TINTERP "Bad t = %g for interpolation." #define MSGAM_BAD_T "Bad t for interpolation." #define MSGAM_WRONG_INTERP "This function cannot be called for the specified interp type." #define MSGAM_MEM_FAIL "A memory request failed." #define MSGAM_NO_INITBS "Illegal attempt to call before calling IDAInitBS." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/idas/LICENSE0000600000175000017500000000545411741421242016734 0ustar sylvestresylvestreCopyright (c) 2006, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by Radu Serban. UCRL-CODE-000000 All rights reserved. This file is part of IDAS. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/src/idas/idas_spgmr.c0000600000175000017500000004146511741421242020225 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2011/05/25 20:46:33 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the implementation file for the IDAS Scaled * Preconditioned GMRES linear solver module, IDASPGMR. * ----------------------------------------------------------------- */ #include #include #include #include "idas_spils_impl.h" #include "idas_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPGMR linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASpgmrInit(IDAMem IDA_mem); static int IDASpgmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASpgmrPerf(IDAMem IDA_mem, int perftask); static int IDASpgmrFree(IDAMem IDA_mem); /* IDASPGMR lfreeB function */ static void IDASpgmrFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * IDASpgmr * ----------------------------------------------------------------- * * This routine initializes the memory record and sets various function * fields specific to the IDASPGMR linear solver module. * * IDASpgmr first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASpgmrInit, IDASpgmrSetup, * IDASpgmrSolve, IDASpgmrPerf, and IDASpgmrFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then various fields in the * IDASpilsMemRec structure. Finally, IDASpgmr allocates memory for * ytemp, yptemp, and xx, and calls SpgmrMalloc to allocate memory * for the Spgmr solver. * * The return value of IDASpgmr is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory allocation failed * IDASPILS_ILL_INPUT = -2 if the gstype argument is illegal. * * ----------------------------------------------------------------- */ int IDASpgmr(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPGMR", "IDASpgmr", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if(vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPGMR", "IDASpgmr", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASpgmrInit; lsetup = IDASpgmrSetup; lsolve = IDASpgmrSolve; lperf = IDASpgmrPerf; lfree = IDASpgmrFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPGMR; /* Set SPGMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Spgmr parameters */ idaspils_mem->s_gstype = MODIFIED_GS; idaspils_mem->s_maxrs = IDA_SPILS_MAXRS; idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); /* Call SpgmrMalloc to allocate workspace for Spgmr */ spgmr_mem = NULL; spgmr_mem = SpgmrMalloc(maxl1, vec_tmpl); if (spgmr_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPGMR memory to spils memory structure */ spils_mem = (void *)spgmr_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPGMR interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define gstype (idaspils_mem->s_gstype) #define maxl (idaspils_mem->s_maxl) #define maxrs (idaspils_mem->s_maxrs) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASpgmrInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } last_flag = IDASPILS_SUCCESS; return(0); } static int IDASpgmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe. */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; /* Return flag showing success or failure of pset. */ if (retval < 0) { IDAProcessError(IDA_mem, SPGMR_PSET_FAIL_UNREC, "IDASPGMR", "IDASpgmrSetup", MSGS_PSET_FAILED); last_flag = SPGMR_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPGMR_PSET_FAIL_REC; return(+1); } last_flag = SPGMR_SUCCESS; return(0); } /* * The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SpgmrSolve. * We copy the solution x into b, and update the counters nli, nps, ncfl. * If SpgmrSolve returned nli_inc = 0 (hence x = 0), we take the SPGMR * vtemp vector (= P_inverse F) as the correction vector instead. * Finally, we set the return value according to the success of SpgmrSolve. */ static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; /* Set SpgmrSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the GMRES convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SpgmrSolve inputs pretype and initial guess xx = 0. */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SpgmrSolve and copy xx to bb. */ retval = SpgmrSolve(spgmr_mem, IDA_mem, xx, bb, pretype, gstype, epslin, maxrs, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); if (nli_inc == 0) N_VScale(ONE, SPGMR_VTEMP(spgmr_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful. */ nli += nli_inc; nps += nps_inc; if (retval != SPGMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPGMR_SUCCESS: return(0); break; case SPGMR_RES_REDUCED: return(1); break; case SPGMR_CONV_FAIL: return(1); break; case SPGMR_QRFACT_FAIL: return(1); break; case SPGMR_PSOLVE_FAIL_REC: return(1); break; case SPGMR_ATIMES_FAIL_REC: return(1); break; case SPGMR_MEM_NULL: return(-1); break; case SPGMR_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPGMR_ATIMES_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPGMR_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPGMR_PSOLVE_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; case SPGMR_GS_FAIL: return(-1); break; case SPGMR_QRSOL_FAIL: return(-1); break; } return(0); } /* * This routine handles performance monitoring specific to the IDASPGMR * linear solver. When perftask = 0, it saves values of various counters. * When perftask = 1, it examines difference quotients in these counters, * and depending on their values, it prints up to three warning messages. * Messages are printed up to a maximum of 10 times. */ static int IDASpgmrPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl )); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASpgmrFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); spgmr_mem = (SpgmrMem) spils_mem; SpgmrFree(spgmr_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * IDASpgmrB * * Wrapper for the backward phase * */ int IDASpgmrB(void *ida_mem, int which, int maxlB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDASpilsMemB idaspilsB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPGMR", "IDASpbcgB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASPGMR", "IDASpgmrB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPGMR", "IDASpgmrB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Get memory for IDASpilsMemRecB */ idaspilsB_mem = NULL; idaspilsB_mem = (IDASpilsMemB) malloc(sizeof(struct IDASpilsMemRecB)); if (idaspilsB_mem == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmrB", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } idaspilsB_mem->s_psetB = NULL; idaspilsB_mem->s_psolveB = NULL; idaspilsB_mem->s_P_dataB = NULL; /* initialize Jacobian function */ idaspilsB_mem->s_jtimesB = NULL; /* attach lmem and lfree */ IDAB_mem->ida_lmem = idaspilsB_mem; IDAB_mem->ida_lfree = IDASpgmrFreeB; flag = IDASpgmr(IDAB_mem->IDA_mem, maxlB); if (flag != IDASPILS_SUCCESS) { free(idaspilsB_mem); idaspilsB_mem = NULL; } return(flag); } /* * IDASpgmrFreeB */ static void IDASpgmrFreeB(IDABMem IDAB_mem) { IDASpilsMemB idaspilsB_mem; idaspilsB_mem = (IDASpilsMemB) IDAB_mem->ida_lmem; free(idaspilsB_mem); } sundials-2.5.0/src/idas/idas_lapack.c0000600000175000017500000004146511741421242020330 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2011/03/23 23:25:35 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a IDAS dense linear solver * using BLAS and LAPACK functions. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include "idas_direct_impl.h" #include "idas_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* IDALAPACK DENSE linit, lsetup, lsolve, and lfree routines */ static int idaLapackDenseInit(IDAMem IDA_mem); static int idaLapackDenseSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC); static int idaLapackDenseFree(IDAMem IDA_mem); /* IDALAPACK BAND linit, lsetup, lsolve, and lfree routines */ static int idaLapackBandInit(IDAMem IDA_mem); static int idaLapackBandSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC); static int idaLapackBandFree(IDAMem IDA_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define res (IDA_mem->ida_res) #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lfree (IDA_mem->ida_lfree) #define lperf (IDA_mem->ida_lperf) #define lmem (IDA_mem->ida_lmem) #define tempv (IDA_mem->ida_tempv1) #define setupNonNull (IDA_mem->ida_setupNonNull) #define mtype (idadls_mem->d_type) #define n (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define smu (idadls_mem->d_smu) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define bjac (idadls_mem->d_bjac) #define JJ (idadls_mem->d_J) #define pivots (idadls_mem->d_pivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define J_data (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDALapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. IDALapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem) * to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve, * and idaLapackDenseFree, respectively. It allocates memory for a * structure of type IDADlsMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to TRUE, and the d_jac field to the default * idaLapackDenseDQJac. Finally, it allocates memory for M, pivots. * * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int IDALapackDense(void *ida_mem, int N) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASLAPACK", "IDALapackDense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the LAPACK solver */ if (tempv->ops->nvgetarraypointer == NULL || tempv->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASLAPACK", "IDALapackDense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree !=NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackDenseInit; lsetup = idaLapackDenseSetup; lsolve = idaLapackDenseSolve; lperf = NULL; lfree = idaLapackDenseFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackDense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for JJ and pivot array */ JJ = NULL; pivots = NULL; JJ = NewDenseMat(n, n); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackDense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackDense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDALapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem) * to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve, * and idaLapackBandFree, respectively. It allocates memory for a * structure of type IDALapackBandMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and * the jacE and jacI field to NULL. * Finally, it allocates memory for M and pivots. * The IDALapackBand return value is IDADLS_SUCCESS = 0, * IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2. * * NOTE: The IDALAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int IDALapackBand(void *ida_mem, int N, int mupper, int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASLAPACK", "IDALapackBand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (tempv->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASLAPACK", "IDALapackBand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackBandInit; lsetup = idaLapackBandSetup; lsolve = idaLapackBandSolve; lperf = NULL; lfree = idaLapackBandFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackBand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwiths in idadls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASLAPACK", "IDALapackBand", MSGD_BAD_SIZES); free(idadls_mem); idadls_mem = NULL; return(IDADLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for JJ and pivot arrays */ JJ = NULL; pivots = NULL; JJ = NewBandMat(n, mu, ml, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackBand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASLAPACK", "IDALapackBand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS * ================================================================= */ /* * idaLapackDenseInit does remaining initializations specific to the dense * linear solver. */ static int idaLapackDenseInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { djac = idaDlsDenseDQJac; J_data = IDA_mem; } else { J_data = IDA_mem->ida_user_data; } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackDenseSetup does the setup operations for the dense linear solver. * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', * updates counters, and calls the dense LU factorization routine. */ static int idaLapackDenseSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { IDADlsMem idadls_mem; int ier, retval; int intn; idadls_mem = (IDADlsMem) lmem; intn = (int) n; /* Call Jacobian function */ nje++; SetToZero(JJ); retval = djac(n, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASLAPACK", "idaLapackDenseSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(1); } /* Do LU factorization of M */ dgetrf_f77(&intn, &intn, JJ->data, &intn, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * idaLapackDenseSolve handles the solve operation for the dense linear solver * by calling the dense backsolve routine. */ static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC) { IDADlsMem idadls_mem; realtype *bd, fact; int ier, one = 1; int intn; idadls_mem = (IDADlsMem) lmem; intn = (int) n; bd = N_VGetArrayPointer(b); dgetrs_f77("N", &intn, &one, JJ->data, &intn, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) { fact = TWO/(ONE + cjratio); dscal_f77(&intn, &fact, bd, &one); } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackDenseFree frees memory specific to the dense linear solver. */ static int idaLapackDenseFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(pivots); free(idadls_mem); idadls_mem = NULL; return(0); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS * ================================================================= */ /* * idaLapackBandInit does remaining initializations specific to the band * linear solver. */ static int idaLapackBandInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { bjac = idaDlsBandDQJac; J_data = IDA_mem; } else { J_data = IDA_mem->ida_user_data; } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackBandSetup does the setup operations for the band linear solver. * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', * updates counters, and calls the band LU factorization routine. */ static int idaLapackBandSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { IDADlsMem idadls_mem; int ier, retval; int intn, iml, imu, ldmat; idadls_mem = (IDADlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = JJ->ldim; /* Call Jacobian function */ nje++; SetToZero(JJ); retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASLAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of M */ dgbtrf_f77(&intn, &intn, &iml, &imu, JJ->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * idaLapackBandSolve handles the solve operation for the band linear solver * by calling the band backsolve routine. */ static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC) { IDADlsMem idadls_mem; realtype *bd, fact; int ier, one = 1; int intn, iml, imu, ldmat; idadls_mem = (IDADlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = JJ->ldim; bd = N_VGetArrayPointer(b); dgbtrs_f77("N", &intn, &iml, &imu, &one, JJ->data, &ldmat, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in cj */ if (cjratio != ONE) { fact = TWO/(ONE + cjratio); dscal_f77(&intn, &fact, bd, &one); } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackBandFree frees memory specific to the band linear solver. */ static int idaLapackBandFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(pivots); free(idadls_mem); idadls_mem = NULL; return(0); } sundials-2.5.0/src/idas/idas_direct.c0000600000175000017500000005656111741421242020352 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:39:19 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for an IDASDLS linear solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "idas_impl.h" #include "idas_direct_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ static int idaDlsDenseJacBWrapper(long int NeqB, realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rBr, DlsMat JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int idaDlsBandJacBWrapper(long int NeqB, long int mupperB, long int mlowerB, realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define uround (IDA_mem->ida_uround) #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lfree (IDA_mem->ida_lfree) #define lperf (IDA_mem->ida_lperf) #define lmem (IDA_mem->ida_lmem) #define tempv (IDA_mem->ida_tempv1) #define setupNonNull (IDA_mem->ida_setupNonNull) #define mtype (idadls_mem->d_type) #define n (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define smu (idadls_mem->d_smu) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define bjac (idadls_mem->d_bjac) #define M (idadls_mem->d_J) #define pivots (idadls_mem->d_pivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define last_flag (idadls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION * ================================================================= */ /* * IDADlsSetDenseJacFn specifies the dense Jacobian function. */ int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsSetDenseJacFn", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsSetDenseJacFn", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; djac = jac; } else { jacDQ = TRUE; } return(IDADLS_SUCCESS); } /* * IDADlsSetBandJacFn specifies the band Jacobian function. */ int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsSetBandJacFn", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsSetBandJacFn", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; bjac = jac; } else { jacDQ = TRUE; } return(IDADLS_SUCCESS); } /* * IDADlsGetWorkSpace returns the length of workspace allocated for the * IDALAPACK linear solver. */ int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsGetWorkSpace", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsGetWorkSpace", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (mtype == SUNDIALS_DENSE) { *lenrwLS = n*n; *leniwLS = n; } else if (mtype == SUNDIALS_BAND) { *lenrwLS = n*(smu + ml + 1); *leniwLS = n; } return(IDADLS_SUCCESS); } /* * IDADlsGetNumJacEvals returns the number of Jacobian evaluations. */ int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsGetNumJacEvals", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsGetNumJacEvals", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *njevals = nje; return(IDADLS_SUCCESS); } /* * IDADlsGetNumResEvals returns the number of calls to the DAE function * needed for the DQ Jacobian approximation. */ int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsGetNumFctEvals", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsGetNumFctEvals", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *nrevalsLS = nreDQ; return(IDADLS_SUCCESS); } /* * IDADlsGetReturnFlagName returns the name associated with a IDALAPACK * return value. */ char *IDADlsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case IDADLS_SUCCESS: sprintf(name,"IDADLS_SUCCESS"); break; case IDADLS_MEM_NULL: sprintf(name,"IDADLS_MEM_NULL"); break; case IDADLS_LMEM_NULL: sprintf(name,"IDADLS_LMEM_NULL"); break; case IDADLS_ILL_INPUT: sprintf(name,"IDADLS_ILL_INPUT"); break; case IDADLS_MEM_FAIL: sprintf(name,"IDADLS_MEM_FAIL"); break; case IDADLS_JACFUNC_UNRECVR: sprintf(name,"IDADLS_JACFUNC_UNRECVR"); break; case IDADLS_JACFUNC_RECVR: sprintf(name,"IDADLS_JACFUNC_RECVR"); break; default: sprintf(name,"NONE"); } return(name); } /* * IDADlsGetLastFlag returns the last flag set in a IDALAPACK function. */ int IDADlsGetLastFlag(void *ida_mem, long int *flag) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsGetLastFlag", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDASDLS", "IDADlsGetLastFlag", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *flag = last_flag; return(IDADLS_SUCCESS); } /* * ================================================================= * DQ JACOBIAN APPROXIMATIONS * ================================================================= */ /* * ----------------------------------------------------------------- * idaDlsDenseDQJac * ----------------------------------------------------------------- * This routine generates a dense difference quotient approximation to * the Jacobian F_y + c_j*F_y'. It assumes that a dense matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of J is obtained via * the macro LAPACK_DENSE_COL and this pointer is associated with an N_Vector * using the N_VGetArrayPointer/N_VSetArrayPointer functions. * Finally, the actual computation of the jth column of the Jacobian is * done with a call to N_VLinearSum. * ----------------------------------------------------------------- */ int idaDlsDenseDQJac(long int N, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj; realtype *tmp2_data, *y_data, *yp_data, *ewt_data, *cns_data = NULL; N_Vector rtemp, jthCol; long int j; int retval = 0; IDAMem IDA_mem; IDADlsMem idadls_mem; /* data points to IDA_mem */ IDA_mem = (IDAMem) data; idadls_mem = (IDADlsMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ rtemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for ewt, yy, yp. */ ewt_data = N_VGetArrayPointer(ewt); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); if(constraints!=NULL) cns_data = N_VGetArrayPointer(constraints); srur = RSqrt(uround); for (j=0; j < N; j++) { /* Generate the jth col of J(tt,yy,yp) as delta(F)/delta(y_j). */ /* Set data address of jthCol, and save y_j and yp_j values. */ N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); yj = y_data[j]; ypj = yp_data[j]; /* Set increment inc to y_j based on sqrt(uround)*abs(y_j), with adjustments using yp_j and ewt_j if this is small, and a further adjustment to give it the same sign as hh*yp_j. */ inc = MAX( srur * MAX( ABS(yj), ABS(hh*ypj) ) , ONE/ewt_data[j] ); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if y_j has an inequality constraint. */ if (constraints != NULL) { conj = cns_data[j]; if (ABS(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment y_j and yp_j, call res, and break on error return. */ y_data[j] += inc; yp_data[j] += c_j*inc; retval = res(tt, yy, yp, rtemp, user_data); nreDQ++; if (retval != 0) break; /* Construct difference quotient in jthCol */ inc_inv = ONE/inc; N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); /* reset y_j, yp_j */ y_data[j] = yj; yp_data[j] = ypj; } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /* * ----------------------------------------------------------------- * idaDlsBandDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation JJ * to the DAE system Jacobian J. It assumes that a band matrix of type * BandMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of JJ is obtained via * the macros BAND_COL and BAND_COL_ELEM. The columns of the Jacobian are * constructed using mupper + mlower + 1 calls to the res routine, and * appropriate differencing. * The return value is either IDABAND_SUCCESS = 0, or the nonzero value returned * by the res routine, if any. */ int idaDlsBandDQJac(long int N, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; N_Vector rtemp, ytemp, yptemp; long int group, i, j, i1, i2, width, ngroups; int retval = 0; IDAMem IDA_mem; IDADlsMem idadls_mem; /* data points to IDA_mem */ IDA_mem = (IDAMem) data; idadls_mem = (IDADlsMem) lmem; rtemp = tmp1; /* Rename work vector for use as the perturbed residual. */ ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ yptemp= tmp3; /* Rename work vector for use as a temporary for yp. */ /* Obtain pointers to the data for all eight vectors used. */ ewt_data = N_VGetArrayPointer(ewt); r_data = N_VGetArrayPointer(rr); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rtemp_data = N_VGetArrayPointer(rtemp); ytemp_data = N_VGetArrayPointer(ytemp); yptemp_data = N_VGetArrayPointer(yptemp); if (constraints != NULL) cns_data = N_VGetArrayPointer(constraints); /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Compute miscellaneous values for the Jacobian computation. */ srur = RSqrt(uround); width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all yy[j] and yp[j] for j in this group. */ for (j=group-1; jia_yyTmp) #define ypTmp (IDAADJ_mem->ia_ypTmp) #define noInterp (IDAADJ_mem->ia_noInterp) /* * ----------------------------------------------------------------- * EXPORTED FUNCTIONS * ----------------------------------------------------------------- */ int IDADlsSetDenseJacFnB(void *ida_mem, int which, IDADlsDenseJacFnB jacB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; void *ida_memB; int flag; /* Is ida_mem allright? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsSetDenseJacFnB", MSGD_CAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASDLS", "IDADlsSetDenseJacFnB", MSGD_NO_ADJ); return(IDADLS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASDLS", "IDADlsSetDenseJacFnB", MSGD_BAD_WHICH); return(IDADLS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; if (IDAB_mem->ida_lmem == NULL) { IDAProcessError(IDAB_mem->IDA_mem, IDADLS_LMEMB_NULL, "IDASDLS", "IDADlsSetDenseJacFnB", MSGD_LMEMB_NULL); return(IDADLS_LMEMB_NULL); } idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; idadlsB_mem->d_djacB = jacB; if (jacB != NULL) { flag = IDADlsSetDenseJacFn(ida_memB, idaDlsDenseJacBWrapper); } else { flag = IDADlsSetDenseJacFn(ida_memB, NULL); } return(flag); } int IDADlsSetBandJacFnB(void *ida_mem, int which, IDADlsBandJacFnB jacB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; void *ida_memB; int flag; /* Is ida_mem allright? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsSetBandJacFnB", MSGD_CAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASDLS", "IDADlsSetBandJacFnB", MSGD_NO_ADJ); return(IDADLS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASDLS", "IDADlsSetBandJacFnB", MSGD_BAD_WHICH); return(IDADLS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; if (IDAB_mem->ida_lmem == NULL) { IDAProcessError(IDAB_mem->IDA_mem, IDADLS_LMEMB_NULL, "IDASDLS", "IDADlsSetBandJacFnB", MSGD_LMEMB_NULL); return(IDADLS_LMEMB_NULL); } idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; idadlsB_mem->d_bjacB = jacB; if (jacB != NULL) { flag = IDADlsSetBandJacFn(ida_memB, idaDlsBandJacBWrapper); } else { flag = IDADlsSetBandJacFn(ida_memB, NULL); } return(flag); } /* * ----------------------------------------------------------------- * PRIVATE INTERFACE FUNCTIONS * ----------------------------------------------------------------- */ /* * idaDlsDenseJacBWrapper * * This routine interfaces to the IDADenseJacFnB routine provided * by the user. idaDlsDenseJacBWrapper is of type IDADlsDenseJacFn. * NOTE: data actually contains ida_mem */ static int idaDlsDenseJacBWrapper(long int NeqB, realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get linear solver's data for this backward problem. */ idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; /* Forward solution from interpolation */ if (noInterp == FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASDLS", "idaDlsDenseJacWrapper", MSGD_BAD_T); return(-1); } } /* Call user's adjoint dense djacB routine */ flag = idadlsB_mem->d_djacB(NeqB, tt, c_jB, yyTmp, ypTmp, yyB, ypB, rrB, JacB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B); return(flag); } /* * idaDlsBandJacBWrapper * * This routine interfaces to the IDABandJacFnB routine provided * by the user. idaDlsBandJacBWrapper is of type IDADlsBandJacFn. * NOTE: data actually contains ida_mem */ static int idaDlsBandJacBWrapper(long int NeqB, long int mupperB, long int mlowerB, realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get linear solver's data for this backward problem. */ idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; /* Forward solution from interpolation */ if (noInterp == FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASDLS", "idaDlsBandJacWrapper", MSGD_BAD_T); return(-1); } } /* Call user's adjoint band bjacB routine */ flag = idadlsB_mem->d_bjacB(NeqB, mupperB, mlowerB, tt, c_jB, yyTmp, ypTmp, yyB, ypB, rrB, JacB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B); return(flag); } sundials-2.5.0/src/idas/idas_bbdpre_impl.h0000600000175000017500000000614411741421242021354 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:39:18 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file (private version) for the IDABBDPRE * module, for a band-block-diagonal preconditioner, i.e. a * block-diagonal matrix with banded blocks, for use with IDAS * and an IDASPILS linear solver. * ----------------------------------------------------------------- */ #ifndef _IDASBBDPRE_IMPL_H #define _IDASBBDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Definition of IBBDPrecData * ----------------------------------------------------------------- */ typedef struct IBBDPrecDataRec { /* passed by user to IDABBDPrecAlloc and used by IDABBDPrecSetup/IDABBDPrecSolve functions */ long int mudq, mldq, mukeep, mlkeep; realtype rel_yy; IDABBDLocalFn glocal; IDABBDCommFn gcomm; /* allocated for use by IDABBDPrecSetup */ N_Vector tempv4; /* set by IDABBDPrecon and used by IDABBDPrecSolve */ DlsMat PP; long int *lpivots; /* set by IDABBDPrecAlloc and used by IDABBDPrecSetup */ long int n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to ida_mem */ void *ida_mem; } *IBBDPrecData; /* * ----------------------------------------------------------------- * Type: IDABBDPrecDataB * ----------------------------------------------------------------- */ typedef struct IDABBDPrecDataRecB{ /* BBD user functions (glocB and cfnB) for backward run */ IDABBDLocalFnB glocalB; IDABBDCommFnB gcommB; /* BBD prec data */ /* //!void *bbd_dataB; */ } *IDABBDPrecDataB; /* * ----------------------------------------------------------------- * IDABBDPRE error messages * ----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The Glocal or Gcomm routine failed in an unrecoverable manner." #define MSGBBD_AMEM_NULL "idaadj_mem = NULL illegal." #define MSGBBD_PDATAB_NULL "IDABBDPRE memory is NULL for the backward integration." #define MSGBBD_BAD_T "Bad t for interpolation." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/idas/idaa.c0000600000175000017500000025571311741421242016776 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.15 $ * $Date: 2011/12/07 23:28:51 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDAA adjoint integrator. * ----------------------------------------------------------------- */ /*=================================================================*/ /* Import Header Files */ /*=================================================================*/ #include #include #include "idas_impl.h" #include /*=================================================================*/ /* Macros */ /*=================================================================*/ #define loop for(;;) /*=================================================================*/ /* IDAA Private Constants */ /*=================================================================*/ #define ZERO RCONST(0.0) /* real 0.0 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for IDAAgetY */ /*=================================================================*/ /* Private Functions Prototypes */ /*=================================================================*/ static CkpntMem IDAAckpntInit(IDAMem IDA_mem); static CkpntMem IDAAckpntNew(IDAMem IDA_mem); static void IDAAckpntCopyVectors(IDAMem IDA_mem, CkpntMem ck_mem); static booleantype IDAAckpntAllocVectors(IDAMem IDA_mem, CkpntMem ck_mem); static void IDAAckpntDelete(CkpntMem *ck_memPtr); static void IDAAbckpbDelete(IDABMem *IDAB_memPtr); static booleantype IDAAdataMalloc(IDAMem IDA_mem); static void IDAAdataFree(IDAMem IDA_mem); static int IDAAdataStore(IDAMem IDA_mem, CkpntMem ck_mem); static int IDAAckpntGet(IDAMem IDA_mem, CkpntMem ck_mem); static booleantype IDAAhermiteMalloc(IDAMem IDA_mem); static void IDAAhermiteFree(IDAMem IDA_mem); static int IDAAhermiteStorePnt(IDAMem IDA_mem, DtpntMem d); static int IDAAhermiteGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); static booleantype IDAApolynomialMalloc(IDAMem IDA_mem); static void IDAApolynomialFree(IDAMem IDA_mem); static int IDAApolynomialStorePnt(IDAMem IDA_mem, DtpntMem d); static int IDAApolynomialGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); static int IDAAfindIndex(IDAMem ida_mem, realtype t, long int *indx, booleantype *newpoint); static int IDAAres(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector resvalB, void *ida_mem); static int IDAArhsQ(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrQB, void *ida_mem); static int IDAAGettnSolutionYp(IDAMem IDA_mem, N_Vector yp); static int IDAAGettnSolutionYpS(IDAMem IDA_mem, N_Vector *ypS); extern int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); /*=================================================================*/ /* Readibility Constants */ /*=================================================================*/ /* IDAADJ memory block */ #define tinitial (IDAADJ_mem->ia_tinitial) #define tfinal (IDAADJ_mem->ia_tfinal) #define nckpnts (IDAADJ_mem->ia_nckpnts) #define nbckpbs (IDAADJ_mem->ia_nbckpbs) #define nsteps (IDAADJ_mem->ia_nsteps) #define ckpntData (IDAADJ_mem->ia_ckpntData) #define newData (IDAADJ_mem->ia_newData) #define np (IDAADJ_mem->ia_np) #define dt (IDAADJ_mem->ia_dt) #define yyTmp (IDAADJ_mem->ia_yyTmp) #define ypTmp (IDAADJ_mem->ia_ypTmp) #define yySTmp (IDAADJ_mem->ia_yySTmp) #define ypSTmp (IDAADJ_mem->ia_ypSTmp) #define res_B (IDAADJ_mem->ia_resB) #define djac_B (IDAADJ_mem->ia_djacB) #define bjac_B (IDAADJ_mem->ia_bjacB) #define pset_B (IDAADJ_mem->ia_psetB) #define psolve_B (IDAADJ_mem->ia_psolveB) #define jtimes_B (IDAADJ_mem->ia_jtimesB) #define jdata_B (IDAADJ_mem->ia_jdataB) #define pdata_B (IDAADJ_mem->ia_pdataB) #define rhsQ_B (IDAADJ_mem->ia_rhsQB) #define Y (IDAADJ_mem->ia_Y) #define YS (IDAADJ_mem->ia_YS) #define T (IDAADJ_mem->ia_T) #define mallocDone (IDAADJ_mem->ia_mallocDone) #define interpSensi (IDAADJ_mem->ia_interpSensi) #define storeSensi (IDAADJ_mem->ia_storeSensi) #define noInterp (IDAADJ_mem->ia_noInterp) /* Forward IDAS memory block */ #define uround (IDA_mem->ida_uround) #define res (IDA_mem->ida_res) #define itol (IDA_mem->ida_itol) #define reltol (IDA_mem->ida_reltol) #define abstol (IDA_mem->ida_abstol) #define user_data (IDA_mem->ida_user_data) #define forceSetup (IDA_mem->ida_forceSetup) #define h0u (IDA_mem->ida_h0u) #define phi (IDA_mem->ida_phi) #define psi (IDA_mem->ida_psi) #define alpha (IDA_mem->ida_alpha) #define beta (IDA_mem->ida_beta) #define sigma (IDA_mem->ida_sigma) #define gamma (IDA_mem->ida_gamma) #define tn (IDA_mem->ida_tn) #define kk (IDA_mem->ida_kk) #define nst (IDA_mem->ida_nst) #define tretlast (IDA_mem->ida_tretlast) #define kk (IDA_mem->ida_kk) #define kused (IDA_mem->ida_kused) #define knew (IDA_mem->ida_knew) #define maxord (IDA_mem->ida_maxord) #define phase (IDA_mem->ida_phase) #define ns (IDA_mem->ida_ns) #define hh (IDA_mem->ida_hh) #define hused (IDA_mem->ida_hused) #define rr (IDA_mem->ida_rr) #define cj (IDA_mem->ida_cj) #define cjlast (IDA_mem->ida_cjlast) #define cjold (IDA_mem->ida_cjold) #define cjratio (IDA_mem->ida_cjratio) #define ss (IDA_mem->ida_ss) #define ssS (IDA_mem->ida_ssS) #define tempv (IDA_mem->ida_tempv1) #define sensi (IDA_mem->ida_sensi) #define Ns (IDA_mem->ida_Ns) #define phiS (IDA_mem->ida_phiS) #define quadr (IDA_mem->ida_quadr) #define errconQ (IDA_mem->ida_errconQ) #define phiQ (IDA_mem->ida_phiQ) #define rhsQ (IDA_mem->ida_rhsQ) #define quadr_sensi (IDA_mem->ida_quadr_sensi) #define errconQS (IDA_mem->ida_errconQS) #define phiQS (IDA_mem->ida_phiQS) #define tempvQ (IDA_mem->ida_eeQ) /* Checkpoint memory block */ #define t0_ (ck_mem->ck_t0) #define t1_ (ck_mem->ck_t1) #define phi_ (ck_mem->ck_phi) #define phiQ_ (ck_mem->ck_phiQ) #define psi_ (ck_mem->ck_psi) #define alpha_ (ck_mem->ck_alpha) #define beta_ (ck_mem->ck_beta) #define sigma_ (ck_mem->ck_sigma) #define gamma_ (ck_mem->ck_gamma) #define nst_ (ck_mem->ck_nst) #define tretlast_ (ck_mem->ck_tretlast) #define kk_ (ck_mem->ck_kk) #define kused_ (ck_mem->ck_kused) #define knew_ (ck_mem->ck_knew) #define phase_ (ck_mem->ck_phase) #define ns_ (ck_mem->ck_ns) #define hh_ (ck_mem->ck_hh) #define hused_ (ck_mem->ck_hused) #define rr_ (ck_mem->ck_rr) #define cj_ (ck_mem->ck_cj) #define cjlast_ (ck_mem->ck_cjlast) #define cjold_ (ck_mem->ck_cjold) #define cjratio_ (ck_mem->ck_cjratio) #define ss_ (ck_mem->ck_ss) #define ssS_ (ck_mem->ck_ssS) #define next_ (ck_mem->ck_next) #define phi_alloc_ (ck_mem->ck_phi_alloc) #define sensi_ (ck_mem->ck_sensi) #define Ns_ (ck_mem->ck_Ns) #define phiS_ (ck_mem->ck_phiS) #define quadr_ (ck_mem->ck_quadr) #define phiQS_ (ck_mem->ck_phiQS) #define quadr_sensi_ (ck_mem->ck_quadr_sensi) /*=================================================================*/ /* Exported Functions */ /*=================================================================*/ /* * IDAAdjInit * * This routine allocates space for the global IDAA memory * structure. */ int IDAAdjInit(void *ida_mem, long int steps, int interp) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; /* Check arguments */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjInit", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; if (steps <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAAdjInit", MSGAM_BAD_STEPS); return(IDA_ILL_INPUT); } if ( (interp != IDA_HERMITE) && (interp != IDA_POLYNOMIAL) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAAdjInit", MSGAM_BAD_INTERP); return(IDA_ILL_INPUT); } /* Allocate memory block for IDAadjMem. */ IDAADJ_mem = (IDAadjMem) malloc(sizeof(struct IDAadjMemRec)); if (IDAADJ_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDAAdjInit", MSGAM_MEM_FAIL); return(IDA_MEM_FAIL); } /* Attach IDAS memory for forward runs */ IDA_mem->ida_adj_mem = IDAADJ_mem; /* Initialization of check points. */ IDAADJ_mem->ck_mem = NULL; IDAADJ_mem->ia_nckpnts = 0; IDAADJ_mem->ia_ckpntData = NULL; /* Initialization of interpolation data. */ IDAADJ_mem->ia_interpType = interp; IDAADJ_mem->ia_nsteps = steps; /* Allocate space for the array of Data Point structures. */ if (IDAAdataMalloc(IDA_mem) == FALSE) { free(IDAADJ_mem); IDAADJ_mem = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDAAdjInit", MSGAM_MEM_FAIL); return(IDA_MEM_FAIL); } /* Attach functions for the appropriate interpolation module */ switch(interp) { case IDA_HERMITE: IDAADJ_mem->ia_malloc = IDAAhermiteMalloc; IDAADJ_mem->ia_free = IDAAhermiteFree; IDAADJ_mem->ia_getY = IDAAhermiteGetY; IDAADJ_mem->ia_storePnt = IDAAhermiteStorePnt; break; case IDA_POLYNOMIAL: IDAADJ_mem->ia_malloc = IDAApolynomialMalloc; IDAADJ_mem->ia_free = IDAApolynomialFree; IDAADJ_mem->ia_getY = IDAApolynomialGetY; IDAADJ_mem->ia_storePnt = IDAApolynomialStorePnt; break; } /* The interpolation module has not been initialized yet */ IDAADJ_mem->ia_mallocDone = FALSE; /* By default we will store but not interpolate sensitivities * - storeSensi will be set in IDASolveF to FALSE if FSA is not enabled * or if the user forced this through IDASetAdjNoSensi * - interpSensi will be set in IDASolveB to TRUE if storeSensi is TRUE * and if at least one backward problem requires sensitivities * - noInterp will be set in IDACalcICB to TRUE before the call to * IDACalcIC and FALSE after.*/ IDAADJ_mem->ia_storeSensi = TRUE; IDAADJ_mem->ia_interpSensi = FALSE; IDAADJ_mem->ia_noInterp = FALSE; /* Initialize backward problems. */ IDAADJ_mem->IDAB_mem = NULL; IDAADJ_mem->ia_bckpbCrt = NULL; IDAADJ_mem->ia_nbckpbs = 0; /* Flags for tracking the first calls to IDASolveF and IDASolveF. */ IDAADJ_mem->ia_firstIDAFcall = TRUE; IDAADJ_mem->ia_tstopIDAFcall = FALSE; IDAADJ_mem->ia_firstIDABcall = TRUE; /* Adjoint module initialized and allocated. */ IDA_mem->ida_adj = TRUE; IDA_mem->ida_adjMallocDone = TRUE; return(IDA_SUCCESS); } /* * IDAAdjReInit * * IDAAdjReInit reinitializes the IDAS memory structure for ASA */ int IDAAdjReInit(void *ida_mem) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; /* Check arguments */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjReInit", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; /* Was ASA previously initialized? */ if(IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAAdjReInit", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Free all stored checkpoints. */ while (IDAADJ_mem->ck_mem != NULL) IDAAckpntDelete(&(IDAADJ_mem->ck_mem)); IDAADJ_mem->ck_mem = NULL; IDAADJ_mem->ia_nckpnts = 0; IDAADJ_mem->ia_ckpntData = NULL; /* Flags for tracking the first calls to IDASolveF and IDASolveF. */ IDAADJ_mem->ia_firstIDAFcall = TRUE; IDAADJ_mem->ia_tstopIDAFcall = FALSE; IDAADJ_mem->ia_firstIDABcall = TRUE; return(IDA_SUCCESS); } /* * IDAAdjFree * * IDAAdjFree routine frees the memory allocated by IDAAdjInit. */ void IDAAdjFree(void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(IDA_mem->ida_adjMallocDone) { /* Data for adjoint. */ IDAADJ_mem = IDA_mem->ida_adj_mem; /* Delete check points one by one */ while (IDAADJ_mem->ck_mem != NULL) { IDAAckpntDelete(&(IDAADJ_mem->ck_mem)); } IDAAdataFree(IDA_mem); /* Free all backward problems. */ while (IDAADJ_mem->IDAB_mem != NULL) IDAAbckpbDelete( &(IDAADJ_mem->IDAB_mem) ); /* Free IDAA memory. */ free(IDAADJ_mem); IDA_mem->ida_adj_mem = NULL; } } /* * ================================================================= * PRIVATE FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ static void IDAAbckpbDelete(IDABMem *IDAB_memPtr) { IDABMem IDAB_mem = (*IDAB_memPtr); void * ida_mem; if (IDAB_mem == NULL) return; /* Move head to the next element in list. */ *IDAB_memPtr = IDAB_mem->ida_next; /* IDAB_mem is going to be deallocated. */ /* Free IDAS memory for this backward problem. */ ida_mem = (void *)IDAB_mem->IDA_mem; IDAFree(&ida_mem); /* Free linear solver memory. */ if (IDAB_mem->ida_lfree != NULL) IDAB_mem->ida_lfree(IDAB_mem); /* Free preconditioner memory. */ if (IDAB_mem->ida_pfree != NULL) IDAB_mem->ida_pfree(IDAB_mem); /* Free any workspace vectors. */ N_VDestroy(IDAB_mem->ida_yy); N_VDestroy(IDAB_mem->ida_yp); /* Free the node itself. */ free(IDAB_mem); IDAB_mem = NULL; } /*=================================================================*/ /* Wrappers for IDAA */ /*=================================================================*/ /* * IDASolveF * * This routine integrates to tout and returns solution into yout. * In the same time, it stores check point data every 'steps' steps. * * IDASolveF can be called repeatedly by the user. The last tout * will be used as the starting time for the backward integration. * * ncheckPtr points to the number of check points stored so far. */ int IDASolveF(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask, int *ncheckPtr) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; CkpntMem tmp; DtpntMem *dt_mem; int flag, i; booleantype iret, allocOK; /* Is the mem OK? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASolveF", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASolveF", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check for yret != NULL */ if (yret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_YRET_NULL); return(IDA_ILL_INPUT); } /* Check for ypret != NULL */ if (ypret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_YPRET_NULL); return(IDA_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_TRET_NULL); return(IDA_ILL_INPUT); } /* Check for valid itask */ if ( (itask != IDA_NORMAL) && (itask != IDA_ONE_STEP) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } /* All memory checks done, proceed ... */ dt_mem = IDAADJ_mem->dt_mem; /* If tstop is enabled, store some info */ if (IDA_mem->ida_tstopset) { IDAADJ_mem->ia_tstopIDAFcall = TRUE; IDAADJ_mem->ia_tstopIDAF = IDA_mem->ida_tstop; } /* We will call IDASolve in IDA_ONE_STEP mode, regardless of what itask is, so flag if we need to return */ if (itask == IDA_ONE_STEP) iret = TRUE; else iret = FALSE; /* On the first step: * - set tinitial * - initialize list of check points * - if needed, initialize the interpolation module * - load dt_mem[0] * On subsequent steps, test if taking a new step is necessary. */ if ( IDAADJ_mem->ia_firstIDAFcall ) { tinitial = tn; IDAADJ_mem->ck_mem = IDAAckpntInit(IDA_mem); if (IDAADJ_mem->ck_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDASolveF", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } if (!mallocDone) { /* Do we need to store sensitivities? */ if (!sensi) storeSensi = FALSE; /* Allocate space for interpolation data */ allocOK = IDAADJ_mem->ia_malloc(IDA_mem); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDASolveF", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Rename phi and, if needed, phiS for use in interpolation */ for (i=0;it = IDAADJ_mem->ck_mem->ck_t0; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); IDAADJ_mem->ia_firstIDAFcall = FALSE; } else if ( (tn-tout)*hh >= ZERO ) { /* If tout was passed, return interpolated solution. No changes to ck_mem or dt_mem are needed. */ *tret = tout; flag = IDAGetSolution(IDA_mem, tout, yret, ypret); *ncheckPtr = nckpnts; newData = TRUE; ckpntData = IDAADJ_mem->ck_mem; np = nst % nsteps + 1; return(flag); } /* Integrate to tout while loading check points */ loop { /* Perform one step of the integration */ flag = IDASolve(IDA_mem, tout, tret, yret, ypret, IDA_ONE_STEP); if (flag < 0) break; /* Test if a new check point is needed */ if ( nst % nsteps == 0 ) { IDAADJ_mem->ck_mem->ck_t1 = *tret; /* Create a new check point, load it, and append it to the list */ tmp = IDAAckpntNew(IDA_mem); if (tmp == NULL) { flag = IDA_MEM_FAIL; break; } tmp->ck_next = IDAADJ_mem->ck_mem; IDAADJ_mem->ck_mem = tmp; nckpnts++; forceSetup = TRUE; /* Reset i=0 and load dt_mem[0] */ dt_mem[0]->t = IDAADJ_mem->ck_mem->ck_t0; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); } else { /* Load next point in dt_mem */ dt_mem[nst%nsteps]->t = *tret; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[nst%nsteps]); } /* Set t1 field of the current ckeck point structure for the case in which there will be no future check points */ IDAADJ_mem->ck_mem->ck_t1 = *tret; /* tfinal is now set to *t */ tfinal = *tret; /* In IDA_ONE_STEP mode break from loop */ if (itask == IDA_ONE_STEP) break; /* Return if tout reached */ if ( (*tret - tout)*hh >= ZERO ) { *tret = tout; IDAGetSolution(IDA_mem, tout, yret, ypret); /* Reset tretlast in IDA_mem so that IDAGetQuad and IDAGetSens * evaluate quadratures and/or sensitivities at the proper time */ IDA_mem->ida_tretlast = tout; break; } } /* Get ncheck from IDAADJ_mem */ *ncheckPtr = nckpnts; /* Data is available for the last interval */ newData = TRUE; ckpntData = IDAADJ_mem->ck_mem; np = nst % nsteps + 1; return(flag); } /* * ================================================================= * FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ int IDACreateB(void *ida_mem, int *which) { IDAMem IDA_mem; void* ida_memB; IDABMem new_IDAB_mem; IDAadjMem IDAADJ_mem; /* Is the mem OK? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACreateB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACreateB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Allocate a new IDABMem struct. */ new_IDAB_mem = (IDABMem) malloc( sizeof( struct IDABMemRec ) ); if (new_IDAB_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDACreateB", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Allocate the IDAMem struct needed by this backward problem. */ ida_memB = IDACreate(); if (ida_memB == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDACreateB", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Save ida_mem in ida_memB as user data. */ IDASetUserData(ida_memB, ida_mem); /* Set same error output and handler for ida_memB. */ IDASetErrHandlerFn(ida_memB, IDA_mem->ida_ehfun, IDA_mem->ida_eh_data); IDASetErrFile(ida_memB, IDA_mem->ida_errfp); /* Initialize fields in the IDABMem struct. */ new_IDAB_mem->ida_index = IDAADJ_mem->ia_nbckpbs; new_IDAB_mem->IDA_mem = (IDAMem) ida_memB; new_IDAB_mem->ida_res = NULL; new_IDAB_mem->ida_resS = NULL; new_IDAB_mem->ida_rhsQ = NULL; new_IDAB_mem->ida_rhsQS = NULL; new_IDAB_mem->ida_user_data = NULL; new_IDAB_mem->ida_lmem = NULL; new_IDAB_mem->ida_lfree = NULL; new_IDAB_mem->ida_pmem = NULL; new_IDAB_mem->ida_pfree = NULL; new_IDAB_mem->ida_yy = NULL; new_IDAB_mem->ida_yp = NULL; new_IDAB_mem->ida_res_withSensi = FALSE; new_IDAB_mem->ida_rhsQ_withSensi = FALSE; /* Attach the new object to the beginning of the linked list IDAADJ_mem->IDAB_mem. */ new_IDAB_mem->ida_next = IDAADJ_mem->IDAB_mem; IDAADJ_mem->IDAB_mem = new_IDAB_mem; /* Return the assigned index. This id is used as identificator and has to be passed to IDAInitB and other ***B functions that set the optional inputs for this backward problem. */ *which = IDAADJ_mem->ia_nbckpbs; /*Increase the counter of the backward problems stored. */ IDAADJ_mem->ia_nbckpbs++; return(IDA_SUCCESS); } int IDAInitB(void *ida_mem, int which, IDAResFnB resB, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAInitB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < tinitial) || (tB0 > tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAInitB", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Call the IDAInit for this backward problem. */ flag = IDAInit(ida_memB, IDAAres, tB0, yyB0, ypB0); if (IDA_SUCCESS != flag) return(flag); /* Copy residual function in IDAB_mem. */ IDAB_mem->ida_res = resB; IDAB_mem->ida_res_withSensi = FALSE; /* Initialized the initial time field. */ IDAB_mem->ida_t0 = tB0; /* Allocate and initialize space workspace vectors. */ IDAB_mem->ida_yy = N_VClone(yyB0); IDAB_mem->ida_yp = N_VClone(yyB0); N_VScale(ONE, yyB0, IDAB_mem->ida_yy); N_VScale(ONE, ypB0, IDAB_mem->ida_yp); return(flag); } int IDAInitBS(void *ida_mem, int which, IDAResFnBS resS, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAInitBS", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAInitBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < tinitial) || (tB0 > tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAInitBS", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Were sensitivities active during the forward integration? */ if (!storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitBS", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Allocate and set the IDAS object */ flag = IDAInit(ida_memB, IDAAres, tB0, yyB0, ypB0); if (flag != IDA_SUCCESS) return(flag); /* Copy residual function pointer in IDAB_mem. */ IDAB_mem->ida_res_withSensi = TRUE; IDAB_mem->ida_resS = resS; /* Allocate space and initialize the yy and yp vectors. */ IDAB_mem->ida_t0 = tB0; IDAB_mem->ida_yy = N_VClone(yyB0); IDAB_mem->ida_yp = N_VClone(ypB0); N_VScale(ONE, yyB0, IDAB_mem->ida_yy); N_VScale(ONE, ypB0, IDAB_mem->ida_yp); return(IDA_SUCCESS); } int IDAReInitB(void *ida_mem, int which, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAReInitB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAReInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < tinitial) || (tB0 > tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAReInitB", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAReInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Call the IDAReInit for this backward problem. */ flag = IDAReInit(ida_memB, tB0, yyB0, ypB0); return(flag); } int IDASStolerancesB(void *ida_mem, int which, realtype relTolB, realtype absTolB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASStolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASStolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASStolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Set tolerances and return. */ return IDASStolerances(ida_memB, relTolB, absTolB); } int IDASVtolerancesB(void *ida_mem, int which, realtype relTolB, N_Vector absTolB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASVtolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASVtolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASVtolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Set tolerances and return. */ return IDASVtolerances(ida_memB, relTolB, absTolB); } int IDAQuadSStolerancesB(void *ida_mem, int which, realtype reltolQB, realtype abstolQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadSStolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadSStolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadSStolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDAQuadSStolerances(ida_memB, reltolQB, abstolQB); } int IDAQuadSVtolerancesB(void *ida_mem, int which, realtype reltolQB, N_Vector abstolQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadSVtolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadSVtolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadSVtolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDAQuadSVtolerances(ida_memB, reltolQB, abstolQB); } int IDAQuadInitB(void *ida_mem, int which, IDAQuadRhsFnB rhsQB, N_Vector yQB0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; flag = IDAQuadInit(ida_memB, IDAArhsQ, yQB0); if (IDA_SUCCESS != flag) return flag; IDAB_mem->ida_rhsQ_withSensi = FALSE; IDAB_mem->ida_rhsQ = rhsQB; return(flag); } int IDAQuadInitBS(void *ida_mem, int which, IDAQuadRhsFnBS rhsQS, N_Vector yQB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitBS", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Allocate and set the IDAS object */ flag = IDAQuadInit(ida_memB, IDAArhsQ, yQB0); if (flag != IDA_SUCCESS) return(flag); /* Copy RHS function pointer in IDAB_mem and enable quad sensitivities. */ IDAB_mem->ida_rhsQ_withSensi = TRUE; IDAB_mem->ida_rhsQS = rhsQS; return(IDA_SUCCESS); } int IDAQuadReInitB(void *ida_mem, int which, N_Vector yQB0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDAQuadReInit(ida_mem, yQB0); } /* * ---------------------------------------------------------------- * Function : IDACalcICB * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for a DAE * backward system (index-one in semi-implicit form). * It uses Newton iteration combined with a Linesearch algorithm. * Calling IDACalcICB is optional. It is only necessary when the * initial conditions do not solve the given system. I.e., if * yB0 and ypB0 are known to satisfy the backward problem, then * a call to IDACalcIC is NOT necessary (for index-one problems). */ int IDACalcICB(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACalcICB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACalcICB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* The wrapper for user supplied res function requires ia_bckpbCrt from IDAAdjMem to be set to curent problem. */ IDAADJ_mem->ia_bckpbCrt = IDAB_mem; /* Save (y, y') in yyTmp and ypTmp for use in the res wrapper.*/ /* yyTmp and ypTmp workspaces are safe to use if IDAADataStore is not called.*/ N_VScale(ONE, yy0, yyTmp); N_VScale(ONE, yp0, ypTmp); /* Set noInterp flag to true, so IDAARes will use user provided values for y and y' and will not call the interpolation routine(s). */ noInterp = TRUE; flag = IDACalcIC(ida_memB, IDA_YA_YDP_INIT, tout1); /* Set interpolation on in IDAARes. */ noInterp = FALSE; return(flag); } /* * ---------------------------------------------------------------- * Function : IDACalcICBS * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for a DAE * backward system (index-one in semi-implicit form) that also * dependes on the sensivities. * * It calls IDACalcIC for the 'which' backward problem. */ int IDACalcICBS(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0, N_Vector *yyS0, N_Vector *ypS0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag, is; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACalcICBS", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACalcICBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Were sensitivities active during the forward integration? */ if (!storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* Was InitBS called for this problem? */ if (!IDAB_mem->ida_res_withSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_NO_INITBS); return(IDA_ILL_INPUT); } /* The wrapper for user supplied res function requires ia_bckpbCrt from IDAAdjMem to be set to curent problem. */ IDAADJ_mem->ia_bckpbCrt = IDAB_mem; /* Save (y, y') and (y_p, y'_p) in yyTmp, ypTmp and yySTmp, ypSTmp.The wrapper for residual will use these values instead of calling interpolation routine.*/ /* The four workspaces variables are safe to use if IDAADataStore is not called.*/ N_VScale(ONE, yy0, yyTmp); N_VScale(ONE, yp0, ypTmp); for (is=0; isida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASolveB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; if ( nbckpbs == 0 ) { IDAProcessError(IDA_mem, IDA_NO_BCK, "IDAA", "IDASolveB", MSGAM_NO_BCK); return(IDA_NO_BCK); } IDAB_mem = IDAADJ_mem->IDAB_mem; /* Check whether IDASolveF has been called */ if ( IDAADJ_mem->ia_firstIDAFcall ) { IDAProcessError(IDA_mem, IDA_NO_FWD, "IDAA", "IDASolveB", MSGAM_NO_FWD); return(IDA_NO_FWD); } sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* If this is the first call, loop over all backward problems and * - check that tB0 is valid * - check that tBout is ahead of tB0 in the backward direction * - check whether we need to interpolate forward sensitivities */ if (IDAADJ_mem->ia_firstIDABcall) { /* First IDABMem struct. */ tmp_IDAB_mem = IDAB_mem; while (tmp_IDAB_mem != NULL) { tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( (sign*(tBn-tinitial) < ZERO) || (sign*(tfinal-tBn) < ZERO) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDASolveB", MSGAM_BAD_TB0, tmp_IDAB_mem->ida_index); return(IDA_BAD_TB0); } if (sign*(tBn-tBout) <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_TBOUT, tmp_IDAB_mem->ida_index); return(IDA_ILL_INPUT); } if ( tmp_IDAB_mem->ida_res_withSensi || tmp_IDAB_mem->ida_rhsQ_withSensi ) interpSensi = TRUE; /* Advance in list. */ tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if ( interpSensi && !storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } IDAADJ_mem->ia_firstIDABcall = FALSE; } /* Check for valid itask */ if ( (itaskB != IDA_NORMAL) && (itaskB != IDA_ONE_STEP) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } /* Check if tBout is legal */ if ( (sign*(tBout-tinitial) < ZERO) || (sign*(tfinal-tBout) < ZERO) ) { tfuzz = HUNDRED*uround*(ABS(tinitial) + ABS(tfinal)); if ( (sign*(tBout-tinitial) < ZERO) && (ABS(tBout-tinitial) < tfuzz) ) { tBout = tinitial; } else { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_TBOUT); return(IDA_ILL_INPUT); } } /* Loop through the check points and stop as soon as a backward * problem has its tn value behind the current check point's t0_ * value (in the backward direction) */ ck_mem = IDAADJ_mem->ck_mem; gotCkpnt = FALSE; loop { tmp_IDAB_mem = IDAB_mem; while(tmp_IDAB_mem != NULL) { tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( sign*(tBn-t0_) > ZERO ) { gotCkpnt = TRUE; break; } if ( (itaskB == IDA_NORMAL) && (tBn == t0_) && (sign*(tBout-t0_) >= ZERO) ) { gotCkpnt = TRUE; break; } tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if (gotCkpnt) break; if (ck_mem->ck_next == NULL) break; ck_mem = ck_mem->ck_next; } /* Loop while propagating backward problems */ loop { /* Store interpolation data if not available. This is the 2nd forward integration pass */ if (ck_mem != ckpntData) { flag = IDAAdataStore(IDA_mem, ck_mem); if (flag != IDA_SUCCESS) break; } /* Starting with the current check point from above, loop over check points while propagating backward problems */ tmp_IDAB_mem = IDAB_mem; while (tmp_IDAB_mem != NULL) { /* Decide if current backward problem is "active" in this check point */ isActive = TRUE; tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( (tBn == t0_) && (sign*(tBout-t0_) < ZERO ) ) isActive = FALSE; if ( (tBn == t0_) && (itaskB == IDA_ONE_STEP) ) isActive = FALSE; if ( sign*(tBn - t0_) < ZERO ) isActive = FALSE; if ( isActive ) { /* Store the address of current backward problem memory * in IDAADJ_mem to be used in the wrapper functions */ IDAADJ_mem->ia_bckpbCrt = tmp_IDAB_mem; /* Integrate current backward problem */ IDASetStopTime(tmp_IDAB_mem->IDA_mem, t0_); flag = IDASolve(tmp_IDAB_mem->IDA_mem, tBout, &tBret, tmp_IDAB_mem->ida_yy, tmp_IDAB_mem->ida_yp, itaskB); /* Set the time at which we will report solution and/or quadratures */ tmp_IDAB_mem->ida_tout = tBret; /* If an error occurred, exit while loop */ if (flag < 0) break; } else { flag = IDA_SUCCESS; tmp_IDAB_mem->ida_tout = tBn; } /* Move to next backward problem */ tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } /* End of while: iteration through backward problems. */ /* If an error occurred, return now */ if (flag <0) { IDAProcessError(IDA_mem, flag, "IDAA", "IDASolveB", MSGAM_BACK_ERROR, tmp_IDAB_mem->ida_index); return(flag); } /* If in IDA_ONE_STEP mode, return now (flag = IDA_SUCCESS) */ if (itaskB == IDA_ONE_STEP) break; /* If all backward problems have succesfully reached tBout, return now */ reachedTBout = TRUE; tmp_IDAB_mem = IDAB_mem; while(tmp_IDAB_mem != NULL) { if ( sign*(tmp_IDAB_mem->ida_tout - tBout) > ZERO ) { reachedTBout = FALSE; break; } tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if ( reachedTBout ) break; /* Move check point in linked list to next one */ ck_mem = ck_mem->ck_next; } /* End of loop. */ return(flag); } /* * IDAGetB * * IDAGetB returns the state variables at the same time (also returned * in tret) as that at which IDASolveBreturned the solution. */ SUNDIALS_EXPORT int IDAGetB(void* ida_mem, int which, realtype *tret, N_Vector yy, N_Vector yp) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } N_VScale(ONE, IDAB_mem->ida_yy, yy); N_VScale(ONE, IDAB_mem->ida_yp, yp); *tret = IDAB_mem->ida_tout; return(IDA_SUCCESS); } /* * IDAGetQuadB * * IDAGetQuadB returns the quadrature variables at the same * time (also returned in tret) as that at which IDASolveB * returned the solution. */ int IDAGetQuadB(void *ida_mem, int which, realtype *tret, N_Vector qB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; long int nstB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetQuadB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetQuadB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetQuadB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* If the integration for this backward problem has not started yet, * simply return the current value of qB (i.e. the final conditions) */ flag = IDAGetNumSteps(ida_memB, &nstB); if (IDA_SUCCESS != flag) return(flag); if (nstB == 0) { N_VScale(ONE, IDAB_mem->IDA_mem->ida_phiQ[0], qB); *tret = IDAB_mem->ida_tout; } else { flag = IDAGetQuad(ida_memB, tret, qB); } return(flag); } /*=================================================================*/ /* Private Functions Implementation */ /*=================================================================*/ /* * IDAAckpntInit * * This routine initializes the check point linked list with * information from the initial time. */ static CkpntMem IDAAckpntInit(IDAMem IDA_mem) { CkpntMem ck_mem; /* Allocate space for ckdata */ ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (NULL==ck_mem) return(NULL); t0_ = tn; nst_ = 0; kk_ = 1; hh_ = ZERO; /* Test if we need to carry quadratures */ quadr_ = quadr && errconQ; /* Test if we need to carry sensitivities */ sensi_ = sensi; if(sensi_) Ns_ = Ns; /* Test if we need to carry quadrature sensitivities */ quadr_sensi_ = quadr_sensi && errconQS; /* Alloc 3: current order, i.e. 1, + 2. */ phi_alloc_ = 3; if (!IDAAckpntAllocVectors(IDA_mem, ck_mem)) { free(ck_mem); ck_mem = NULL; return(NULL); } /* Save phi* vectors from IDA_mem to ck_mem. */ IDAAckpntCopyVectors(IDA_mem, ck_mem); /* Next in list */ next_ = NULL; return(ck_mem); } /* * IDAAckpntNew * * This routine allocates space for a new check point and sets * its data from current values in IDA_mem. */ static CkpntMem IDAAckpntNew(IDAMem IDA_mem) { CkpntMem ck_mem; int j; /* Allocate space for ckdata */ ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (ck_mem == NULL) return(NULL); nst_ = nst; tretlast_ = tretlast; kk_ = kk; kused_ = kused; knew_ = knew; phase_ = phase; ns_ = ns; hh_ = hh; hused_ = hused; rr_ = rr; cj_ = cj; cjlast_ = cjlast; cjold_ = cjold; cjratio_ = cjratio; ss_ = ss; ssS_ = ssS; t0_ = tn; for (j=0; jck_next; /* free N_Vectors in tmp */ for (j=0; jck_phi_alloc; j++) N_VDestroy(tmp->ck_phi[j]); /* free N_Vectors for quadratures in tmp */ if (tmp->ck_quadr) { for (j=0; jck_phi_alloc; j++) N_VDestroy(tmp->ck_phiQ[j]); } /* Free sensitivity related data. */ if (tmp->ck_sensi) { for (j=0; jck_phi_alloc; j++) N_VDestroyVectorArray(tmp->ck_phiS[j], tmp->ck_Ns); } if (tmp->ck_quadr_sensi) { for (j=0; jck_phi_alloc; j++) N_VDestroyVectorArray(tmp->ck_phiQS[j], tmp->ck_Ns); } free(tmp); tmp=NULL; } } /* * IDAAckpntAllocVectors * * Allocate checkpoint's phi, phiQ, phiS, phiQS vectors needed to save * current state of IDAMem. * */ static booleantype IDAAckpntAllocVectors(IDAMem IDA_mem, CkpntMem ck_mem) { int j, jj; for (j=0; jida_adj_mem; IDAADJ_mem->dt_mem = NULL; dt_mem = (DtpntMem *)malloc((nsteps+1)*sizeof(struct DtpntMemRec *)); if (dt_mem==NULL) return(FALSE); for (i=0; i<=nsteps; i++) { dt_mem[i] = (DtpntMem)malloc(sizeof(struct DtpntMemRec)); /* On failure, free any allocated memory and return NULL. */ if (dt_mem[i] == NULL) { for(j=0; jcontent = NULL; } /* Attach the allocated dt_mem to IDAADJ_mem. */ IDAADJ_mem->dt_mem = dt_mem; return(TRUE); } /* * IDAAdataFree * * This routine frees the memory allocated for data storage. */ static void IDAAdataFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; if (IDAADJ_mem == NULL) return; /* Destroy data points by calling the interpolation's 'free' routine. */ IDAADJ_mem->ia_free(IDA_mem); for (i=0; i<=nsteps; i++) { free(IDAADJ_mem->dt_mem[i]); IDAADJ_mem->dt_mem[i] = NULL; } free(IDAADJ_mem->dt_mem); IDAADJ_mem->dt_mem = NULL; } /* * IDAAdataStore * * This routine integrates the forward model starting at the check * point ck_mem and stores y and yprime at all intermediate * steps. * * Return values: * - the flag that IDASolve may return on error * - IDA_REIFWD_FAIL if no check point is available for this hot start * - IDA_SUCCESS */ static int IDAAdataStore(IDAMem IDA_mem, CkpntMem ck_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; realtype t; long int i; int flag, sign; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Initialize IDA_mem with data from ck_mem. */ flag = IDAAckpntGet(IDA_mem, ck_mem); if (flag != IDA_SUCCESS) return(IDA_REIFWD_FAIL); /* Set first structure in dt_mem[0] */ dt_mem[0]->t = t0_; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); /* Decide whether TSTOP must be activated */ if (IDAADJ_mem->ia_tstopIDAFcall) { IDASetStopTime(IDA_mem, IDAADJ_mem->ia_tstopIDAF); } sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* Run IDASolve in IDA_ONE_STEP mode to set following structures in dt_mem[i]. */ i = 1; do { flag = IDASolve(IDA_mem, t1_, &t, yyTmp, ypTmp, IDA_ONE_STEP); if (flag < 0) return(IDA_FWD_FAIL); dt_mem[i]->t = t; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[i]); i++; } while ( sign*(t1_ - t) > ZERO ); /* New data is now available. */ ckpntData = ck_mem; newData = TRUE; np = i; return(IDA_SUCCESS); } /* * CVAckpntGet * * This routine prepares IDAS for a hot restart from * the check point ck_mem */ static int IDAAckpntGet(IDAMem IDA_mem, CkpntMem ck_mem) { int flag, j, is; if (next_ == NULL) { /* In this case, we just call the reinitialization routine, * but make sure we use the same initial stepsize as on * the first run. */ IDASetInitStep(IDA_mem, h0u); flag = IDAReInit(IDA_mem, t0_, phi_[0], phi_[1]); if (flag != IDA_SUCCESS) return(flag); if (quadr_) { flag = IDAQuadReInit(IDA_mem, phiQ_[0]); if (flag != IDA_SUCCESS) return(flag); } if (sensi_) { flag = IDASensReInit(IDA_mem, IDA_mem->ida_ism, phiS_[0], phiS_[1]); if (flag != IDA_SUCCESS) return(flag); } if (quadr_sensi_) { flag = IDAQuadSensReInit(IDA_mem, phiQS_[0]); if (flag != IDA_SUCCESS) return(flag); } } else { /* Copy parameters from check point data structure */ nst = nst_; tretlast = tretlast_; kk = kk_; kused = kused_; knew = knew_; phase = phase_; ns = ns_; hh = hh_; hused = hused_; rr = rr_; cj = cj_; cjlast = cjlast_; cjold = cjold_; cjratio = cjratio_; tn = t0_; ss = ss_; ssS = ssS_; /* Copy the arrays from check point data structure */ for (j=0; jida_adj_mem; /* Allocate space for the vectors yyTmp and ypTmp. */ yyTmp = N_VClone(tempv); if (yyTmp == NULL) { return(FALSE); } ypTmp = N_VClone(tempv); if (ypTmp == NULL) { return(FALSE); } /* Allocate space for sensitivities temporary vectors. */ if (storeSensi) { yySTmp = N_VCloneVectorArray(Ns, tempv); if (yySTmp == NULL) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); return(FALSE); } ypSTmp = N_VCloneVectorArray(Ns, tempv); if (ypSTmp == NULL) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); N_VDestroyVectorArray(yySTmp, Ns); return(FALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = NULL; content = (HermiteDataMem) malloc(sizeof(struct HermiteDataMemRec)); if (content == NULL) { ii = i; allocOK = FALSE; break; } content->y = N_VClone(tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = FALSE; break; } content->yd = N_VClone(tempv); if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = FALSE; break; } if (storeSensi) { content->yS = N_VCloneVectorArray(Ns, tempv); if (content->yS == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = FALSE; break; } content->ySd = N_VCloneVectorArray(Ns, tempv); if (content->ySd == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, Ns); free(content); content = NULL; ii = i; allocOK = FALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); if (storeSensi) { N_VDestroyVectorArray(yySTmp, Ns); N_VDestroyVectorArray(ypSTmp, Ns); } for (i=0; icontent); N_VDestroy(content->y); N_VDestroy(content->yd); if (storeSensi) { N_VDestroyVectorArray(content->yS, Ns); N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * IDAAhermiteFree * * This routine frees the memory allocated for data storage. */ static void IDAAhermiteFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; N_VDestroy(yyTmp); N_VDestroy(ypTmp); if (storeSensi) { N_VDestroyVectorArray(yySTmp, Ns); N_VDestroyVectorArray(ypSTmp, Ns); } dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = (HermiteDataMem) (dt_mem[i]->content); /* content might be NULL, if IDAAdjInit was called but IDASolveF was not. */ if(content) { N_VDestroy(content->y); N_VDestroy(content->yd); if (storeSensi) { N_VDestroyVectorArray(content->yS, Ns); N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } } /* * IDAAhermiteStorePnt * * This routine stores a new point (y,yd) in the structure d for use * in the cubic Hermite interpolation. * Note that the time is already stored. */ static int IDAAhermiteStorePnt(IDAMem IDA_mem, DtpntMem d) { IDAadjMem IDAADJ_mem; HermiteDataMem content; int is; IDAADJ_mem = IDA_mem->ida_adj_mem; content = (HermiteDataMem) d->content; /* Load solution(s) */ N_VScale(ONE, phi[0], content->y); if (storeSensi) { for (is=0; isyS[is]); } /* Load derivative(s). */ IDAAGettnSolutionYp(IDA_mem, content->yd); if (storeSensi) { IDAAGettnSolutionYpS(IDA_mem, content->ySd); } return(0); } /* * IDAAhermiteGetY * * This routine uses cubic piece-wise Hermite interpolation for * the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB) but * can be directly called by the user through IDAGetAdjY */ static int IDAAhermiteGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content0, content1; realtype t0, t1, delta; realtype factor1, factor2, factor3; N_Vector y0, yd0, y1, yd1; N_Vector *yS0, *ySd0, *yS1, *ySd1; int flag, is, NS; long int indx; booleantype newpoint; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Local value of Ns */ NS = interpSensi ? Ns : 0; /* Get the index in dt_mem */ flag = IDAAfindIndex(IDA_mem, t, &indx, &newpoint); if (flag != IDA_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content0 = (HermiteDataMem) (dt_mem[0]->content); N_VScale(ONE, content0->y, yy); N_VScale(ONE, content0->yd, yp); for (is=0; isyS[is], yyS[is]); N_VScale(ONE, content0->ySd[is],ypS[is]); } return(IDA_SUCCESS); } /* Extract stuff from the appropriate data points */ t0 = dt_mem[indx-1]->t; t1 = dt_mem[indx]->t; delta = t1 - t0; content0 = (HermiteDataMem) (dt_mem[indx-1]->content); y0 = content0->y; yd0 = content0->yd; if (interpSensi) { yS0 = content0->yS; ySd0 = content0->ySd; } if (newpoint) { /* Recompute Y0 and Y1 */ content1 = (HermiteDataMem) (dt_mem[indx]->content); y1 = content1->y; yd1 = content1->yd; N_VLinearSum(ONE, y1, -ONE, y0, Y[0]); N_VLinearSum(ONE, yd1, ONE, yd0, Y[1]); N_VLinearSum(delta, Y[1], -TWO, Y[0], Y[1]); N_VLinearSum(ONE, Y[0], -delta, yd0, Y[0]); yS1 = content1->yS; ySd1 = content1->ySd; for (is=0; isida_adj_mem; /* Allocate space for the vectors yyTmp and ypTmp */ yyTmp = N_VClone(tempv); if (yyTmp == NULL) { return(FALSE); } ypTmp = N_VClone(tempv); if (ypTmp == NULL) { return(FALSE); } if (storeSensi) { yySTmp = N_VCloneVectorArray(Ns, tempv); if (yySTmp == NULL) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); return(FALSE); } ypSTmp = N_VCloneVectorArray(Ns, tempv); if (ypSTmp == NULL) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); N_VDestroyVectorArray(yySTmp, Ns); return(FALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = NULL; content = (PolynomialDataMem) malloc(sizeof(struct PolynomialDataMemRec)); if (content == NULL) { ii = i; allocOK = FALSE; break; } content->y = N_VClone(tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = FALSE; break; } /* Allocate space for yp also. Needed for the most left point interpolation. */ if (i == 0) { content->yd = N_VClone(tempv); /* Memory allocation failure ? */ if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = FALSE; } } else { /* Not the first data point. */ content->yd = NULL; } if (storeSensi) { content->yS = N_VCloneVectorArray(Ns, tempv); if (content->yS == NULL) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = FALSE; break; } if (i==0) { content->ySd = N_VCloneVectorArray(Ns, tempv); if (content->ySd == NULL) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, Ns); free(content); content = NULL; ii = i; allocOK = FALSE; } } else { content->ySd = NULL; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(yyTmp); N_VDestroy(ypTmp); if (storeSensi) { N_VDestroyVectorArray(yySTmp, Ns); N_VDestroyVectorArray(ypSTmp, Ns); } for (i=0; icontent); N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); if (storeSensi) { N_VDestroyVectorArray(content->yS, Ns); if (content->ySd) N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * IDAApolynomialFree * * This routine frees the memory allocated for data storage. */ static void IDAApolynomialFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; N_VDestroy(yyTmp); N_VDestroy(ypTmp); if (storeSensi) { N_VDestroyVectorArray(yySTmp, Ns); N_VDestroyVectorArray(ypSTmp, Ns); } dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = (PolynomialDataMem) (dt_mem[i]->content); /* content might be NULL, if IDAAdjInit was called but IDASolveF was not. */ if(content) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); if (storeSensi) { N_VDestroyVectorArray(content->yS, Ns); if (content->ySd) N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } } /* * IDAApolynomialStorePnt * * This routine stores a new point y in the structure d for use * in the Polynomial interpolation. * * Note that the time is already stored. Information about the * first derivative is available only for the first data point, * in which case content->yp is non-null. */ static int IDAApolynomialStorePnt(IDAMem IDA_mem, DtpntMem d) { IDAadjMem IDAADJ_mem; PolynomialDataMem content; int is; IDAADJ_mem = IDA_mem->ida_adj_mem; content = (PolynomialDataMem) d->content; N_VScale(ONE, phi[0], content->y); /* copy also the derivative for the first data point (in this case content->yp is non-null). */ if (content->yd) IDAAGettnSolutionYp(IDA_mem, content->yd); if (storeSensi) { for (is=0; isyS[is]); /* store the derivative if it is the first data point. */ if(content->ySd) IDAAGettnSolutionYpS(IDA_mem, content->ySd); } content->order = kused; return(0); } /* * IDAApolynomialGetY * * This routine uses polynomial interpolation for the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB)) but * can be directly called by the user through CVodeGetAdjY. */ static int IDAApolynomialGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; int flag, dir, order, i, j, is, NS; long int indx, base; booleantype newpoint; realtype delt, factor, Psi, Psiprime; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Local value of Ns */ NS = interpSensi ? Ns : 0; /* Get the index in dt_mem */ flag = IDAAfindIndex(IDA_mem, t, &indx, &newpoint); if (flag != IDA_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content = (PolynomialDataMem) (dt_mem[0]->content); N_VScale(ONE, content->y, yy); N_VScale(ONE, content->yd, yp); for (is=0; isyS[is], yyS[is]); N_VScale(ONE, content->ySd[is], ypS[is]); } return(IDA_SUCCESS); } /* Scaling factor */ delt = ABS(dt_mem[indx]->t - dt_mem[indx-1]->t); /* Find the direction of the forward integration */ dir = (tfinal - tinitial > ZERO) ? 1 : -1; /* Establish the base point depending on the integration direction. Modify the base if there are not enough points for the current order */ if (dir == 1) { base = indx; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if(indx < order) base += order-indx; } else { base = indx-1; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if (np-indx > order) base -= indx+order-np; } /* Recompute Y (divided differences for Newton polynomial) if needed */ if (newpoint) { /* Store 0-th order DD */ if (dir == 1) { for(j=0;j<=order;j++) { T[j] = dt_mem[base-j]->t; content = (PolynomialDataMem) (dt_mem[base-j]->content); N_VScale(ONE, content->y, Y[j]); for (is=0; isyS[is], YS[j][is]); } } else { for(j=0;j<=order;j++) { T[j] = dt_mem[base-1+j]->t; content = (PolynomialDataMem) (dt_mem[base-1+j]->content); N_VScale(ONE, content->y, Y[j]); for (is=0; isyS[is], YS[j][is]); } } /* Compute higher-order DD */ for(i=1;i<=order;i++) { for(j=order;j>=i;j--) { factor = delt/(T[j]-T[j-i]); N_VLinearSum(factor, Y[j], -factor, Y[j-1], Y[j]); for (is=0; is=0; i--) { factor = (t-T[i])/delt; N_VLinearSum(factor, yy, ONE, Y[i], yy); for (is=0; isida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; *newpoint = FALSE; /* Find the direction of integration */ sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* If this is the first time we use new data */ if (newData) { ilast = np-1; *newpoint = TRUE; newData = FALSE; } /* Search for indx starting from ilast */ to_left = ( sign*(t - dt_mem[ilast-1]->t) < ZERO); to_right = ( sign*(t - dt_mem[ilast]->t) > ZERO); if ( to_left ) { /* look for a new indx to the left */ *newpoint = TRUE; *indx = ilast; loop { if ( *indx == 0 ) break; if ( sign*(t - dt_mem[*indx-1]->t) <= ZERO ) (*indx)--; else break; } if ( *indx == 0 ) ilast = 1; else ilast = *indx; if ( *indx == 0 ) { /* t is beyond leftmost limit. Is it too far? */ if ( ABS(t - dt_mem[0]->t) > FUZZ_FACTOR * uround ) { return(IDA_GETY_BADT); } } } else if ( to_right ) { /* look for a new indx to the right */ *newpoint = TRUE; *indx = ilast; loop { if ( sign*(t - dt_mem[*indx]->t) > ZERO) (*indx)++; else break; } ilast = *indx; } else { /* ilast is still OK */ *indx = ilast; } return(IDA_SUCCESS); } /* * IDAGetAdjY * * This routine returns the interpolated forward solution at time t. * The user must allocate space for y. */ int IDAGetAdjY(void *ida_mem, realtype t, N_Vector yy, N_Vector yp) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjY", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; flag = IDAADJ_mem->ia_getY(IDA_mem, t, yy, yp, NULL, NULL); return(flag); } /*=================================================================*/ /* Wrappers for adjoint system */ /*=================================================================*/ /* * IDAAres * * This routine interfaces to the RhsFnB routine provided by * the user. */ static int IDAAres(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *ida_mem) { IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDAMem IDA_mem; int flag, retval; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get the current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get forward solution from interpolation. */ if( noInterp == FALSE) { if (interpSensi) flag = IDAADJ_mem->ia_getY(ida_mem, tt, yyTmp, ypTmp, yySTmp, ypSTmp); else flag = IDAADJ_mem->ia_getY(ida_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDAA", "IDAAres", MSGAM_BAD_TINTERP, tt); return(-1); } } /* Call the user supplied residual. */ if(IDAB_mem->ida_res_withSensi) { retval = IDAB_mem->ida_resS(tt, yyTmp, ypTmp, yySTmp, ypSTmp, yyB, ypB, rrB, IDAB_mem->ida_user_data); }else { retval = IDAB_mem->ida_res(tt, yyTmp, ypTmp, yyB, ypB, rrB, IDAB_mem->ida_user_data); } return(retval); } /* *IDAArhsQ * * This routine interfaces to the IDAQuadRhsFnB routine provided by * the user. * * It is passed to IDAQuadInit calls for backward problem, so it must * be of IDAQuadRhsFn type. */ static int IDAArhsQ(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector resvalQB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; int retval, flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; retval = IDA_SUCCESS; /* Get forward solution from interpolation. */ if (noInterp == FALSE) { if (interpSensi) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, yySTmp, ypSTmp); } else { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); } if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDAA", "IDAArhsQ", MSGAM_BAD_TINTERP, tt); return(-1); } } /* Call user's adjoint quadrature RHS routine */ if (IDAB_mem->ida_rhsQ_withSensi) { retval = IDAB_mem->ida_rhsQS(tt, yyTmp, ypTmp, yySTmp, ypSTmp, yyB, ypB, resvalQB, IDAB_mem->ida_user_data); } else { retval = IDAB_mem->ida_rhsQ(tt, yyTmp, ypTmp, yyB, ypB, resvalQB, IDAB_mem->ida_user_data); } return(retval); } sundials-2.5.0/src/idas/idas_direct_impl.h0000600000175000017500000001170411741421242021366 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:39:18 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the IDADLS linear solvers. * ----------------------------------------------------------------- */ #ifndef _IDASDLS_IMPL_H #define _IDASDLS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * I D A S D I R E C T I N T E R N A L C O N S T A N T S * ================================================================= */ /* * ================================================================= * PART I: F O R W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : IDADlsMemRec, IDADlsMem * ----------------------------------------------------------------- * IDADlsMem is pointer to a IDADlsMemRec structure. * ----------------------------------------------------------------- */ typedef struct IDADlsMemRec { int d_type; /* Type of Jacobians (DENSE or BAND) */ long int d_n; /* problem dimension */ long int d_ml; /* b_ml = lower bandwidth of savedJ */ long int d_mu; /* b_mu = upper bandwidth of savedJ */ long int d_smu; /* upper bandwith of M = MIN(N-1,b_mu+b_ml) */ booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ IDADlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ IDADlsBandJacFn d_bjac; /* band Jacobian routine to be called */ void *d_J_data; /* J_data is passed to djac or bjac */ DlsMat d_J; /* J = dF/dy + cj*dF/dy' */ int *d_pivots; /* pivots = int pivot array for PM = LU */ long int *d_lpivots; /* lpivots = long int pivot array for PM = LU */ long int d_nje; /* nje = no. of calls to jac */ long int d_nreDQ; /* no. of calls to res due to DQ Jacobian approx.*/ long int d_last_flag; /* last error return flag */ } *IDADlsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ int idaDlsDenseDQJac(long int N, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int idaDlsBandDQJac(long int N, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * PART II: B A C K W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : IDADlsMemRecB, IDADlsMemB * ----------------------------------------------------------------- * An IDADLS linear solver's specification function attaches such * a structure to the lmemB filed of IDABMem * ----------------------------------------------------------------- */ typedef struct IDADlsMemRecB { int d_typeB; IDADlsDenseJacFnB d_djacB; IDADlsBandJacFnB d_bjacB; } *IDADlsMemB; /* * ================================================================= * E R R O R M E S S A G E S * ================================================================= */ #define MSGD_IDAMEM_NULL "Integrator memory is NULL." #define MSGD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSGD_MEM_FAIL "A memory request failed." #define MSGD_LMEM_NULL "Linear solver memory is NULL." #define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #define MSGD_CAMEM_NULL "idaadj_mem = NULL illegal." #define MSGD_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSGD_BAD_T "Bad t for interpolation." #define MSGD_BAD_WHICH "Illegal value for which." #define MSGD_NO_ADJ "Illegal attempt to call before calling IDAAdjInit." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/idas/idas_band.c0000600000175000017500000003005311741421242017770 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.14 $ * $Date: 2011/03/23 21:12:45 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDAS banded linear * solver module, IDABAND. This module uses standard banded * matrix techniques to solve the linear systems generated by the * (nonlinear) Newton iteration process. The user may either * supply a banded Jacobian routine or use the routine supplied * with this module (IDABandDQJac). * ----------------------------------------------------------------- */ #include #include #include #include "idas_direct_impl.h" #include "idas_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* IDABAND linit, lsetup, lsolve, and lfree routines */ static int IDABandInit(IDAMem IDA_mem); static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur); static int IDABandFree(IDAMem IDA_mem); /* IDABAND lfreeB function */ static void IDABandFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define res (IDA_mem->ida_res) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define mtype (idadls_mem->d_type) #define neq (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define jacDQ (idadls_mem->d_jacDQ) #define bjac (idadls_mem->d_bjac) #define JJ (idadls_mem->d_J) #define smu (idadls_mem->d_smu) #define lpivots (idadls_mem->d_lpivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define jacdata (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ----------------------------------------------------------------- * IDABand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDABAND linear solver module. * IDABand first calls the existing lfree routine if this is not NULL. * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDABandInit, IDABandSetup, * IDABandSolve, NULL, and IDABandFree, respectively. * It allocates memory for a structure of type IDADlsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jacdata field in * the IDADlsMemRec structure to be the input parameter jdata, and sets * the d_bjac field to be: * (1) the input parameter bjac, if bjac != NULL, or * (2) IDABandDQJac, if bjac == NULL. * Finally, it allocates memory for JJ and lpivots. * IDABand returns IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, * or IDADLS_ILL_INPUT = -2. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDABand will first * test for a compatible N_Vector internal representation by * checking that the N_VGetArrayPointer function exists * ----------------------------------------------------------------- */ int IDABand(void *ida_mem, long int Neq, long int mupper, long int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } /* Test mlower and mupper for legality. */ if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_SIZES); return(IDADLS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem. */ linit = IDABandInit; lsetup = IDABandSetup; lsolve = IDABandSolve; lperf = NULL; lfree = IDABandFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; idadls_mem->d_ml = mlower; idadls_mem->d_mu = mupper; /* Set extended upper half-bandwidth for JJ (required for pivoting). */ smu = MIN(Neq-1, mupper + mlower); /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewBandMat(Neq, mupper, mlower, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(Neq); if (lpivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDABAND interface functions * ----------------------------------------------------------------- */ /* This routine does remaining initializations specific to the IDABAND linear solver module. It returns 0. */ static int IDABandInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Initialize nje and nreB */ nje = 0; nreDQ = 0; if (jacDQ) { bjac = idaDlsBandDQJac; jacdata = IDA_mem; } else { jacdata = IDA_mem->ida_user_data; } last_flag = 0; return(0); } /* This routine does the setup operations for the IDABAND linear solver module. It calls the Jacobian evaluation routine, updates counters, and calls the band LU factorization routine. The return value is either IDADLS_SUCCESS = 0 if successful, +1 if the jac routine failed recoverably or the LU factorization failed, or -1 if the jac routine failed unrecoverably. */ static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = bjac(neq, mu, ml, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASBAND", "IDABandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = BandGBTRF(JJ, lpivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); } /* This routine handles the solve operation for the IDABAND linear solver module. It calls the band backsolve routine, scales the solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. */ static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur) { IDADlsMem idadls_mem; realtype *bd; idadls_mem = (IDADlsMem) lmem; bd = N_VGetArrayPointer(b); BandGBTRS(JJ, lpivots, bd); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); last_flag = 0; return(0); } /* This routine frees memory specific to the IDABAND linear solver. */ static int IDABandFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(lpivots); free(lmem); lmem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * IDABandB is a wrapper around IDABand. It attaches the IDASBAND linear solver * to the backward problem memory block. */ int IDABandB(void *ida_mem, int which, long int NeqB, long int mupperB, long int mlowerB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; void *ida_memB; int flag; /* Is ida_mem allright? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABandB", MSGD_CAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASBAND", "IDABandB", MSGD_NO_ADJ); return(IDADLS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABandB", MSGD_BAD_WHICH); return(IDADLS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get memory for IDADlsMemRecB */ idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB)); if (idadlsB_mem == NULL) { IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABandB", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* set matrix type and initialize Jacob function. */ idadlsB_mem->d_typeB = SUNDIALS_BAND; idadlsB_mem->d_bjacB = NULL; /* Attach lmemB data and lfreeB function. */ IDAB_mem->ida_lmem = idadlsB_mem; IDAB_mem->ida_lfree = IDABandFreeB; /* Call IDABand for the IDAS data of the backward problem. */ ida_memB = (void *)IDAB_mem->IDA_mem; flag = IDABand(ida_memB, NeqB, mupperB, mlowerB); if (flag != IDADLS_SUCCESS) { free(idadlsB_mem); idadlsB_mem = NULL; } return(flag); } /* * IDABandFreeB */ static void IDABandFreeB(IDABMem IDAB_mem) { IDADlsMemB idadlsB_mem; idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; free(idadlsB_mem); } sundials-2.5.0/src/idas/idas_bbdpre.c0000600000175000017500000006250711741421242020333 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2011/03/23 21:12:45 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with IDAS and an IDASPILS * linear solver. * * NOTE: With only one processor in use, a banded matrix results * rather than a block-diagonal matrix with banded blocks. * Diagonal blocking occurs at the processor level. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include "idas_spils_impl.h" #include "idas_bbdpre_impl.h" #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Prototypes of IDABBDPrecSetup and IDABBDPrecSolve */ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *prec_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *prec_data, N_Vector tmp); /* Prototype for IDABBDPrecFree */ static void IDABBDPrecFree(IDAMem ida_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp); /* Wrapper functions for adjoint code */ static int IDAAglocal(long int NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB); static int IDAAgcomm(long int NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, void *user_dataB); /* Prototype for the pfree routine for backward problems. */ static void IDABBDPrecFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define uround (IDA_mem->ida_uround) #define vec_tmpl (IDA_mem->ida_tempv1) /* * ----------------------------------------------------------------- * User-Callable Functions : malloc, reinit and free * ----------------------------------------------------------------- */ int IDABBDPrecInit(void *ida_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; N_Vector tempv4; long int muk, mlk, storage_mu; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if one of the SPILS linear solvers has been attached */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } /* Allocate data memory. */ pdata = NULL; pdata = (IBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set pointers to glocal and gcomm; load half-bandwidths. */ pdata->ida_mem = IDA_mem; pdata->glocal = Gres; pdata->gcomm = Gcomm; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); muk = MIN(Nlocal-1, MAX(0, mukeep)); mlk = MIN(Nlocal-1, MAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting). */ storage_mu = MIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix. */ pdata->PP = NULL; pdata->PP = NewBandMat(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Allocate memory for lpivots. */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(Nlocal); if (pdata->lpivots == NULL) { DestroyMat(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Allocate tempv4 for use by IBBDDQJac */ tempv4 = NULL; tempv4 = N_VClone(vec_tmpl); if (tempv4 == NULL){ DestroyMat(pdata->PP); DestroyArray(pdata->lpivots); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } pdata->tempv4 = tempv4; /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); /* Store Nlocal to be used in IDABBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge. */ pdata->rpwsize = Nlocal*(mlk + storage_mu + 1); pdata->ipwsize = Nlocal; pdata->nge = 0; /* Overwrite the pdata field in the SPILS memory */ idaspils_mem->s_pdata = pdata; /* Attach the pfree function */ idaspils_mem->s_pfree = IDABBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve); return(flag); } int IDABBDPrecReInit(void *ida_mem, long int mudq, long int mldq, realtype dq_rel_yy) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; long int Nlocal; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if one of the SPILS linear solvers has been attached */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; /* Test if the preconditioner data is non-NULL */ if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; /* Load half-bandwidths. */ Nlocal = pdata->n_local; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); /* Re-initialize nge */ pdata->nge = 0; return(IDASPILS_SUCCESS); } int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(IDASPILS_SUCCESS); } int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; *ngevalsBBDP = pdata->nge; return(IDASPILS_SUCCESS); } /* Readability Replacements */ #define Nlocal (pdata->n_local) #define mudq (pdata->mudq) #define mldq (pdata->mldq) #define mukeep (pdata->mukeep) #define mlkeep (pdata->mlkeep) #define glocal (pdata->glocal) #define gcomm (pdata->gcomm) #define lpivots (pdata->lpivots) #define PP (pdata->PP) #define tempv4 (pdata->tempv4) #define nge (pdata->nge) #define rel_yy (pdata->rel_yy) /* * ----------------------------------------------------------------- * Function : IDABBDPrecSetup * ----------------------------------------------------------------- * IDABBDPrecSetup generates a band-block-diagonal preconditioner * matrix, where the local block (on this processor) is a band * matrix. Each local block is computed by a difference quotient * scheme via calls to the user-supplied routines glocal, gcomm. * After generating the block in the band matrix PP, this routine * does an LU factorization in place in PP. * * The IDABBDPrecSetup parameters used here are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * bbd_data is the pointer to BBD data set by IDABBDInit. * * tmp1, tmp2, tmp3 are pointers to vectors of type * N_Vector, used for temporary storage or * work space. * * The arguments Neq, rr, res, uround, and nrePtr are not used. * * Return value: * The value returned by this IDABBDPrecSetup function is a int * flag indicating whether it was successful. This value is * 0 if successful, * > 0 for a recoverable error (step will be retried), or * < 0 for a nonrecoverable error (step fails). * ----------------------------------------------------------------- */ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *bbd_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { int retval; long int ier; IBBDPrecData pdata; IDAMem IDA_mem; pdata =(IBBDPrecData) bbd_data; IDA_mem = (IDAMem) pdata->ida_mem; /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ SetToZero(PP); retval = IBBDDQJac(pdata, tt, c_j, yy, yp, tempv1, tempv2, tempv3, tempv4); if (retval < 0) { IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(+1); } /* Do LU factorization of preconditioner block in place (in PP). */ ier = BandGBTRF(PP, lpivots); /* Return 0 if the LU was complete, or +1 otherwise. */ if (ier > 0) return(+1); return(0); } /* * ----------------------------------------------------------------- * Function: IDABBDPrecSolve * ----------------------------------------------------------------- * The function IDABBDPrecSolve computes a solution to the linear * system P z = r, where P is the left preconditioner defined by * the routine IDABBDPrecSetup. * * The IDABBDPrecSolve parameters used here are as follows: * * rvec is the input right-hand side vector r. * * zvec is the computed solution vector z. * * bbd_data is the pointer to BBD data set by IDABBDInit. * * The arguments tt, yy, yp, rr, c_j, delta, and tmp are NOT used. * * IDABBDPrecSolve always returns 0, indicating success. * ----------------------------------------------------------------- */ static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *bbd_data, N_Vector tmp) { IBBDPrecData pdata; realtype *zd; pdata = (IBBDPrecData) bbd_data; /* Copy rvec to zvec, do the backsolve, and return. */ N_VScale(ONE, rvec, zvec); zd = N_VGetArrayPointer(zvec); BandGBTRS(PP, lpivots, zd); return(0); } static void IDABBDPrecFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (IDA_mem->ida_lmem == NULL) return; idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) return; pdata = (IBBDPrecData) idaspils_mem->s_pdata; DestroyMat(PP); DestroyArray(lpivots); N_VDestroy(tempv4); free(pdata); pdata = NULL; } #define ewt (IDA_mem->ida_ewt) #define user_data (IDA_mem->ida_user_data) #define hh (IDA_mem->ida_hh) #define constraints (IDA_mem->ida_constraints) /* * ----------------------------------------------------------------- * IBBDDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation * to the local block of the Jacobian of G(t,y,y'). It assumes that * a band matrix of type BandMat is stored column-wise, and that * elements within each column are contiguous. * * All matrix elements are generated as difference quotients, by way * of calls to the user routine glocal. By virtue of the band * structure, the number of these calls is bandwidth + 1, where * bandwidth = mldq + mudq + 1. But the band matrix kept has * bandwidth = mlkeep + mukeep + 1. This routine also assumes that * the local elements of a vector are stored contiguously. * * Return values are: 0 (success), > 0 (recoverable error), * or < 0 (nonrecoverable error). * ----------------------------------------------------------------- */ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) { IDAMem IDA_mem; realtype inc, inc_inv; int retval; long int group, i, j, width, ngroups, i1, i2; realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; realtype *cnsdata = NULL, *ewtdata; realtype *col_j, conj, yj, ypj, ewtj; IDA_mem = (IDAMem) pdata->ida_mem; /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Obtain pointers as required to the data array of vectors. */ ydata = N_VGetArrayPointer(yy); ypdata = N_VGetArrayPointer(yp); gtempdata = N_VGetArrayPointer(gtemp); ewtdata = N_VGetArrayPointer(ewt); if (constraints != NULL) cnsdata = N_VGetArrayPointer(constraints); ytempdata = N_VGetArrayPointer(ytemp); yptempdata= N_VGetArrayPointer(yptemp); grefdata = N_VGetArrayPointer(gref); /* Call gcomm and glocal to get base value of G(t,y,y'). */ if (gcomm != NULL) { retval = gcomm(Nlocal, tt, yy, yp, user_data); if (retval != 0) return(retval); } retval = glocal(Nlocal, tt, yy, yp, gref, user_data); nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing. */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups. */ for(group = 1; group <= ngroups; group++) { /* Loop over the components in this group. */ for(j = group-1; j < Nlocal; j += width) { yj = ydata[j]; ypj = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc to yj based on rel_yy*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment yj and ypj. */ ytempdata[j] += inc; yptempdata[j] += cj*inc; } /* Evaluate G with incremented y and yp arguments. */ retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, user_data); nge++; if (retval != 0) return(retval); /* Loop over components of the group again; restore ytemp and yptemp. */ for(j = group-1; j < Nlocal; j += width) { yj = ytempdata[j] = ydata[j]; ypj = yptempdata[j] = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc as before .*/ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Form difference quotients and load into PP. */ inc_inv = ONE/inc; col_j = BAND_COL(PP,j); i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtempdata[i] - grefdata[i]); } } return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Readability replacements */ #define yyTmp (IDAADJ_mem->ia_yyTmp) #define ypTmp (IDAADJ_mem->ia_ypTmp) #define noInterp (IDAADJ_mem->ia_noInterp) /* * ---------------------------------------------------------------- * User-callable functions * ---------------------------------------------------------------- */ int IDABBDPrecInitB(void *ida_mem, int which, long int NlocalB, long int mudqB, long int mldqB, long int mukeepB, long int mlkeepB, realtype dq_rel_yyB, IDABBDLocalFnB glocalB, IDABBDCommFnB gcommB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecInitB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDABBDPRE", "IDABBDPrecInitB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDABBDPRE", "IDABBDPrecInitB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Initialize the BBD preconditioner for this backward problem. */ flag = IDABBDPrecInit(ida_memB, NlocalB, mudqB, mldqB, mukeepB, mlkeepB, dq_rel_yyB, IDAAglocal, IDAAgcomm); if (flag != IDA_SUCCESS) return(flag); /* Allocate memory for IDABBDPrecDataB to store the user-provided * functions which will be called from the wrappers */ idabbdB_mem = NULL; idabbdB_mem = (IDABBDPrecDataB) malloc(sizeof(* idabbdB_mem)); if (idabbdB_mem == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInitB", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } idabbdB_mem->glocalB = glocalB; idabbdB_mem->gcommB = gcommB; /* Attach pmem */ IDAB_mem->ida_pmem = idabbdB_mem; /* Attach deallocation routine pfree. */ IDAB_mem->ida_pfree = IDABBDPrecFreeB; return(IDASPILS_SUCCESS); } int IDABBDPrecReInitB(void *ida_mem, int which, long int mudqB, long int mldqB, realtype dq_rel_yyB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecReInitB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDABBDPRE", "IDABBDPrecReInitB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDABBDPRE", "IDABBDPrecReInitB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' backward problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; flag = IDABBDPrecReInit(ida_memB, mudqB, mldqB, dq_rel_yyB); return(flag); } static void IDABBDPrecFreeB(IDABMem IDAB_mem) { free(IDAB_mem->ida_pmem); IDAB_mem->ida_pmem = NULL; } /* * ---------------------------------------------------------------- * Wrapper functions * ---------------------------------------------------------------- */ /* * IDAAglocal * * This routine interfaces to the IDALocalFnB routine * provided by the user. */ static int IDAAglocal(long int NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get the preconditioner's memory. */ idabbdB_mem = (IDABBDPrecDataB) IDAB_mem->ida_pmem; /* Get forward solution from interpolation. */ if (noInterp == FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDAAglocal", MSGBBD_BAD_T); return(-1); } } /* Call user's adjoint LocalFnB function. */ return idabbdB_mem->glocalB(NlocalB, tt, yyTmp, ypTmp, yyB, ypB, gvalB, IDAB_mem->ida_user_data); } /* * IDAAgcomm * * This routine interfaces to the IDACommFnB routine * provided by the user. */ static int IDAAgcomm(long int NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get the preconditioner's memory. */ idabbdB_mem = (IDABBDPrecDataB) IDAB_mem->ida_pmem; if (idabbdB_mem->gcommB == NULL) return(0); /* Get forward solution from interpolation. */ if (noInterp == FALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDAAgcomm", MSGBBD_BAD_T); return(-1); } } /* Call user's adjoint CommFnB routine */ return idabbdB_mem->gcommB(NlocalB, tt, yyTmp, ypTmp, yyB, ypB, IDAB_mem->ida_user_data); } sundials-2.5.0/src/idas/idaa_io.c0000600000175000017500000004746611741421242017471 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:41:48 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the adjoint module in the IDAS solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "idas_impl.h" #include /* * ================================================================= * IDAA PRIVATE CONSTANTS * ================================================================= */ #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Readibility Constants * ----------------------------------------------------------------- */ #define nbckpbs (IDAADJ_mem->ia_nbckpbs) /* * ----------------------------------------------------------------- * Optional input functions for ASA * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * IDAAdjSetNoSensi * ----------------------------------------------------------------- * Disables the forward sensitivity analysis in IDASolveF. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAAdjSetNoSensi(void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjSetNoSensi", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAAdjSetNoSensi", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; IDAADJ_mem->ia_storeSensi = FALSE; return(IDA_SUCCESS); } int IDASetUserDataB(void *ida_mem, int which, void *user_dataB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetUserDataB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetUserDataB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetUserDataB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Set user data for this backward problem. */ IDAB_mem->ida_user_data = user_dataB; return(IDA_SUCCESS); } int IDASetMaxOrdB(void *ida_mem, int which, int maxordB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxOrdB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxOrdB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxOrdB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxOrd(ida_memB, maxordB); } int IDASetMaxNumStepsB(void *ida_mem, int which, long int mxstepsB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxNumStepsB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxNumStepsB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxNumStepsB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxNumSteps(ida_memB, mxstepsB); } int IDASetInitStepB(void *ida_mem, int which, realtype hinB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetInitStepB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetInitStepB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetInitStepB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetInitStep(ida_memB, hinB); } int IDASetMaxStepB(void *ida_mem, int which, realtype hmaxB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxStepB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxStepB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxStepB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxStep(ida_memB, hmaxB); } int IDASetSuppressAlgB(void *ida_mem, int which, booleantype suppressalgB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetSuppressAlgB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetSuppressAlgB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetSuppressAlgB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetSuppressAlg(ida_memB, suppressalgB); } int IDASetIdB(void *ida_mem, int which, N_Vector idB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetIdB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetIdB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetIdB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetId(ida_memB, idB); } int IDASetConstraintsB(void *ida_mem, int which, N_Vector constraintsB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetConstraintsB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetConstraintsB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetConstraintsB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetConstraints(ida_memB, constraintsB); } /* * ---------------------------------------------------------------- * Input quadrature functions for ASA * ---------------------------------------------------------------- */ int IDASetQuadErrConB(void *ida_mem, int which, int errconQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetQuadErrConB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetQuadErrConB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetQuadErrConB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetQuadErrCon(ida_memB, errconQB); } /* * ----------------------------------------------------------------- * Optional output functions for backward integration * ----------------------------------------------------------------- */ /* * IDAGetAdjIDABmem * * This function returns a (void *) pointer to the IDAS * memory allocated for the backward problem. This pointer can * then be used to call any of the IDAGet* IDAS routines to * extract optional output for the backward integration phase. */ SUNDIALS_EXPORT void *IDAGetAdjIDABmem(void *ida_mem, int which) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_NULL_IDAMEM); return(NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_NO_ADJ); return(NULL); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_BAD_WHICH); return(NULL); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return(ida_memB); } /* * IDAGetAdjCheckPointsInfo * * Loads an array of nckpnts structures of type IDAadjCheckPointRec * defined below. * * The user must allocate space for ckpnt (ncheck+1). */ int IDAGetAdjCheckPointsInfo(void *ida_mem, IDAadjCheckPointRec *ckpnt) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; CkpntMem ck_mem; int i; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjCheckPointsInfo", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjCheckPointsInfo", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; i=0; ck_mem = IDAADJ_mem->ck_mem; while (ck_mem != NULL) { ckpnt[i].my_addr = (void *) ck_mem; ckpnt[i].next_addr = (void *) ck_mem->ck_next; ckpnt[i].t0 = ck_mem->ck_t0; ckpnt[i].t1 = ck_mem->ck_t1; ckpnt[i].nstep = ck_mem->ck_nst; ckpnt[i].order = ck_mem->ck_kk; ckpnt[i].step = ck_mem->ck_hh; ck_mem = ck_mem->ck_next; i++; } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDAGetAdjDataPointHermite * ----------------------------------------------------------------- * Returns the 2 vectors stored for cubic Hermite interpolation at * the data point 'which'. The user must allocate space for yy and * yd. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_HERMITE or * IDA_SUCCESS otherwise. * */ int IDAGetAdjDataPointHermite(void *ida_mem, int which, realtype *t, N_Vector yy, N_Vector yd) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; if (IDAADJ_mem->ia_interpType != IDA_HERMITE) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_WRONG_INTERP); return(IDA_ILL_INPUT); } *t = dt_mem[which]->t; content = (HermiteDataMem) dt_mem[which]->content; if (yy != NULL) N_VScale(ONE, content->y, yy); if (yd != NULL) N_VScale(ONE, content->yd, yd); return(IDA_SUCCESS); } /* * IDAGetAdjDataPointPolynomial * * Returns the vector stored for polynomial interpolation at the * data point 'which'. The user must allocate space for y. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_POLYNOMIAL or * IDA_SUCCESS otherwise. */ int IDAGetAdjDataPointPolynomial(void *ida_mem, int which, realtype *t, int *order, N_Vector y) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; if (IDAADJ_mem->ia_interpType != IDA_POLYNOMIAL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_WRONG_INTERP); return(IDA_ILL_INPUT); } *t = dt_mem[which]->t; content = (PolynomialDataMem) dt_mem[which]->content; if (y != NULL) N_VScale(ONE, content->y, y); *order = content->order; return(IDA_SUCCESS); } /* * IDAGetAdjCurrentCheckPoint * * Returns the address of the 'active' check point. */ SUNDIALS_EXPORT int IDAGetAdjCurrentCheckPoint(void *ida_mem, void **addr) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjCurrentCheckPoint", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjCurrentCheckPoint", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; *addr = (void *) IDAADJ_mem->ia_ckpntData; return(IDA_SUCCESS); } /* IDAGetConsistenICB * * Returns the consistent initial conditions computed by IDACalcICB or * IDACalcICBS * * It must be preceded by a successful call to IDACalcICB or IDACalcICBS * for 'which' backward problem. */ int IDAGetConsistentICB(void *ida_mem, int which, N_Vector yyB0_mod, N_Vector ypB0_mod) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetConsistenICB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetConsistenICB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetConsistenICB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; flag = IDAGetConsistentIC(ida_memB, yyB0_mod, ypB0_mod); return(flag); } sundials-2.5.0/src/idas/README0000600000175000017500000001137611741421242016607 0ustar sylvestresylvestre IDAS Release 1.1.0, March 2012 Radu Serban Center for Applied Scientific Computing, LLNL IDAS is a package for the solution of differential-algebraic equation (DAE) systems with sensitivity analysis capabilities (both forward and adjoint modes). It is written in ANSI standard C. IDAS can be used both on serial and parallel (MPI) computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel version, communication between processors is done with the MPI (Message Passage Interface) system. When used with the serial NVECTOR module, IDAS provides both direct (dense and band) linear solvers and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When IDAS is used with the parallel NVECTOR module, only the Krylov linear solvers are available. For the latter case, in addition to the basic solver, the IDA package also contains a preconditioner module called IDABBDPRE, which provides a band-block-diagonal preconditioner. IDAS is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers [3]. This suite consists of CVODE, CVODES, IDA, IDAS, and KINSOL. The directory structure of the package supplied reflects this family relationship. Several examples problem programs are included, covering both serial and parallel cases, both small and large problem sizes, and both linear and nonlinear problems. The notes below provide the location of documentation, directions for the installation of the IDAS package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/idas/ contains PDF files for the IDAS User Guide [1] (idas_guide.pdf) and the IDAS Examples [2] (idas_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_NOTES. For complete installation instructions see the "IDAS Installation Procedure" chapter in the IDAS User Guide. C. References ------------- [1] R. Serban and C. Petra, "User Documentation for IDAS v1.1.0," LLNL technical report UCRL-SM-234051, December 2011. [2] R. Serban, "Example Programs for IDAS v1.1.0," LLNL technical report LLNL-TR-437091, December 2011. [3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 1.1.0 - Mar. 2012 v. 1.0.0 - May 2009 E. Revision History ------------------- v. 1.6.0 (May 2009) ---> v. 1.1.0 (Mar. 2012) --------------------------------------------- - Bug fixes - errors in the logic for the integration of backward problems were identified and fixed. - a missing vector pointer setting was added in IDASensLineSrch. - in IDACompleteStep, conditionals around lines loading a new column of three auxiliary divided difference arrays, for a possible order increase, were fixed. - after the solver memory is created, it is set to zero before being filled. - in each linear solver interface function, the linear solver memory is freed on an error return, and the **Free function now includes a line setting to NULL the main memory pointer to the linear solver memory. - a memory leak was fixed in two of the IDASp***Free functions. - in rootfinding functions IDARcheck1/IDARcheck2, when an exact zero is found, the array glo at the left endpoint is adjusted instead of shifting tlo. - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag, have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. - in a minor change to the user interface, the type of the index which in IDAS was changed from long int to int. - in the installation files, we modified the treatment of the macro SUNDIALS_USE_GENERIC_MATH, so that the parameter GENERIC_MATH_LIB is either defined (with no value) or not defined. sundials-2.5.0/src/idas/idas_dense.c0000600000175000017500000002647611741421242020200 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.14 $ * $Date: 2011/03/23 21:12:45 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDASDENSE linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "idas_direct_impl.h" #include "idas_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* IDASDENSE linit, lsetup, lsolve, and lfree routines */ static int IDADenseInit(IDAMem IDA_mem); static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur); static int IDADenseFree(IDAMem IDA_mem); /* IDADENSE lfreeB function */ static void IDADenseFreeB(IDABMem IDAB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define res (IDA_mem->ida_res) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define mtype (idadls_mem->d_type) #define neq (idadls_mem->d_n) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define JJ (idadls_mem->d_J) #define lpivots (idadls_mem->d_lpivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define jacdata (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ----------------------------------------------------------------- * IDADense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDADENSE linear solver module. * IDADense first calls the existing lfree routine if this is not NULL. * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDADenseInit, IDADenseSetup, * IDADenseSolve, NULL, and IDADenseFree, respectively. * It allocates memory for a structure of type IDADlsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jdata field * in the IDADlsMemRec structure to be the input parameter jdata, * and sets the d_jac field to be: * (1) the input parameter djac, if djac != NULL, or * (2) IDADenseDQJac, if djac == NULL. * Finally, it allocates memory for JJ and lpivots. * The return value is IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, * or IDADLS_ILL_INPUT = -2. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDADense will first * test for a compatible N_Vector internal * representation by checking that the functions N_VGetArrayPointer * and N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ int IDADense(void *ida_mem, long int Neq) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDENSE", "IDADense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if(vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASDENSE", "IDADense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) flag = lfree(IDA_mem); /* Set five main function fields in IDA_mem. */ linit = IDADenseInit; lsetup = IDADenseSetup; lsolve = IDADenseSolve; lperf = NULL; lfree = IDADenseFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASDENSE", "IDADense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewDenseMat(Neq, Neq); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASDENSE", "IDADense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(Neq); if (lpivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASDENSE", "IDADense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDADENSE interface functions * ----------------------------------------------------------------- */ /* This routine does remaining initializations specific to the IDADENSE linear solver module. It returns 0. */ static int IDADenseInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { djac = idaDlsDenseDQJac; jacdata = IDA_mem; } else { jacdata = IDA_mem->ida_user_data; } last_flag = 0; return(0); } /* This routine does the setup operations for the IDADENSE linear solver module. It calls the Jacobian evaluation routine, updates counters, and calls the dense LU factorization routine. The return value is either IDADLS_SUCCESS = 0 if successful, +1 if the jac routine failed recoverably or the LU factorization failed, or -1 if the jac routine failed unrecoverably. */ static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASDENSE", "IDADenseSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = DenseGETRF(JJ, lpivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); } /* This routine handles the solve operation for the IDADENSE linear solver module. It calls the dense backsolve routine, scales the solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. */ static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur) { IDADlsMem idadls_mem; realtype *bd; idadls_mem = (IDADlsMem) lmem; bd = N_VGetArrayPointer(b); DenseGETRS(JJ, lpivots, bd); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); last_flag = 0; return(0); } /* This routine frees memory specific to the IDADENSE linear solver. */ static int IDADenseFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(lpivots); free(lmem); lmem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * IDADenseB is a wrapper around IDADense. */ int IDADenseB(void *ida_mem, int which, long int NeqB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; void *ida_memB; int flag; /* Is ida_mem allright? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDENSE", "IDADenseB", MSGD_CAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASDENSE", "IDADenseB", MSGD_NO_ADJ); return(IDADLS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASDENSE", "IDADenseB", MSGD_BAD_WHICH); return(IDADLS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Alloc memory for IDADlsMemRecB */ idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB)); if (idadlsB_mem == NULL) { IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASDENSE", "IDADenseB", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* set matrix type and initialize Jacob function. */ idadlsB_mem->d_typeB = SUNDIALS_DENSE; idadlsB_mem->d_bjacB = NULL; /* Attach lmemB data and lfreeB function. */ IDAB_mem->ida_lmem = idadlsB_mem; IDAB_mem->ida_lfree = IDADenseFreeB; /* Call IDADense to the IDAS data of the backward problem. */ ida_memB = (void *)IDAB_mem->IDA_mem; flag = IDADense(ida_memB, NeqB); if (flag != IDADLS_SUCCESS) { free(idadlsB_mem); idadlsB_mem = NULL; } return(flag); } /* * IDADenseFreeB frees the linear solver's memory for that backward problem passed * as argument. */ static void IDADenseFreeB(IDABMem IDAB_mem) { IDADlsMemB idadlsB_mem; idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; free(idadlsB_mem); } sundials-2.5.0/src/ida/0000755000175000017500000000000011767174700015560 5ustar sylvestresylvestresundials-2.5.0/src/ida/ida_spils_impl.h0000600000175000017500000001466211741421215020706 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:35:26 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the common header file (private version) for the Scaled * Preconditioned Iterative Linear Solver modules. * ----------------------------------------------------------------- */ #ifndef _IDASPILS_IMPL_H #define _IDASPILS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "ida_impl.h" /* Types of iterative linear solvers */ #define SPILS_SPGMR 1 #define SPILS_SPBCG 2 #define SPILS_SPTFQMR 3 /* Constants */ #define IDA_SPILS_MAXL 5 #define IDA_SPILS_MAXRS 5 /* * ----------------------------------------------------------------- * Types : IDASpilsMemRec, IDASpilsMem * ----------------------------------------------------------------- */ typedef struct IDASpilsMemRec { int s_type; /* type of scaled preconditioned iterative LS */ int s_gstype; /* type of Gram-Schmidt orthogonalization */ realtype s_sqrtN; /* sqrt(N) */ int s_maxl; /* maxl = maximum dimension of the Krylov space */ int s_maxrs; /* maxrs = max. number of GMRES restarts */ realtype s_eplifac; /* eplifac = linear convergence factor */ realtype s_dqincfac; /* dqincfac = optional increment factor in Jv */ realtype s_epslin; /* SpgrmSolve tolerance parameter */ long int s_npe; /* npe = total number of precond calls */ long int s_nli; /* nli = total number of linear iterations */ long int s_nps; /* nps = total number of psolve calls */ long int s_ncfl; /* ncfl = total number of convergence failures */ long int s_nres; /* nres = total number of calls to res */ long int s_njtimes; /* njtimes = total number of calls to jtimes */ long int s_nst0; /* nst0 = saved nst (for performance monitor) */ long int s_nni0; /* nni0 = saved nni (for performance monitor) */ long int s_nli0; /* nli0 = saved nli (for performance monitor) */ long int s_ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ long int s_ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ long int s_nwarn; /* nwarn = no. of warnings (for perf. monitor) */ N_Vector s_ytemp; /* temp vector used by IDAAtimesDQ */ N_Vector s_yptemp; /* temp vector used by IDAAtimesDQ */ N_Vector s_xx; /* temp vector used by the solve function */ N_Vector s_ycur; /* current y vector in Newton iteration */ N_Vector s_ypcur; /* current yp vector in Newton iteration */ N_Vector s_rcur; /* rcur = F(tn, ycur, ypcur) */ void *s_spils_mem; /* memory used by the generic solver */ long int s_last_flag; /* last error return flag */ /* Preconditioner computation * (a) user-provided: * - pdata == user_data * - pfree == NULL (the user dealocates memory for f_data) * (b) internal preconditioner module * - pdata == ida_mem * - pfree == set by the prec. module and called in IDASpilsFree */ IDASpilsPrecSetupFn s_pset; IDASpilsPrecSolveFn s_psolve; void (*s_pfree)(IDAMem IDA_mem); void *s_pdata; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - jdata == user_data * - jtimesDQ == FALSE * (b) internal jtimes * - jdata == ida_mem * - jtimesDQ == TRUE */ booleantype s_jtimesDQ; IDASpilsJacTimesVecFn s_jtimes; void *s_jdata; } *IDASpilsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ /* Atimes and PSolve routines called by generic solver */ int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z); int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr); /* Difference quotient approximation for Jac times vector */ int IDASpilsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *data, N_Vector work1, N_Vector work2); /* * ----------------------------------------------------------------- * Error and Warning Messages * ----------------------------------------------------------------- */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSGS_TIME "at t = %Lg, " #define MSGS_FRMT "%Le." #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSGS_TIME "at t = %lg, " #define MSGS_FRMT "%le." #else #define MSGS_TIME "at t = %g, " #define MSGS_FRMT "%e." #endif /* Error Messages */ #define MSGS_IDAMEM_NULL "Integrator memory is NULL." #define MSGS_MEM_FAIL "A memory request failed." #define MSGS_BAD_NVECTOR "A required vector operation is not implemented." #define MSGS_BAD_LSTYPE "Incompatible linear solver type." #define MSGS_LMEM_NULL "Linear solver memory is NULL." #define MSGS_BAD_GSTYPE "gstype has an illegal value." #define MSGS_NEG_MAXRS "maxrs < 0 illegal." #define MSGS_NEG_EPLIFAC "eplifac < 0.0 illegal." #define MSGS_NEG_DQINCFAC "dqincfac < 0.0 illegal." #define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." /* Warning Messages */ #define MSGS_WARN "Warning: " MSGS_TIME "poor iterative algorithm performance. " #define MSGS_AVD_WARN MSGS_WARN "Average number of linear iterations is " MSGS_FRMT #define MSGS_CFN_WARN MSGS_WARN "Nonlinear convergence failure rate is " MSGS_FRMT #define MSGS_CFL_WARN MSGS_WARN "Linear convergence failure rate is " MSGS_FRMT #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/ida_sptfqmr.c0000600000175000017500000003524111741421215020216 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2007/11/26 16:20:00 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDA scaled preconditioned * TFQMR linear solver module, IDASPTFQMR. * ----------------------------------------------------------------- */ #include #include #include #include "ida_spils_impl.h" #include "ida_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPTFQMR linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASptfqmrInit(IDAMem IDA_mem); static int IDASptfqmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask); static int IDASptfqmrFree(IDAMem IDA_mem); /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : IDASptfqmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDASPTFQMR linear solver module. * * IDASptfqmr first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASptfqmrInit, IDASptfqmrSetup, * IDASptfqmrSolve, IDASptfqmrPerf, and IDASptfqmrFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then sets various fields * in the IDASpilsMemRec structure. Finally, IDASptfqmr allocates * memory for ytemp, yptemp, and xx, and calls SptfqmrMalloc to * allocate memory for the Sptfqmr solver. * * The return value of IDASptfqmr is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory * allocation failed * IDASPILS_ILL_INPUT = -2 if a required vector operation is not * implemented. * ----------------------------------------------------------------- */ int IDASptfqmr(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPTFQMR", "IDASptfqmr", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPTFQMR", "IDASptfqmr", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASptfqmrInit; lsetup = IDASptfqmrSetup; lsolve = IDASptfqmrSolve; lperf = IDASptfqmrPerf; lfree = IDASptfqmrFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPTFQMR; /* Set SPTFQMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Sptfqmr parameters */ idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ sptfqmr_mem = NULL; sptfqmr_mem = SptfqmrMalloc(maxl1, vec_tmpl); if (sptfqmr_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPTFQMR", "IDASptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPTFQMR memory to spils memory structure */ spils_mem = (void *)sptfqmr_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPTFQMR interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define maxl (idaspils_mem->s_maxl) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASptfqmrInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; idaspils_mem = (IDASpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } /* Set maxl in the SPTFQMR memory in case it was changed by the user */ sptfqmr_mem->l_max = maxl; last_flag = IDASPILS_SUCCESS; return(0); } static int IDASptfqmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; if (retval < 0) { IDAProcessError(IDA_mem, SPTFQMR_PSET_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSetup", MSGS_PSET_FAILED); last_flag = SPTFQMR_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPTFQMR_PSET_FAIL_REC; return(+1); } last_flag = SPTFQMR_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : IDASptfqmrSolve * ----------------------------------------------------------------- * Note: The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SptfqmrSolve. * We copy the solution x into b, and update the counters nli, nps, * and ncfl. If SptfqmrSolve returned nli_inc = 0 (hence x = 0), we * take the SPTFQMR vtemp vector (= P_inverse F) as the correction * vector instead. Finally, we set the return value according to the * success of SptfqmrSolve. * ----------------------------------------------------------------- */ static int IDASptfqmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; sptfqmr_mem = (SptfqmrMem)spils_mem; /* Set SptfqmrSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the TFQMR convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SptfqmrSolve inputs pretype and initial guess xx = 0 */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SptfqmrSolve and copy xx to bb */ retval = SptfqmrSolve(sptfqmr_mem, IDA_mem, xx, bb, pretype, epslin, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); if (nli_inc == 0) N_VScale(ONE, SPTFQMR_VTEMP(sptfqmr_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful */ nli += nli_inc; nps += nps_inc; if (retval != SPTFQMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPTFQMR_SUCCESS: return(0); break; case SPTFQMR_RES_REDUCED: return(1); break; case SPTFQMR_CONV_FAIL: return(1); break; case SPTFQMR_PSOLVE_FAIL_REC: return(1); break; case SPTFQMR_ATIMES_FAIL_REC: return(1); break; case SPTFQMR_MEM_NULL: return(-1); break; case SPTFQMR_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPTFQMR_ATIMES_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPTFQMR_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "IDASPTFQMR", "IDASptfqmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : IDASptfqmrPerf * ----------------------------------------------------------------- * This routine handles performance monitoring specific to the * IDASPTFQMR linear solver. When perftask = 0, it saves values of * various counters. When perftask = 1, it examines difference * quotients in these counters, and depending on their values, it * prints up to three warning messages. Messages are printed up to * a maximum of 10 times. * ----------------------------------------------------------------- */ static int IDASptfqmrPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl)); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPTFQMR", "IDASptfqmrPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASptfqmrFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SptfqmrMem sptfqmr_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); sptfqmr_mem = (SptfqmrMem)spils_mem; SptfqmrFree(sptfqmr_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } sundials-2.5.0/src/ida/ida_impl.h0000600000175000017500000005710611741421215017474 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.15 $ * $Date: 2009/09/09 22:25:05 $ * ----------------------------------------------------------------- * Programmer(s): Allan G. Taylor, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file (private version) for the main IDA solver. * ----------------------------------------------------------------- */ #ifndef _IDA_IMPL_H #define _IDA_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* Basic IDA constants */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MAXORD_DEFAULT 5 /* maxord default value */ #define MXORDP1 6 /* max. number of N_Vectors in phi */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* * ---------------------------------------------------------------- * Types : struct IDAMemRec, IDAMem * ---------------------------------------------------------------- * The type IDAMem is type pointer to struct IDAMemRec. This * structure contains fields to keep track of problem state. * ---------------------------------------------------------------- */ typedef struct IDAMemRec { realtype ida_uround; /* machine unit roundoff */ /* Problem Specification Data */ IDAResFn ida_res; /* F(t,y(t),y'(t))=0; the function F */ void *ida_user_data; /* user pointer passed to res */ int ida_itol; /* itol = IDA_SS, IDA_SV, IDA_WF, IDA_NN */ realtype ida_rtol; /* relative tolerance */ realtype ida_Satol; /* scalar absolute tolerance */ N_Vector ida_Vatol; /* vector absolute tolerance */ booleantype ida_user_efun; /* TRUE if user provides efun */ IDAEwtFn ida_efun; /* function to set ewt */ void *ida_edata; /* user pointer passed to efun */ booleantype ida_setupNonNull; /* Does setup do something? */ booleantype ida_constraintsSet; /* constraints vector present: do constraints calc */ booleantype ida_suppressalg; /* true means suppress algebraic vars in local error tests */ /* Divided differences array and associated minor arrays */ N_Vector ida_phi[MXORDP1]; /* phi = (maxord+1) arrays of divided differences */ realtype ida_psi[MXORDP1]; /* differences in t (sums of recent step sizes) */ realtype ida_alpha[MXORDP1]; /* ratios of current stepsize to psi values */ realtype ida_beta[MXORDP1]; /* ratios of current to previous product of psi's */ realtype ida_sigma[MXORDP1]; /* product successive alpha values and factorial */ realtype ida_gamma[MXORDP1]; /* sum of reciprocals of psi values */ /* N_Vectors */ N_Vector ida_ewt; /* error weight vector */ N_Vector ida_yy; /* work space for y vector (= user's yret) */ N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ N_Vector ida_delta; /* residual vector */ N_Vector ida_id; /* bit vector for diff./algebraic components */ N_Vector ida_constraints; /* vector of inequality constraint options */ N_Vector ida_savres; /* saved residual vector (= tempv1) */ N_Vector ida_ee; /* accumulated corrections to y vector, but set equal to estimated local errors upon successful return */ N_Vector ida_mm; /* mask vector in constraints tests (= tempv2) */ N_Vector ida_tempv1; /* work space vector */ N_Vector ida_tempv2; /* work space vector */ N_Vector ida_ynew; /* work vector for y in IDACalcIC (= tempv2) */ N_Vector ida_ypnew; /* work vector for yp in IDACalcIC (= ee) */ N_Vector ida_delnew; /* work vector for delta in IDACalcIC (= phi[2]) */ N_Vector ida_dtemp; /* work vector in IDACalcIC (= phi[3]) */ /* Variables for use by IDACalcIC*/ realtype ida_t0; /* initial t */ N_Vector ida_yy0; /* initial y vector (user-supplied). */ N_Vector ida_yp0; /* initial y' vector (user-supplied). */ int ida_icopt; /* IC calculation user option */ booleantype ida_lsoff; /* IC calculation linesearch turnoff option */ int ida_maxnh; /* max. number of h tries in IC calculation */ int ida_maxnj; /* max. number of J tries in IC calculation */ int ida_maxnit; /* max. number of Netwon iterations in IC calc. */ int ida_nbacktr; /* number of IC linesearch backtrack operations */ int ida_sysindex; /* computed system index (0 or 1) */ realtype ida_epiccon; /* IC nonlinear convergence test constant */ realtype ida_steptol; /* minimum Newton step size in IC calculation */ realtype ida_tscale; /* time scale factor = abs(tout1 - t0) */ /* Tstop information */ booleantype ida_tstopset; realtype ida_tstop; /* Step Data */ int ida_kk; /* current BDF method order */ int ida_kused; /* method order used on last successful step */ int ida_knew; /* order for next step from order decrease decision */ int ida_phase; /* flag to trigger step doubling in first few steps */ int ida_ns; /* counts steps at fixed stepsize and order */ realtype ida_hin; /* initial step */ realtype ida_h0u; /* actual initial stepsize */ realtype ida_hh; /* current step size h */ realtype ida_hused; /* step size used on last successful step */ realtype ida_rr; /* rr = hnext / hused */ realtype ida_tn; /* current internal value of t */ realtype ida_tretlast; /* value of tret previously returned by IDASolve */ realtype ida_cj; /* current value of scalar (-alphas/hh) in Jacobian */ realtype ida_cjlast; /* cj value saved from last successful step */ realtype ida_cjold; /* cj value saved from last call to lsetup */ realtype ida_cjratio; /* ratio of cj values: cj/cjold */ realtype ida_ss; /* scalar used in Newton iteration convergence test */ realtype ida_epsNewt; /* test constant in Newton convergence test */ realtype ida_epcon; /* coeficient of the Newton covergence test */ realtype ida_toldel; /* tolerance in direct test on Newton corrections */ /* Limits */ int ida_maxncf; /* max numer of convergence failures */ int ida_maxcor; /* max number of Newton corrections */ int ida_maxnef; /* max number of error test failures */ int ida_maxord; /* max value of method order k: */ int ida_maxord_alloc; /* value of maxord used when allocating memory */ long int ida_mxstep; /* max number of internal steps for one user call */ realtype ida_hmax_inv; /* inverse of max. step size hmax (default = 0.0) */ /* Counters */ long int ida_nst; /* number of internal steps taken */ long int ida_nre; /* number of function (res) calls */ long int ida_ncfn; /* number of corrector convergence failures */ long int ida_netf; /* number of error test failures */ long int ida_nni; /* number of Newton iterations performed */ long int ida_nsetups; /* number of lsetup calls */ /* Space requirements for IDA */ long int ida_lrw1; /* no. of realtype words in 1 N_Vector */ long int ida_liw1; /* no. of integer words in 1 N_Vector */ long int ida_lrw; /* number of realtype words in IDA work vectors */ long int ida_liw; /* no. of integer words in IDA work vectors */ realtype ida_tolsf; /* tolerance scale factor (saved value) */ /* Error handler function and error ouput file */ IDAErrHandlerFn ida_ehfun; /* Error messages are handled by ehfun */ void *ida_eh_data; /* dats pointer passed to ehfun */ FILE *ida_errfp; /* IDA error messages are sent to errfp */ /* Flags to verify correct calling sequence */ booleantype ida_SetupDone; /* set to FALSE by IDAMalloc and IDAReInit set to TRUE by IDACalcIC or IDASolve */ booleantype ida_VatolMallocDone; booleantype ida_constraintsMallocDone; booleantype ida_idMallocDone; booleantype ida_MallocDone; /* set to FALSE by IDACreate set to TRUE by IDAMAlloc tested by IDAReInit and IDASolve */ /* Linear Solver Data */ /* Linear Solver functions to be called */ int (*ida_linit)(struct IDAMemRec *idamem); int (*ida_lsetup)(struct IDAMemRec *idamem, N_Vector yyp, N_Vector ypp, N_Vector resp, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); int (*ida_lsolve)(struct IDAMemRec *idamem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rescur); int (*ida_lperf)(struct IDAMemRec *idamem, int perftask); int (*ida_lfree)(struct IDAMemRec *idamem); /* Linear Solver specific memory */ void *ida_lmem; /* Flag to indicate successful ida_linit call */ booleantype ida_linitOK; /* Rootfinding Data */ IDARootFn ida_gfun; /* Function g for roots sought */ int ida_nrtfn; /* number of components of g */ int *ida_iroots; /* array for root information */ int *ida_rootdir; /* array specifying direction of zero-crossing */ realtype ida_tlo; /* nearest endpoint of interval in root search */ realtype ida_thi; /* farthest endpoint of interval in root search */ realtype ida_trout; /* t return value from rootfinder routine */ realtype *ida_glo; /* saved array of g values at t = tlo */ realtype *ida_ghi; /* saved array of g values at t = thi */ realtype *ida_grout; /* array of g values at t = trout */ realtype ida_toutc; /* copy of tout (if NORMAL mode) */ realtype ida_ttol; /* tolerance on root location */ int ida_taskc; /* copy of parameter itask */ int ida_irfnd; /* flag showing whether last step had a root */ long int ida_nge; /* counter for g evaluations */ booleantype *ida_gactive; /* array with active/inactive event functions */ int ida_mxgnull; /* number of warning messages about possible g==0 */ } *IDAMem; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * int (*ida_linit)(IDAMem IDA_mem); * ----------------------------------------------------------------- * The purpose of ida_linit is to allocate memory for the * solver-specific fields in the structure *(idamem->ida_lmem) and * perform any needed initializations of solver-specific memory, * such as counters/statistics. An (*ida_linit) should return * 0 if it has successfully initialized the IDA linear solver and * a non-zero value otherwise. If an error does occur, an appropriate * message should be sent to the error handler function. * ---------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsetup)(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, * N_Vector resp, * N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); * ----------------------------------------------------------------- * The job of ida_lsetup is to prepare the linear solver for * subsequent calls to ida_lsolve. Its parameters are as follows: * * idamem - problem memory pointer of type IDAMem. See the big * typedef earlier in this file. * * * yyp - the predicted y vector for the current IDA internal * step. * * ypp - the predicted y' vector for the current IDA internal * step. * * resp - F(tn, yyp, ypp). * * tempv1, tempv2, tempv3 - temporary N_Vectors provided for use * by ida_lsetup. * * The ida_lsetup routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsolve)(IDAMem IDA_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector ypcur, N_Vector rescur); * ----------------------------------------------------------------- * ida_lsolve must solve the linear equation P x = b, where * P is some approximation to the system Jacobian * J = (dF/dy) + cj (dF/dy') * evaluated at (tn,ycur,ypcur) and the RHS vector b is input. * The N-vector ycur contains the solver's current approximation * to y(tn), ypcur contains that for y'(tn), and the vector rescur * contains the N-vector residual F(tn,ycur,ypcur). * The solution is to be returned in the vector b. * * The ida_lsolve routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lperf)(IDAMem IDA_mem, int perftask); * ----------------------------------------------------------------- * ida_lperf is called two places in IDA where linear solver * performance data is required by IDA. For perftask = 0, an * initialization of performance variables is performed, while for * perftask = 1, the performance is evaluated. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lfree)(IDAMem IDA_mem); * ----------------------------------------------------------------- * ida_lfree should free up any memory allocated by the linear * solver. This routine is called once a problem has been * completed and the linear solver is no longer needed. * ----------------------------------------------------------------- */ /* * ================================================================= * I D A I N T E R N A L F U N C T I O N S * ================================================================= */ /* Prototype of internal ewtSet function */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* * ================================================================= * I D A E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg, " #define MSG_TIME_H "t = %Lg and h = %Lg, " #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg, " #define MSG_TIME_H "t = %lg and h = %lg, " #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g, " #define MSG_TIME_H "t = %g and h = %g, " #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* General errors */ #define MSG_MEM_FAIL "A memory request failed." #define MSG_NO_MEM "ida_mem = NULL illegal." #define MSG_NO_MALLOC "Attempt to call before IDAMalloc." #define MSG_BAD_NVECTOR "A required vector operation is not implemented." /* Initialization errors */ #define MSG_Y0_NULL "y0 = NULL illegal." #define MSG_YP0_NULL "yp0 = NULL illegal." #define MSG_BAD_ITOL "Illegal value for itol. The legal values are IDA_SS, IDA_SV, and IDA_WF." #define MSG_RES_NULL "res = NULL illegal." #define MSG_BAD_RTOL "reltol < 0 illegal." #define MSG_ATOL_NULL "abstol = NULL illegal." #define MSG_BAD_ATOL "Some abstol component < 0.0 illegal." #define MSG_ROOT_FUNC_NULL "g = NULL illegal." #define MSG_MISSING_ID "id = NULL but suppressalg option on." #define MSG_NO_TOLS "No integration tolerances have been specified." #define MSG_FAIL_EWT "The user-provide EwtSet function failed." #define MSG_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." #define MSG_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSG_LINIT_FAIL "The linear solver's init routine failed." /* IDACalcIC error messages */ #define MSG_IC_BAD_ICOPT "icopt has an illegal value." #define MSG_IC_MISSING_ID "id = NULL conflicts with icopt." #define MSG_IC_TOO_CLOSE "tout1 too close to t0 to attempt initial condition calculation." #define MSG_IC_BAD_ID "id has illegal values." #define MSG_IC_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_IC_RES_NONREC "The residual function failed unrecoverably. " #define MSG_IC_RES_FAIL "The residual function failed at the first call. " #define MSG_IC_SETUP_FAIL "The linear solver setup failed unrecoverably." #define MSG_IC_SOLVE_FAIL "The linear solver solve failed unrecoverably." #define MSG_IC_NO_RECOVERY "The residual routine or the linear setup or solve routine had a recoverable error, but IDACalcIC was unable to recover." #define MSG_IC_FAIL_CONSTR "Unable to satisfy the inequality constraints." #define MSG_IC_FAILED_LINS "The linesearch algorithm failed with too small a step." #define MSG_IC_CONV_FAILED "Newton/Linesearch algorithm failed to converge." /* IDASolve error messages */ #define MSG_YRET_NULL "yret = NULL illegal." #define MSG_YPRET_NULL "ypret = NULL illegal." #define MSG_TRET_NULL "tret = NULL illegal." #define MSG_BAD_ITASK "itask has an illegal value." #define MSG_TOO_CLOSE "tout too close to t0 to start integration." #define MSG_BAD_HINIT "Initial step is not towards tout." #define MSG_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME "in the direction of integration." #define MSG_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSG_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSG_EWT_NOW_FAIL "At " MSG_TIME "the user-provide EwtSet function failed." #define MSG_EWT_NOW_BAD "At " MSG_TIME "some ewt component has become <= 0.0." #define MSG_TOO_MUCH_ACC "At " MSG_TIME "too much accuracy requested." #define MSG_BAD_K "Illegal value for k." #define MSG_NULL_DKY "dky = NULL illegal." #define MSG_BAD_T "Illegal value for t." MSG_TIME_INT #define MSG_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration." #define MSG_ERR_FAILS "At " MSG_TIME_H "the error test failed repeatedly or with |h| = hmin." #define MSG_CONV_FAILS "At " MSG_TIME_H "the corrector convergence failed repeatedly or with |h| = hmin." #define MSG_SETUP_FAILED "At " MSG_TIME "the linear solver setup failed unrecoverably." #define MSG_SOLVE_FAILED "At " MSG_TIME "the linear solver solve failed unrecoverably." #define MSG_REP_RES_ERR "At " MSG_TIME "repeated recoverable residual errors." #define MSG_RES_NONRECOV "At " MSG_TIME "the residual function failed unrecoverably." #define MSG_FAILED_CONSTR "At " MSG_TIME "unable to satisfy inequality constraints." #define MSG_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSG_NO_ROOT "Rootfinding was not initialized." #define MSG_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." /* IDASet* / IDAGet* error messages */ #define MSG_NEG_MAXORD "maxord <= 0 illegal." #define MSG_BAD_MAXORD "Illegal attempt to increase maximum order." #define MSG_NEG_HMAX "hmax < 0 illegal." #define MSG_NEG_EPCON "epcon <= 0.0 illegal." #define MSG_BAD_CONSTR "Illegal values in constraints vector." #define MSG_BAD_EPICCON "epiccon <= 0.0 illegal." #define MSG_BAD_MAXNH "maxnh <= 0 illegal." #define MSG_BAD_MAXNJ "maxnj <= 0 illegal." #define MSG_BAD_MAXNIT "maxnit <= 0 illegal." #define MSG_BAD_STEPTOL "steptol <= 0.0 illegal." #define MSG_TOO_LATE "IDAGetConsistentIC can only be called before IDASolve." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/CMakeLists.txt0000600000175000017500000000671611741421215020306 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:48 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the IDA library INSTALL(CODE "MESSAGE(\"\nInstall IDA\n\")") # Add variable ida_SOURCES with the sources for the IDA library SET(ida_SOURCES ida.c ida_io.c ida_ic.c ida_direct.c ida_band.c ida_dense.c ida_spils.c ida_spbcgs.c ida_spgmr.c ida_sptfqmr.c ida_bbdpre.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the IDA library SET(shared_SOURCES sundials_nvector.c sundials_math.c sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_spbcgs.c sundials_spgmr.c sundials_sptfqmr.c ) # Add prefix with complete path to the common SUNDIALS sources ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable ida_HEADERS with the exported IDA header files SET(ida_HEADERS ida_band.h ida_bbdpre.h ida_dense.h ida_direct.h ida.h ida_spbcgs.h ida_spgmr.h ida_spils.h ida_sptfqmr.h ) # Add prefix with complete path to the IDA header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/ida/ ida_HEADERS) # If Blas/Lapack support was enabled, set-up additional file lists IF(LAPACK_FOUND) SET(ida_BL_SOURCES ida_lapack.c) SET(ida_BL_HEADERS ida_lapack.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/ida/ ida_BL_HEADERS) ELSE(LAPACK_FOUND) SET(ida_BL_SOURCES "") SET(ida_BL_HEADERS "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static IDA library ADD_LIBRARY(sundials_ida_static STATIC ${ida_SOURCES} ${ida_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_ida_static PROPERTIES OUTPUT_NAME sundials_ida CLEAN_DIRECT_OUTPUT 1) # Install the IDA library INSTALL(TARGETS sundials_ida_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the IDA library ADD_LIBRARY(sundials_ida_shared SHARED ${ida_SOURCES} ${ida_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_ida_shared PROPERTIES OUTPUT_NAME sundials_ida CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_ida_shared PROPERTIES VERSION ${idalib_VERSION} SOVERSION ${idalib_SOVERSION}) # Install the IDA library INSTALL(TARGETS sundials_ida_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the IDA header files INSTALL(FILES ${ida_HEADERS} ${ida_BL_HEADERS} DESTINATION include/ida) # Install the IDA implementation header file INSTALL(FILES ida_impl.h DESTINATION include/ida) # MESSAGE(STATUS "Added IDA module") sundials-2.5.0/src/ida/Makefile.in0000600000175000017500000001520011741421215017577 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDA module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include LIB_REVISION = 2:0:0 IDA_LIB = libsundials_ida.la IDA_SRC_FILES = ida.c ida_ic.c ida_io.c ida_direct.c ida_dense.c ida_band.c ida_spils.c ida_spbcgs.c ida_spgmr.c ida_sptfqmr.c ida_bbdpre.c IDA_BL_SRC_FILES = ida_lapack.c IDA_OBJ_FILES = $(IDA_SRC_FILES:.c=.o) IDA_BL_OBJ_FILES = $(IDA_BL_SRC_FILES:.c=.o) IDA_LIB_FILES = $(IDA_SRC_FILES:.c=.lo) IDA_BL_LIB_FILES = $(IDA_BL_SRC_FILES:.c=.lo) SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ $(top_builddir)/src/sundials/sundials_dense.lo \ $(top_builddir)/src/sundials/sundials_direct.lo \ $(top_builddir)/src/sundials/sundials_iterative.lo \ $(top_builddir)/src/sundials/sundials_spgmr.lo \ $(top_builddir)/src/sundials/sundials_spbcgs.lo \ $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ $(top_builddir)/src/sundials/sundials_math.lo \ $(top_builddir)/src/sundials/sundials_nvector.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(IDA_LIB) $(IDA_LIB): shared $(IDA_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: shared $(IDA_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDA_LIB) $(IDA_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) lib_with_bl: shared $(IDA_LIB_FILES) $(IDA_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(IDA_LIB) $(IDA_LIB_FILES) $(IDA_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) install: $(IDA_LIB) $(mkinstalldirs) $(includedir)/ida $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(IDA_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_direct.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_dense.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_band.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spbcgs.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spgmr.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_sptfqmr.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_bbdpre.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_spils.h $(includedir)/ida/ $(INSTALL_HEADER) $(top_srcdir)/src/ida/ida_impl.h $(includedir)/ida/ @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ $(INSTALL_HEADER) $(top_srcdir)/include/ida/ida_lapack.h $(includedir)/ida/ ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(IDA_LIB) rm -f $(includedir)/ida/ida.h rm -f $(includedir)/ida/ida_direct.h rm -f $(includedir)/ida/ida_dense.h rm -f $(includedir)/ida/ida_band.h rm -f $(includedir)/ida/ida_lapack.h rm -f $(includedir)/ida/ida_spbcgs.h rm -f $(includedir)/ida/ida_spgmr.h rm -f $(includedir)/ida/ida_sptfqmr.h rm -f $(includedir)/ida/ida_bbdpre.h rm -f $(includedir)/ida/ida_spils.h rm -f $(includedir)/ida/ida_impl.h $(rminstalldirs) ${includedir}/ida shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(IDA_LIB) rm -f $(IDA_LIB_FILES) rm -f $(IDA_BL_LIB_FILES) rm -f $(IDA_OBJ_FILES) rm -f $(IDA_BL_OBJ_FILES) distclean: clean rm -f Makefile ida.lo: $(srcdir)/ida.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida.c ida_ic.lo: $(srcdir)/ida_ic.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_ic.c ida_io.lo: $(srcdir)/ida_io.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_io.c ida_direct.lo: $(srcdir)/ida_direct.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_direct.c ida_dense.lo: $(srcdir)/ida_dense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_dense.c ida_band.lo: $(srcdir)/ida_band.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_band.c ida_lapack.lo: $(srcdir)/ida_lapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_lapack.c ida_spils.lo: $(srcdir)/ida_spils.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spils.c ida_spbcgs.lo: $(srcdir)/ida_spbcgs.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spbcgs.c ida_spgmr.lo: $(srcdir)/ida_spgmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_spgmr.c ida_sptfqmr.lo: $(srcdir)/ida_sptfqmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_sptfqmr.c ida_bbdpre.lo: $(srcdir)/ida_bbdpre.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/ida_bbdpre.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/ida/ida_dense.c0000600000175000017500000002140611741421215017616 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 20:44:01 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDADENSE linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "ida_direct_impl.h" #include "ida_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* IDADENSE linit, lsetup, lsolve, and lfree routines */ static int IDADenseInit(IDAMem IDA_mem); static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur); static int IDADenseFree(IDAMem IDA_mem); /* Readability Replacements */ #define res (IDA_mem->ida_res) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define mtype (idadls_mem->d_type) #define neq (idadls_mem->d_n) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define JJ (idadls_mem->d_J) #define lpivots (idadls_mem->d_lpivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define jacdata (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ----------------------------------------------------------------- * IDADense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDADENSE linear solver module. * IDADense first calls the existing lfree routine if this is not NULL. * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDADenseInit, IDADenseSetup, * IDADenseSolve, NULL, and IDADenseFree, respectively. * It allocates memory for a structure of type IDADlsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jdata field * in the IDADlsMemRec structure to be the input parameter jdata, * and sets the d_jac field to be: * (1) the input parameter djac, if djac != NULL, or * (2) IDADenseDQJac, if djac == NULL. * Finally, it allocates memory for JJ and lpivots. * The return value is IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, * or IDADLS_ILL_INPUT = -2. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDADense will first * test for a compatible N_Vector internal * representation by checking that the functions N_VGetArrayPointer * and N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ int IDADense(void *ida_mem, long int Neq) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADENSE", "IDADense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if(vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDADENSE", "IDADense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) flag = lfree(IDA_mem); /* Set five main function fields in IDA_mem. */ linit = IDADenseInit; lsetup = IDADenseSetup; lsolve = IDADenseSolve; lperf = NULL; lfree = IDADenseFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewDenseMat(Neq, Neq); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(Neq); if (lpivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDADENSE interface functions * ----------------------------------------------------------------- */ /* This routine does remaining initializations specific to the IDADENSE linear solver module. It returns 0. */ static int IDADenseInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { djac = idaDlsDenseDQJac; jacdata = IDA_mem; } else { jacdata = IDA_mem->ida_user_data; } last_flag = 0; return(0); } /* This routine does the setup operations for the IDADENSE linear solver module. It calls the Jacobian evaluation routine, updates counters, and calls the dense LU factorization routine. The return value is either IDADLS_SUCCESS = 0 if successful, +1 if the jac routine failed recoverably or the LU factorization failed, or -1 if the jac routine failed unrecoverably. */ static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDADENSE", "IDADenseSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = DenseGETRF(JJ, lpivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); } /* This routine handles the solve operation for the IDADENSE linear solver module. It calls the dense backsolve routine, scales the solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. */ static int IDADenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur) { IDADlsMem idadls_mem; realtype *bd; idadls_mem = (IDADlsMem) lmem; bd = N_VGetArrayPointer(b); DenseGETRS(JJ, lpivots, bd); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); last_flag = 0; return(0); } /* This routine frees memory specific to the IDADENSE linear solver. */ static int IDADenseFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(lpivots); free(lmem); lmem = NULL; return(0); } sundials-2.5.0/src/ida/ida_spbcgs.c0000600000175000017500000003476711741421215020017 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2011/05/25 20:20:25 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDA scaled preconditioned * Bi-CGSTAB linear solver module, IDASPBCG. * ----------------------------------------------------------------- */ #include #include #include #include "ida_spils_impl.h" #include "ida_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPBCG linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASpbcgInit(IDAMem IDA_mem); static int IDASpbcgSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASpbcgPerf(IDAMem IDA_mem, int perftask); static int IDASpbcgFree(IDAMem IDA_mem); /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : IDASpbcg * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDASPBCG linear solver module. * * IDASpbcg first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASpbcgInit, IDASpbcgSetup, * IDASpbcgSolve, IDASpbcgPerf, and IDASpbcgFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then sets various fields * in the IDASpilsMemRec structure. Finally, IDASpbcg allocates memory * for ytemp, yptemp, and xx, and calls SpbcgMalloc to allocate memory * for the Spbcg solver. * * The return value of IDASpbcg is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory * allocation failed * IDASPILS_ILL_INPUT = -2 if a required vector operation is not * implemented. * ----------------------------------------------------------------- */ int IDASpbcg(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASpbcgInit; lsetup = IDASpbcgSetup; lsolve = IDASpbcgSolve; lperf = IDASpbcgPerf; lfree = IDASpbcgFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPBCG; /* Set SPBCG parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Spbcg parameters */ idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SpbcgMalloc to allocate workspace for Spbcg */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl); if (spbcg_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *)spbcg_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPBCG interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define maxl (idaspils_mem->s_maxl) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASpbcgInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; idaspils_mem = (IDASpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } /* Set maxl in the SPBCG memory in case it was changed by the user */ spbcg_mem->l_max = maxl; last_flag = IDASPILS_SUCCESS; return(0); } static int IDASpbcgSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; if (retval < 0) { IDAProcessError(IDA_mem, SPBCG_PSET_FAIL_UNREC, "IDASPBCG", "IDASpbcgSetup", MSGS_PSET_FAILED); last_flag = SPBCG_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPBCG_PSET_FAIL_REC; return(+1); } last_flag = SPBCG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : IDASpbcgSolve * ----------------------------------------------------------------- * Note: The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SpbcgSolve. * We copy the solution x into b, and update the counters nli, nps, * and ncfl. If SpbcgSolve returned nli_inc = 0 (hence x = 0), we * take the SPBCG vtemp vector (= P_inverse F) as the correction * vector instead. Finally, we set the return value according to the * success of SpbcgSolve. * ----------------------------------------------------------------- */ static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; spbcg_mem = (SpbcgMem)spils_mem; /* Set SpbcgSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SpbcgSolve inputs pretype and initial guess xx = 0 */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SpbcgSolve and copy xx to bb */ retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful */ nli += nli_inc; nps += nps_inc; if (retval != SPBCG_SUCCESS) ncfl++; /* Interpret return value from SpbcgSolve */ last_flag = retval; switch(retval) { case SPBCG_SUCCESS: return(0); break; case SPBCG_RES_REDUCED: return(1); break; case SPBCG_CONV_FAIL: return(1); break; case SPBCG_PSOLVE_FAIL_REC: return(1); break; case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_MEM_NULL: return(-1); break; case SPBCG_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPBCG_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : IDASpbcgPerf * ----------------------------------------------------------------- * This routine handles performance monitoring specific to the * IDASPBCG linear solver. When perftask = 0, it saves values of * various counters. When perftask = 1, it examines difference * quotients in these counters, and depending on their values, it * prints up to three warning messages. Messages are printed up to * a maximum of 10 times. * ----------------------------------------------------------------- */ static int IDASpbcgPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl)); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPBCG", "IDASpbcgPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASpbcgFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); spbcg_mem = (SpbcgMem)spils_mem; SpbcgFree(spbcg_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } sundials-2.5.0/src/ida/ida_io.c0000600000175000017500000006270311741421215017134 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.15 $ * $Date: 2010/12/01 22:35:26 $ * ----------------------------------------------------------------- * Programmer(s): Alan Hindmarsh, Radu Serban and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the implementation file for the optional inputs and * outputs for the IDA solver. * ----------------------------------------------------------------- */ #include #include #include "ida_impl.h" #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWOPT5 RCONST(2.5) /* * ================================================================= * IDA optional input functions * ================================================================= */ /* * Readability constants */ #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrHandlerFn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_ehfun = ehfun; IDA_mem->ida_eh_data = eh_data; return(IDA_SUCCESS); } int IDASetErrFile(void *ida_mem, FILE *errfp) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetErrFile", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_errfp = errfp; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetUserData(void *ida_mem, void *user_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetUserData", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_user_data = user_data; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxOrd(void *ida_mem, int maxord) { IDAMem IDA_mem; int maxord_alloc; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxOrd", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxord <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_NEG_MAXORD); return(IDA_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ maxord_alloc = IDA_mem->ida_maxord_alloc; if (maxord > maxord_alloc) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxOrd", MSG_BAD_MAXORD); return(IDA_ILL_INPUT); } IDA_mem->ida_maxord = MIN(maxord,MAXORD_DEFAULT); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) IDA_mem->ida_mxstep = MXSTEP_DEFAULT; else IDA_mem->ida_mxstep = mxsteps; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetInitStep(void *ida_mem, realtype hin) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_hin = hin; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxStep(void *ida_mem, realtype hmax) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (hmax < 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxStep", MSG_NEG_HMAX); return(IDA_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; return(IDA_SUCCESS); } IDA_mem->ida_hmax_inv = ONE/hmax; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStopTime(void *ida_mem, realtype tstop) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStopTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* If IDASolve was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If IDASetStopTime is called before the first call to IDASolve, * tstop will be checked in IDASolve. */ if (IDA_mem->ida_nst > 0) { if ( (tstop - IDA_mem->ida_tn) * IDA_mem->ida_hh < ZERO ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStopTime", MSG_BAD_TSTOP, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } } IDA_mem->ida_tstop = tstop; IDA_mem->ida_tstopset = TRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoef", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epcon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoef", MSG_NEG_EPCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epcon = epcon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxErrTestFails(void *ida_mem, int maxnef) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxErrTestFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxnef = maxnef; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxConvFails(void *ida_mem, int maxncf) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxConvFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxncf = maxncf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNonlinIters(void *ida_mem, int maxcor) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNonlinIters", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxcor = maxcor; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetSuppressAlg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_suppressalg = suppressalg; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetId(void *ida_mem, N_Vector id) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetId", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (id == NULL) { if (IDA_mem->ida_idMallocDone) { N_VDestroy(IDA_mem->ida_id); lrw -= lrw1; liw -= liw1; } IDA_mem->ida_idMallocDone = FALSE; return(IDA_SUCCESS); } if ( !(IDA_mem->ida_idMallocDone) ) { IDA_mem->ida_id = N_VClone(id); lrw += lrw1; liw += liw1; IDA_mem->ida_idMallocDone = TRUE; } /* Load the id vector */ N_VScale(ONE, id, IDA_mem->ida_id); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetConstraints(void *ida_mem, N_Vector constraints) { IDAMem IDA_mem; realtype temptest; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetConstraints", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (constraints == NULL) { if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(IDA_mem->ida_constraints); lrw -= lrw1; liw -= liw1; } IDA_mem->ida_constraintsMallocDone = FALSE; IDA_mem->ida_constraintsSet = FALSE; return(IDA_SUCCESS); } /* Test if required vector ops. are defined */ if (constraints->ops->nvdiv == NULL || constraints->ops->nvmaxnorm == NULL || constraints->ops->nvcompare == NULL || constraints->ops->nvconstrmask == NULL || constraints->ops->nvminquotient == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if((temptest > TWOPT5) || (temptest < HALF)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetConstraints", MSG_BAD_CONSTR); return(IDA_ILL_INPUT); } if ( !(IDA_mem->ida_constraintsMallocDone) ) { IDA_mem->ida_constraints = N_VClone(constraints); lrw += lrw1; liw += liw1; IDA_mem->ida_constraintsMallocDone = TRUE; } /* Load the constraints vector */ N_VScale(ONE, constraints, IDA_mem->ida_constraints); IDA_mem->ida_constraintsSet = TRUE; return(IDA_SUCCESS); } /* * IDASetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int IDASetRootDirection(void *ida_mem, int *rootdir) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetRootDirection", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; if (nrt==0) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDA", "IDASetRootDirection", MSG_NO_ROOT); return(IDA_ILL_INPUT); } for(i=0; iida_rootdir[i] = rootdir[i]; return(IDA_SUCCESS); } /* * IDASetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int IDASetNoInactiveRootWarn(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNoInactiveRootWarn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_mxgnull = 0; return(IDA_SUCCESS); } /* * ================================================================= * IDA IC optional input functions * ================================================================= */ int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinConvCoefIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epiccon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinConvCoefIC", MSG_BAD_EPICCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epiccon = epiccon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumStepsIC(void *ida_mem, int maxnh) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumStepsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnh <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumStepsIC", MSG_BAD_MAXNH); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnh = maxnh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumJacsIC(void *ida_mem, int maxnj) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumJacsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnj <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumJacsIC", MSG_BAD_MAXNJ); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnj = maxnj; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumItersIC(void *ida_mem, int maxnit) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumItersIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnit <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxNumItersIC", MSG_BAD_MAXNIT); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnit = maxnit; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetLineSearchOffIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_lsoff = lsoff; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStepToleranceIC(void *ida_mem, realtype steptol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetStepToleranceIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (steptol <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStepToleranceIC", MSG_BAD_STEPTOL); return(IDA_ILL_INPUT); } IDA_mem->ida_steptol = steptol; return(IDA_SUCCESS); } /* * ================================================================= * Readability constants * ================================================================= */ #define ewt (IDA_mem->ida_ewt) #define kk (IDA_mem->ida_kk) #define hh (IDA_mem->ida_hh) #define h0u (IDA_mem->ida_h0u) #define tn (IDA_mem->ida_tn) #define nbacktr (IDA_mem->ida_nbacktr) #define nst (IDA_mem->ida_nst) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define netf (IDA_mem->ida_netf) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) #define kused (IDA_mem->ida_kused) #define hused (IDA_mem->ida_hused) #define tolsf (IDA_mem->ida_tolsf) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define nge (IDA_mem->ida_nge) #define iroots (IDA_mem->ida_iroots) #define ee (IDA_mem->ida_ee) /* * ================================================================= * IDA optional input functions * ================================================================= */ int IDAGetNumSteps(void *ida_mem, long int *nsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = nst; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumResEvals(void *ida_mem, long int *nrevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumResEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nrevals = nre; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumLinSolvSetups", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nlinsetups = nsetups; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *netfails = netf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumBacktrackOps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nbacktracks = nbacktr; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetConsistentIC(void *ida_mem, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetConsistentIC", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_kused != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAGetConsistentIC", MSG_TOO_LATE); return(IDA_ILL_INPUT); } if(yy0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[0], yy0); if(yp0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[1], yp0); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastOrder(void *ida_mem, int *klast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *klast = kused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentOrder(void *ida_mem, int *kcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *kcur = kk; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetActualInitStep(void *ida_mem, realtype *hinused) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetActualInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hinused = h0u; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastStep(void *ida_mem, realtype *hlast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetLastStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hlast = hused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentStep(void *ida_mem, realtype *hcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hcur = hh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentTime(void *ida_mem, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetCurrentTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tcur = tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetTolScaleFactor", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tolsfact = tolsf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetErrWeights(void *ida_mem, N_Vector eweight) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetErrWeights", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, ewt, eweight); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetEstLocalErrors", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, ee, ele); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetWorkSpace", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *leniw = liw; *lenrw = lrw; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *klast, int *kcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetIntegratorStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = nst; *nrevals = nre; *nlinsetups = nsetups; *netfails = netf; *klast = kused; *kcur = kk; *hinused = h0u; *hlast = hused; *hcur = hh; *tcur = tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumGEvals(void *ida_mem, long int *ngevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetNumGEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *ngevals = nge; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetRootInfo(void *ida_mem, int *rootsfound) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetRootInfo", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; for (i=0; i #include /* * ----------------------------------------------------------------- * Definition of IBBDPrecData * ----------------------------------------------------------------- */ typedef struct IBBDPrecDataRec { /* passed by user to IDABBDPrecAlloc and used by IDABBDPrecSetup/IDABBDPrecSolve functions */ long int mudq, mldq, mukeep, mlkeep; realtype rel_yy; IDABBDLocalFn glocal; IDABBDCommFn gcomm; /* allocated for use by IDABBDPrecSetup */ N_Vector tempv4; /* set by IDABBDPrecon and used by IDABBDPrecSolve */ DlsMat PP; long int *lpivots; /* set by IDABBDPrecAlloc and used by IDABBDPrecSetup */ long int n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to ida_mem */ void *ida_mem; } *IBBDPrecData; /* * ----------------------------------------------------------------- * IDABBDPRE error messages * ----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The Glocal or Gcomm routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/ida_spils.c0000600000175000017500000004164411741421215017660 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:35:26 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the common implementation file for the IDA Scaled * Preconditioned Linear Solver modules. * ----------------------------------------------------------------- */ #include #include #include "ida_impl.h" #include "ida_spils_impl.h" /* Private constants */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define PT05 RCONST(0.05) #define ONE RCONST(1.0) /* Algorithmic constants */ #define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ /* Readability Replacements */ #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define lmem (IDA_mem->ida_lmem) #define ils_type (idaspils_mem->s_type) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT * ----------------------------------------------------------------- */ int IDASpilsSetGSType(void *ida_mem, int gstype) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetGSType", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetGSType", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type != SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetGSType", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetGSType", MSGS_BAD_GSTYPE); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_gstype = gstype; return(IDASPILS_SUCCESS); } int IDASpilsSetMaxRestarts(void *ida_mem, int maxrs) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type != SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } /* Check for legal maxrs */ if (maxrs < 0) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxRestarts", MSGS_NEG_MAXRS); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_maxrs = maxrs; return(IDASPILS_SUCCESS); } int IDASpilsSetMaxl(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetMaxl", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetMaxl", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (ils_type == SPILS_SPGMR) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetMaxl", MSGS_BAD_LSTYPE); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_maxl = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; return(IDASPILS_SUCCESS); } int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetEpsLin", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetEpsLin", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; /* Check for legal maxrs */ if (eplifac < ZERO) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetEpsLin", MSGS_NEG_EPLIFAC); return(IDASPILS_ILL_INPUT); } if (eplifac == ZERO) idaspils_mem->s_eplifac = PT05; else idaspils_mem->s_eplifac = eplifac; return(IDASPILS_SUCCESS); } int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; /* Check for legal maxrs */ if (dqincfac <= ZERO) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPILS", "IDASpilsSetIncrementFactor", MSGS_NEG_DQINCFAC); return(IDASPILS_ILL_INPUT); } idaspils_mem->s_dqincfac = dqincfac; return(IDASPILS_SUCCESS); } int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetPreconditioner", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetPreconditioner", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; idaspils_mem->s_pset = pset; idaspils_mem->s_psolve = psolve; return(IDASPILS_SUCCESS); } int IDASpilsSetJacTimesVecFn(void *ida_mem, IDASpilsJacTimesVecFn jtv) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsSetJacTimesVecFn", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsSetJacTimesVecFn", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; if (jtv != NULL) { jtimesDQ = FALSE; jtimes = jtv; } else { jtimesDQ = TRUE; } return(IDASPILS_SUCCESS); } int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int maxl; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetWorkSpace", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetWorkSpace", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: maxl = idaspils_mem->s_maxl; *lenrwLS = lrw1*(maxl + 6) + maxl*(maxl + 4) + 1; *leniwLS = liw1*(maxl + 6); break; case SPILS_SPBCG: *lenrwLS = lrw1 * 10; *leniwLS = liw1 * 10; break; case SPILS_SPTFQMR: *lenrwLS = lrw1*13; *leniwLS = liw1*13; break; } return(IDASPILS_SUCCESS); } int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumPrecEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumPrecEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *npevals = npe; return(IDASPILS_SUCCESS); } int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumPrecSolves", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumPrecSolves", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *npsolves = nps; return(IDASPILS_SUCCESS); } int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumLinIters", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumLinIters", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nliters = nli; return(IDASPILS_SUCCESS); } int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumConvFails", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumConvFails", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nlcfails = ncfl; return(IDASPILS_SUCCESS); } int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumJtimesEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumJtimesEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *njvevals = njtimes; return(IDASPILS_SUCCESS); } int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetNumResEvals", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetNumResEvals", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *nrevalsLS = nres; return(IDASPILS_SUCCESS); } int IDASpilsGetLastFlag(void *ida_mem, long int *flag) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPILS", "IDASpilsGetLastFlag", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDASPILS", "IDASpilsGetLastFlag", MSGS_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) lmem; *flag = last_flag; return(IDASPILS_SUCCESS); } char *IDASpilsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case IDASPILS_SUCCESS: sprintf(name,"IDASPILS_SUCCESS"); break; case IDASPILS_MEM_NULL: sprintf(name,"IDASPILS_MEM_NULL"); break; case IDASPILS_LMEM_NULL: sprintf(name,"IDASPILS_LMEM_NULL"); break; case IDASPILS_ILL_INPUT: sprintf(name,"IDASPILS_ILL_INPUT"); break; case IDASPILS_MEM_FAIL: sprintf(name,"IDASPILS_MEM_FAIL"); break; case IDASPILS_PMEM_NULL: sprintf(name,"IDASPILS_PMEM_NULL"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * IDASPILS private functions * ----------------------------------------------------------------- */ #define psolve (idaspils_mem->s_psolve) #define pdata (idaspils_mem->s_pdata) #define dqincfac (idaspils_mem->s_dqincfac) /* * This routine generates the matrix-vector product z = Jv, where * J is the system Jacobian, by calling either the user provided * routine or the internal DQ routine. */ int IDASpilsAtimes(void *ida_mem, N_Vector v, N_Vector z) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int jtflag; IDA_mem = (IDAMem) ida_mem; idaspils_mem = (IDASpilsMem) lmem; jtflag = jtimes(tn, ycur, ypcur, rcur, v, z, cj, jdata, ytemp, yptemp); njtimes++; return(jtflag); } /* * This routine interfaces between the generic Solve routine and * the user's psolve routine. It passes to psolve all required state * information from ida_mem. Its return value is the same as that * returned by psolve. Note that the generic solver guarantees * that IDASilsPSolve will not be called in the case psolve = NULL. */ int IDASpilsPSolve(void *ida_mem, N_Vector r, N_Vector z, int lr) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; int retval; IDA_mem = (IDAMem) ida_mem; idaspils_mem = (IDASpilsMem) lmem; retval = psolve(tn, ycur, ypcur, rcur, r, z, cj, epslin, pdata, ytemp); /* This call is counted in nps within the IDASp**Solve routine */ return(retval); } /* * This routine generates the matrix-vector product z = Jv, where * J is the system Jacobian, by using a difference quotient approximation. * The approximation is * Jv = [F(t,y1,yp1) - F(t,y,yp)]/sigma, where * y1 = y + sigma*v, yp1 = yp + cj*sigma*v, * sigma = sqrt(Neq)*dqincfac. * The return value from the call to res is saved in order to set the * return flag from IDASp**Solve. */ int IDASpilsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *data, N_Vector work1, N_Vector work2) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; N_Vector y_tmp, yp_tmp; realtype sig, siginv; int iter, retval; /* data is ida_mem */ IDA_mem = (IDAMem) data; idaspils_mem = (IDASpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: sig = sqrtN*dqincfac; break; case SPILS_SPBCG: sig = dqincfac/N_VWrmsNorm(v, ewt); break; case SPILS_SPTFQMR: sig = dqincfac/N_VWrmsNorm(v, ewt); break; } /* Rename work1 and work2 for readibility */ y_tmp = work1; yp_tmp = work2; for (iter=0; iter 0) return(+1); /* Set Jv to [Jv - rr]/sig and return. */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, rr, Jv); return(0); } sundials-2.5.0/src/ida/ida_lapack.c0000600000175000017500000004143711741421215017761 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2011/03/23 23:16:14 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a IDA dense linear solver * using BLAS and LAPACK functions. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include "ida_direct_impl.h" #include "ida_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* IDALAPACK DENSE linit, lsetup, lsolve, and lfree routines */ static int idaLapackDenseInit(IDAMem IDA_mem); static int idaLapackDenseSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC); static int idaLapackDenseFree(IDAMem IDA_mem); /* IDALAPACK BAND linit, lsetup, lsolve, and lfree routines */ static int idaLapackBandInit(IDAMem IDA_mem); static int idaLapackBandSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC); static int idaLapackBandFree(IDAMem IDA_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define res (IDA_mem->ida_res) #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lfree (IDA_mem->ida_lfree) #define lperf (IDA_mem->ida_lperf) #define lmem (IDA_mem->ida_lmem) #define tempv (IDA_mem->ida_tempv1) #define setupNonNull (IDA_mem->ida_setupNonNull) #define mtype (idadls_mem->d_type) #define n (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define smu (idadls_mem->d_smu) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define bjac (idadls_mem->d_bjac) #define JJ (idadls_mem->d_J) #define pivots (idadls_mem->d_pivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define J_data (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDALapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. IDALapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem) * to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve, * and idaLapackDenseFree, respectively. It allocates memory for a * structure of type IDADlsMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to TRUE, and the d_jac field to the default * idaLapackDenseDQJac. Finally, it allocates memory for M, pivots. * * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int IDALapackDense(void *ida_mem, int N) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackDense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the LAPACK solver */ if (tempv->ops->nvgetarraypointer == NULL || tempv->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackDense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree !=NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackDenseInit; lsetup = idaLapackDenseSetup; lsolve = idaLapackDenseSolve; lperf = NULL; lfree = idaLapackDenseFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for JJ and pivot array */ JJ = NULL; pivots = NULL; JJ = NewDenseMat(n, n); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDALapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem) * to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve, * and idaLapackBandFree, respectively. It allocates memory for a * structure of type IDALapackBandMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and * the jacE and jacI field to NULL. * Finally, it allocates memory for M and pivots. * The IDALapackBand return value is IDADLS_SUCCESS = 0, * IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2. * * NOTE: The IDALAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int IDALapackBand(void *ida_mem, int N, int mupper, int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackBand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (tempv->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackBandInit; lsetup = idaLapackBandSetup; lsolve = idaLapackBandSolve; lperf = NULL; lfree = idaLapackBandFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwiths in idadls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_SIZES); free(idadls_mem); idadls_mem = NULL; return(IDADLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for JJ and pivot arrays */ JJ = NULL; pivots = NULL; JJ = NewBandMat(n, mu, ml, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS * ================================================================= */ /* * idaLapackDenseInit does remaining initializations specific to the dense * linear solver. */ static int idaLapackDenseInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { djac = idaDlsDenseDQJac; J_data = IDA_mem; } else { J_data = IDA_mem->ida_user_data; } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackDenseSetup does the setup operations for the dense linear solver. * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', * updates counters, and calls the dense LU factorization routine. */ static int idaLapackDenseSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { IDADlsMem idadls_mem; int ier, retval; int intn; idadls_mem = (IDADlsMem) lmem; intn = (int) n; /* Call Jacobian function */ nje++; SetToZero(JJ); retval = djac(n, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackDenseSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(1); } /* Do LU factorization of M */ dgetrf_f77(&intn, &intn, JJ->data, &intn, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * idaLapackDenseSolve handles the solve operation for the dense linear solver * by calling the dense backsolve routine. */ static int idaLapackDenseSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC) { IDADlsMem idadls_mem; realtype *bd, fact; int ier, one = 1; int intn; idadls_mem = (IDADlsMem) lmem; intn = (int) n; bd = N_VGetArrayPointer(b); dgetrs_f77("N", &intn, &one, JJ->data, &intn, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) { fact = TWO/(ONE + cjratio); dscal_f77(&intn, &fact, bd, &one); } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackDenseFree frees memory specific to the dense linear solver. */ static int idaLapackDenseFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(pivots); free(idadls_mem); idadls_mem = NULL; return(0); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS * ================================================================= */ /* * idaLapackBandInit does remaining initializations specific to the band * linear solver. */ static int idaLapackBandInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; nje = 0; nreDQ = 0; if (jacDQ) { bjac = idaDlsBandDQJac; J_data = IDA_mem; } else { J_data = IDA_mem->ida_user_data; } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackBandSetup does the setup operations for the band linear solver. * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', * updates counters, and calls the band LU factorization routine. */ static int idaLapackBandSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { IDADlsMem idadls_mem; int ier, retval; int intn, iml, imu, ldmat; idadls_mem = (IDADlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = JJ->ldim; /* Call Jacobian function */ nje++; SetToZero(JJ); retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of M */ dgbtrf_f77(&intn, &intn, &iml, &imu, JJ->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * idaLapackBandSolve handles the solve operation for the band linear solver * by calling the band backsolve routine. */ static int idaLapackBandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector ypC, N_Vector fctC) { IDADlsMem idadls_mem; realtype *bd, fact; int ier, one = 1; int intn, iml, imu, ldmat; idadls_mem = (IDADlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = JJ->ldim; bd = N_VGetArrayPointer(b); dgbtrs_f77("N", &intn, &iml, &imu, &one, JJ->data, &ldmat, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in cj */ if (cjratio != ONE) { fact = TWO/(ONE + cjratio); dscal_f77(&intn, &fact, bd, &one); } last_flag = IDADLS_SUCCESS; return(0); } /* * idaLapackBandFree frees memory specific to the band linear solver. */ static int idaLapackBandFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(pivots); free(idadls_mem); idadls_mem = NULL; return(0); } sundials-2.5.0/src/ida/ida_band.c0000600000175000017500000002270711741421215017431 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 20:44:01 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the IDA banded linear * solver module, IDABAND. This module uses standard banded * matrix techniques to solve the linear systems generated by the * (nonlinear) Newton iteration process. The user may either * supply a banded Jacobian routine or use the routine supplied * with this module (IDABandDQJac). * ----------------------------------------------------------------- */ #include #include #include #include "ida_direct_impl.h" #include "ida_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* IDABAND linit, lsetup, lsolve, and lfree routines */ static int IDABandInit(IDAMem IDA_mem); static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur); static int IDABandFree(IDAMem IDA_mem); /* Readability Replacements */ #define res (IDA_mem->ida_res) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define mtype (idadls_mem->d_type) #define neq (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define jacDQ (idadls_mem->d_jacDQ) #define bjac (idadls_mem->d_bjac) #define JJ (idadls_mem->d_J) #define smu (idadls_mem->d_smu) #define lpivots (idadls_mem->d_lpivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define jacdata (idadls_mem->d_J_data) #define last_flag (idadls_mem->d_last_flag) /* * ----------------------------------------------------------------- * IDABand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the IDABAND linear solver module. * IDABand first calls the existing lfree routine if this is not NULL. * Then it sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDABandInit, IDABandSetup, * IDABandSolve, NULL, and IDABandFree, respectively. * It allocates memory for a structure of type IDADlsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem) to TRUE, sets the d_jacdata field in * the IDADlsMemRec structure to be the input parameter jdata, and sets * the d_bjac field to be: * (1) the input parameter bjac, if bjac != NULL, or * (2) IDABandDQJac, if bjac == NULL. * Finally, it allocates memory for JJ and lpivots. * IDABand returns IDADLS_SUCCESS = 0, IDADLS_LMEM_FAIL = -1, * or IDADLS_ILL_INPUT = -2. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDABand will first * test for a compatible N_Vector internal representation by * checking that the N_VGetArrayPointer function exists * ----------------------------------------------------------------- */ int IDABand(void *ida_mem, long int Neq, long int mupper, long int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDABAND", "IDABand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDABAND", "IDABand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } /* Test mlower and mupper for legality. */ if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDABAND", "IDABand", MSGD_BAD_SIZES); return(IDADLS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem. */ linit = IDABandInit; lsetup = IDABandSetup; lsolve = IDABandSolve; lperf = NULL; lfree = IDABandFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; idadls_mem->d_ml = mlower; idadls_mem->d_mu = mupper; /* Set extended upper half-bandwidth for JJ (required for pivoting). */ smu = MIN(Neq-1, mupper + mlower); /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewBandMat(Neq, mupper, mlower, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(Neq); if (lpivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDABAND", "IDABand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); } /* * ----------------------------------------------------------------- * IDABAND interface functions * ----------------------------------------------------------------- */ /* This routine does remaining initializations specific to the IDABAND linear solver module. It returns 0. */ static int IDABandInit(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Initialize nje and nreB */ nje = 0; nreDQ = 0; if (jacDQ) { bjac = idaDlsBandDQJac; jacdata = IDA_mem; } else { jacdata = IDA_mem->ida_user_data; } last_flag = 0; return(0); } /* This routine does the setup operations for the IDABAND linear solver module. It calls the Jacobian evaluation routine, updates counters, and calls the band LU factorization routine. The return value is either IDADLS_SUCCESS = 0 if successful, +1 if the jac routine failed recoverably or the LU factorization failed, or -1 if the jac routine failed unrecoverably. */ static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = bjac(neq, mu, ml, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDABAND", "IDABandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = BandGBTRF(JJ, lpivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); } /* This routine handles the solve operation for the IDABAND linear solver module. It calls the band backsolve routine, scales the solution vector according to cjratio, then returns IDADLS_SUCCESS = 0. */ static int IDABandSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rrcur) { IDADlsMem idadls_mem; realtype *bd; idadls_mem = (IDADlsMem) lmem; bd = N_VGetArrayPointer(b); BandGBTRS(JJ, lpivots, bd); /* Scale the correction to account for change in cj. */ if (cjratio != ONE) N_VScale(TWO/(ONE + cjratio), b, b); last_flag = 0; return(0); } /* This routine frees memory specific to the IDABAND linear solver. */ static int IDABandFree(IDAMem IDA_mem) { IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; DestroyMat(JJ); DestroyArray(lpivots); free(lmem); lmem = NULL; return(0); } sundials-2.5.0/src/ida/ida_bbdpre.c0000600000175000017500000004444111741421215017762 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2011/03/23 20:44:01 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with IDA and an IDASPILS * linear solver. * * NOTE: With only one processor in use, a banded matrix results * rather than a block-diagonal matrix with banded blocks. * Diagonal blocking occurs at the processor level. * ----------------------------------------------------------------- */ #include #include #include "ida_impl.h" #include "ida_spils_impl.h" #include "ida_bbdpre_impl.h" #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Prototypes of IDABBDPrecSetup and IDABBDPrecSolve */ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *prec_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *prec_data, N_Vector tmp); /* Prototype for IDABBDPrecFree */ static void IDABBDPrecFree(IDAMem ida_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp); /* * ================================================================ * User-Callable Functions: initialization, reinit and free * ================================================================ */ /* Readability Replacements */ #define uround (IDA_mem->ida_uround) #define vec_tmpl (IDA_mem->ida_tempv1) /* * ----------------------------------------------------------------- * User-Callable Functions : malloc, reinit and free * ----------------------------------------------------------------- */ int IDABBDPrecInit(void *ida_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; N_Vector tempv4; long int muk, mlk, storage_mu; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if one of the SPILS linear solvers has been attached */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } /* Allocate data memory. */ pdata = NULL; pdata = (IBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set pointers to glocal and gcomm; load half-bandwidths. */ pdata->ida_mem = IDA_mem; pdata->glocal = Gres; pdata->gcomm = Gcomm; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); muk = MIN(Nlocal-1, MAX(0, mukeep)); mlk = MIN(Nlocal-1, MAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting). */ storage_mu = MIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix. */ pdata->PP = NULL; pdata->PP = NewBandMat(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Allocate memory for lpivots. */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(Nlocal); if (pdata->lpivots == NULL) { DestroyMat(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Allocate tempv4 for use by IBBDDQJac */ tempv4 = NULL; tempv4 = N_VClone(vec_tmpl); if (tempv4 == NULL){ DestroyMat(pdata->PP); DestroyArray(pdata->lpivots); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDABBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDASPILS_MEM_FAIL); } pdata->tempv4 = tempv4; /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); /* Store Nlocal to be used in IDABBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge. */ pdata->rpwsize = Nlocal*(mlk + storage_mu + 1); pdata->ipwsize = Nlocal; pdata->nge = 0; /* Overwrite the pdata field in the SPILS memory */ idaspils_mem->s_pdata = pdata; /* Attach the pfree function */ idaspils_mem->s_pfree = IDABBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve); return(flag); } int IDABBDPrecReInit(void *ida_mem, long int mudq, long int mldq, realtype dq_rel_yy) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; long int Nlocal; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if one of the SPILS linear solvers has been attached */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; /* Test if the preconditioner data is non-NULL */ if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecReInit", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; /* Load half-bandwidths. */ Nlocal = pdata->n_local; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); /* Re-initialize nge */ pdata->nge = 0; return(IDASPILS_SUCCESS); } int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(IDASPILS_SUCCESS); } int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDASPILS_LMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(IDASPILS_LMEM_NULL); } idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) { IDAProcessError(IDA_mem, IDASPILS_PMEM_NULL, "IDABBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(IDASPILS_PMEM_NULL); } pdata = (IBBDPrecData) idaspils_mem->s_pdata; *ngevalsBBDP = pdata->nge; return(IDASPILS_SUCCESS); } /* Readability Replacements */ #define Nlocal (pdata->n_local) #define mudq (pdata->mudq) #define mldq (pdata->mldq) #define mukeep (pdata->mukeep) #define mlkeep (pdata->mlkeep) #define glocal (pdata->glocal) #define gcomm (pdata->gcomm) #define lpivots (pdata->lpivots) #define PP (pdata->PP) #define tempv4 (pdata->tempv4) #define nge (pdata->nge) #define rel_yy (pdata->rel_yy) /* * ----------------------------------------------------------------- * Function : IDABBDPrecSetup * ----------------------------------------------------------------- * IDABBDPrecSetup generates a band-block-diagonal preconditioner * matrix, where the local block (on this processor) is a band * matrix. Each local block is computed by a difference quotient * scheme via calls to the user-supplied routines glocal, gcomm. * After generating the block in the band matrix PP, this routine * does an LU factorization in place in PP. * * The IDABBDPrecSetup parameters used here are as follows: * * tt is the current value of the independent variable t. * * yy is the current value of the dependent variable vector, * namely the predicted value of y(t). * * yp is the current value of the derivative vector y', * namely the predicted value of y'(t). * * c_j is the scalar in the system Jacobian, proportional to 1/hh. * * bbd_data is the pointer to BBD memory set by IDABBDInit * * tmp1, tmp2, tmp3 are pointers to vectors of type * N_Vector, used for temporary storage or * work space. * * The arguments Neq, rr, res, uround, and nrePtr are not used. * * Return value: * The value returned by this IDABBDPrecSetup function is a int * flag indicating whether it was successful. This value is * 0 if successful, * > 0 for a recoverable error (step will be retried), or * < 0 for a nonrecoverable error (step fails). * ----------------------------------------------------------------- */ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *bbd_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { int retval; long int ier; IBBDPrecData pdata; IDAMem IDA_mem; pdata =(IBBDPrecData) bbd_data; IDA_mem = (IDAMem) pdata->ida_mem; /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ SetToZero(PP); retval = IBBDDQJac(pdata, tt, c_j, yy, yp, tempv1, tempv2, tempv3, tempv4); if (retval < 0) { IDAProcessError(IDA_mem, -1, "IDABBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(+1); } /* Do LU factorization of preconditioner block in place (in PP). */ ier = BandGBTRF(PP, lpivots); /* Return 0 if the LU was complete, or +1 otherwise. */ if (ier > 0) return(+1); return(0); } /* * ----------------------------------------------------------------- * Function: IDABBDPrecSolve * ----------------------------------------------------------------- * The function IDABBDPrecSolve computes a solution to the linear * system P z = r, where P is the left preconditioner defined by * the routine IDABBDPrecSetup. * * The IDABBDPrecSolve parameters used here are as follows: * * rvec is the input right-hand side vector r. * * zvec is the computed solution vector z. * * bbd_data is the pointer to BBD data set by IDABBDInit. * * The arguments tt, yy, yp, rr, c_j, delta, and tmp are NOT used. * * IDABBDPrecSolve always returns 0, indicating success. * ----------------------------------------------------------------- */ static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *bbd_data, N_Vector tmp) { IBBDPrecData pdata; realtype *zd; pdata = (IBBDPrecData) bbd_data; /* Copy rvec to zvec, do the backsolve, and return. */ N_VScale(ONE, rvec, zvec); zd = N_VGetArrayPointer(zvec); BandGBTRS(PP, lpivots, zd); return(0); } static void IDABBDPrecFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; IBBDPrecData pdata; if (IDA_mem->ida_lmem == NULL) return; idaspils_mem = (IDASpilsMem) IDA_mem->ida_lmem; if (idaspils_mem->s_pdata == NULL) return; pdata = (IBBDPrecData) idaspils_mem->s_pdata; DestroyMat(PP); DestroyArray(lpivots); N_VDestroy(tempv4); free(pdata); pdata = NULL; } #define ewt (IDA_mem->ida_ewt) #define user_data (IDA_mem->ida_user_data) #define hh (IDA_mem->ida_hh) #define constraints (IDA_mem->ida_constraints) /* * ----------------------------------------------------------------- * IBBDDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation * to the local block of the Jacobian of G(t,y,y'). It assumes that * a band matrix of type BandMat is stored column-wise, and that * elements within each column are contiguous. * * All matrix elements are generated as difference quotients, by way * of calls to the user routine glocal. By virtue of the band * structure, the number of these calls is bandwidth + 1, where * bandwidth = mldq + mudq + 1. But the band matrix kept has * bandwidth = mlkeep + mukeep + 1. This routine also assumes that * the local elements of a vector are stored contiguously. * * Return values are: 0 (success), > 0 (recoverable error), * or < 0 (nonrecoverable error). * ----------------------------------------------------------------- */ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) { IDAMem IDA_mem; realtype inc, inc_inv; int retval; long int group, i, j, width, ngroups, i1, i2; realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; realtype *cnsdata = NULL, *ewtdata; realtype *col_j, conj, yj, ypj, ewtj; IDA_mem = (IDAMem) pdata->ida_mem; /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Obtain pointers as required to the data array of vectors. */ ydata = N_VGetArrayPointer(yy); ypdata = N_VGetArrayPointer(yp); gtempdata = N_VGetArrayPointer(gtemp); ewtdata = N_VGetArrayPointer(ewt); if (constraints != NULL) cnsdata = N_VGetArrayPointer(constraints); ytempdata = N_VGetArrayPointer(ytemp); yptempdata= N_VGetArrayPointer(yptemp); grefdata = N_VGetArrayPointer(gref); /* Call gcomm and glocal to get base value of G(t,y,y'). */ if (gcomm != NULL) { retval = gcomm(Nlocal, tt, yy, yp, user_data); if (retval != 0) return(retval); } retval = glocal(Nlocal, tt, yy, yp, gref, user_data); nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing. */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups. */ for(group = 1; group <= ngroups; group++) { /* Loop over the components in this group. */ for(j = group-1; j < Nlocal; j += width) { yj = ydata[j]; ypj = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc to yj based on rel_yy*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment yj and ypj. */ ytempdata[j] += inc; yptempdata[j] += cj*inc; } /* Evaluate G with incremented y and yp arguments. */ retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, user_data); nge++; if (retval != 0) return(retval); /* Loop over components of the group again; restore ytemp and yptemp. */ for(j = group-1; j < Nlocal; j += width) { yj = ytempdata[j] = ydata[j]; ypj = yptempdata[j] = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc as before .*/ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Form difference quotients and load into PP. */ inc_inv = ONE/inc; col_j = BAND_COL(PP,j); i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtempdata[i] - grefdata[i]); } } return(0); } sundials-2.5.0/src/ida/LICENSE0000600000175000017500000000551111741421215016543 0ustar sylvestresylvestreCopyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by Alan Hindmarsh, Allan Taylor, Radu Serban. UCRL-CODE-155952 All rights reserved. This file is part of IDA. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/src/ida/ida.c0000600000175000017500000030044011741421215016436 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.25 $ * $Date: 2012/03/06 21:58:52 $ * ----------------------------------------------------------------- * Programmer(s): Alan Hindmarsh, Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the main IDA solver. * It is independent of the linear solver in use. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * Creation, allocation and re-initialization functions * IDACreate * IDAInit * IDAReInit * IDARootInit * Main solver function * IDASolve * Interpolated output and extraction functions * IDAGetDky * Deallocation functions * IDAFree * * PRIVATE FUNCTIONS * ----------------- * IDACheckNvector * Memory allocation/deallocation * IDAAllocVectors * IDAFreeVectors * Initial setup * IDAInitialSetup * IDAEwtSet * IDAEwtSetSS * IDAEwtSetSV * Stopping tests * IDAStopTest1 * IDAStopTest2 * Error handler * IDAHandleFailure * Main IDAStep function * IDAStep * IDASetCoeffs * Nonlinear solver functions * IDANls * IDAPredict * IDANewtonIter * Error test * IDATestError * IDARestore * Handler for convergence and/or error test failures * IDAHandleNFlag * IDAReset * Function called after a successful step * IDACompleteStep * Get solution * IDAGetSolution * Norm functions * IDAWrmsNorm * Functions for rootfinding * IDARcheck1 * IDARcheck2 * IDARcheck3 * IDARootfind * IDA Error message handling functions * IDAProcessError * IDAErrHandler * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include "ida_impl.h" #include /* * ================================================================= * MACRO DEFINITIONS * ================================================================= */ /* Macro: loop */ #define loop for(;;) /* * ================================================================= * IDAS PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define QUARTER RCONST(0.25) /* real 0.25 */ #define TWOTHIRDS RCONST(0.667) /* real 2/3 */ #define ONE RCONST(1.0) /* real 1.0 */ #define ONEPT5 RCONST(1.5) /* real 1.5 */ #define TWO RCONST(2.0) /* real 2.0 */ #define FOUR RCONST(4.0) /* real 4.0 */ #define FIVE RCONST(5.0) /* real 5.0 */ #define TEN RCONST(10.0) /* real 10.0 */ #define TWELVE RCONST(12.0) /* real 12.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define PT9 RCONST(0.9) /* real 0.9 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT01 RCONST(0.01) /* real 0.01 */ #define PT001 RCONST(0.001) /* real 0.001 */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ /* * ================================================================= * IDAS ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by IDASolve * ------------------------------------------------------------ */ /* IDAStep control constants */ #define PREDICT_AGAIN 20 /* Return values for lower level routines used by IDASolve */ #define IDA_RES_RECVR +1 #define IDA_LSETUP_RECVR +2 #define IDA_LSOLVE_RECVR +3 #define IDA_NCONV_RECVR +4 #define IDA_CONSTR_RECVR +5 #define CONTINUE_STEPS +99 /* IDACompleteStep constants */ #define UNSET -1 #define LOWER +1 #define RAISE +2 #define MAINTAIN +3 /* IDATestError constants */ #define ERROR_TEST_FAIL +7 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- */ #define RTFOUND +1 #define CLOSERT +3 /* * Control constants for tolerances * -------------------------------- */ #define IDA_NN 0 #define IDA_SS 1 #define IDA_SV 2 #define IDA_WF 3 /* * Algorithmic constants * --------------------- */ #define MXNCF 10 /* max number of convergence failures allowed */ #define MXNEF 10 /* max number of error test failures allowed */ #define MAXNH 5 /* max. number of h tries in IC calc. */ #define MAXNJ 4 /* max. number of J tries in IC calc. */ #define MAXNI 10 /* max. Newton iterations in IC calc. */ #define EPCON RCONST(0.33) /* Newton convergence test constant */ /* IDANewtonIter constants */ #define MAXIT 4 #define RATEMAX RCONST(0.9) #define XRATE RCONST(0.25) /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype IDACheckNvector(N_Vector tmpl); /* Memory allocation/deallocation */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDAFreeVectors(IDAMem IDA_mem); /* Initial setup */ int IDAInitialSetup(IDAMem IDA_mem); static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); /* Main IDAStep function */ static int IDAStep(IDAMem IDA_mem); /* Function called at beginning of step */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); /* Nonlinear solver functions */ static void IDAPredict(IDAMem IDA_mem); static int IDANls(IDAMem IDA_mem); static int IDANewtonIter(IDAMem IDA_mem); /* Error test */ static int IDATestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1); /* Handling of convergence and/or error test failures */ static void IDARestore(IDAMem IDA_mem, realtype saved_t); static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr); static void IDAReset(IDAMem IDA_mem); /* Function called after a successful step */ static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1); /* Function called to evaluate the solutions y(t) and y'(t) at t */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); /* Stopping tests and failure handling */ static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAHandleFailure(IDAMem IDA_mem, int sflag); /* Functions for rootfinding */ static int IDARcheck1(IDAMem IDA_mem); static int IDARcheck2(IDAMem IDA_mem); static int IDARcheck3(IDAMem IDA_mem); static int IDARootfind(IDAMem IDA_mem); /* Norm functions */ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation, allocation and re-initialization functions * ----------------------------------------------------------------- */ /* * IDACreate * * IDACreate creates an internal memory block for a problem to * be solved by IDA. * If successful, IDACreate returns a pointer to the problem memory. * This pointer should be passed to IDAInit. * If an initialization error occurs, IDACreate prints an error * message to standard err and returns NULL. */ void *IDACreate(void) { IDAMem IDA_mem; IDA_mem = NULL; IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); if (IDA_mem == NULL) { IDAProcessError(NULL, 0, "IDA", "IDACreate", MSG_MEM_FAIL); return (NULL); } /* Zero out ida_mem */ memset(IDA_mem, 0, sizeof(struct IDAMemRec)); /* Set unit roundoff in IDA_mem */ IDA_mem->ida_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ IDA_mem->ida_res = NULL; IDA_mem->ida_user_data = NULL; IDA_mem->ida_itol = IDA_NN; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = NULL; IDA_mem->ida_edata = NULL; IDA_mem->ida_ehfun = IDAErrHandler; IDA_mem->ida_eh_data = IDA_mem; IDA_mem->ida_errfp = stderr; IDA_mem->ida_maxord = MAXORD_DEFAULT; IDA_mem->ida_mxstep = MXSTEP_DEFAULT; IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; IDA_mem->ida_hin = ZERO; IDA_mem->ida_epcon = EPCON; IDA_mem->ida_maxnef = MXNEF; IDA_mem->ida_maxncf = MXNCF; IDA_mem->ida_maxcor = MAXIT; IDA_mem->ida_suppressalg = FALSE; IDA_mem->ida_id = NULL; IDA_mem->ida_constraints = NULL; IDA_mem->ida_constraintsSet = FALSE; IDA_mem->ida_tstopset = FALSE; /* set the saved value maxord_alloc */ IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT; /* Set default values for IC optional inputs */ IDA_mem->ida_epiccon = PT01 * EPCON; IDA_mem->ida_maxnh = MAXNH; IDA_mem->ida_maxnj = MAXNJ; IDA_mem->ida_maxnit = MAXNI; IDA_mem->ida_lsoff = FALSE; IDA_mem->ida_steptol = RPowerR(IDA_mem->ida_uround, TWOTHIRDS); /* Initialize lrw and liw */ IDA_mem->ida_lrw = 25 + 5*MXORDP1; IDA_mem->ida_liw = 38; /* No mallocs have been done yet */ IDA_mem->ida_VatolMallocDone = FALSE; IDA_mem->ida_constraintsMallocDone = FALSE; IDA_mem->ida_idMallocDone = FALSE; IDA_mem->ida_MallocDone = FALSE; /* Return pointer to IDA memory block */ return((void *)IDA_mem); } /*-----------------------------------------------------------------*/ #define lrw (IDA_mem->ida_lrw) #define liw (IDA_mem->ida_liw) /*-----------------------------------------------------------------*/ /* * IDAInit * * IDAInit allocates and initializes memory for a problem. All * problem specification inputs are checked for errors. If any * error occurs during initialization, it is reported to the * error handler function. */ int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; booleantype nvectorOK, allocOK; long int lrw1, liw1; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } if (res == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_RES_NULL); return(IDA_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = IDACheckNvector(yy0); if (!nvectorOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInit", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (yy0->ops->nvspace != NULL) { N_VSpace(yy0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } IDA_mem->ida_lrw1 = lrw1; IDA_mem->ida_liw1 = liw1; /* Allocate the vectors (using yy0 as a template) */ allocOK = IDAAllocVectors(IDA_mem, yy0); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDAInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* All error checking is complete at this point */ /* Copy the input parameters into IDA memory block */ IDA_mem->ida_res = res; IDA_mem->ida_tn = t0; /* Set the linear solver addresses to NULL */ IDA_mem->ida_linit = NULL; IDA_mem->ida_lsetup = NULL; IDA_mem->ida_lsolve = NULL; IDA_mem->ida_lperf = NULL; IDA_mem->ida_lfree = NULL; IDA_mem->ida_lmem = NULL; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initialize root-finding variables */ IDA_mem->ida_glo = NULL; IDA_mem->ida_ghi = NULL; IDA_mem->ida_grout = NULL; IDA_mem->ida_iroots = NULL; IDA_mem->ida_rootdir = NULL; IDA_mem->ida_gfun = NULL; IDA_mem->ida_nrtfn = 0; IDA_mem->ida_gactive = NULL; IDA_mem->ida_mxgnull = 1; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = FALSE; /* Problem memory has been successfully allocated */ IDA_mem->ida_MallocDone = TRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1 (IDA_mem->ida_lrw1) #define liw1 (IDA_mem->ida_liw1) /*-----------------------------------------------------------------*/ /* * IDAReInit * * IDAReInit re-initializes IDA's memory for a problem, assuming * it has already beeen allocated in a prior IDAInit call. * All problem specification inputs are checked for errors. * The problem size Neq is assumed to be unchaged since the call * to IDAInit, and the maximum order maxord must not be larger. * If any error occurs during reinitialization, it is reported to * the error handler function. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; /* Check for legal input parameters */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAReInit", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAReInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } /* Copy the input parameters into IDA memory block */ IDA_mem->ida_tn = t0; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = FALSE; /* Problem has been successfully re-initialized */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASStolerances * IDASVtolerances * IDAWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to IDA. * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) * which will be called to set the error weight vector. */ int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASStolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (abstol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASStolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_rtol = reltol; IDA_mem->ida_Satol = abstol; IDA_mem->ida_itol = IDA_SS; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup; */ return(IDA_SUCCESS); } int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASVtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASVtolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(IDA_mem->ida_VatolMallocDone) ) { IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); lrw += lrw1; liw += liw1; IDA_mem->ida_VatolMallocDone = TRUE; } IDA_mem->ida_rtol = reltol; N_VScale(ONE, abstol, IDA_mem->ida_Vatol); IDA_mem->ida_itol = IDA_SV; IDA_mem->ida_user_efun = FALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup; */ return(IDA_SUCCESS); } int IDAWFtolerances(void *ida_mem, IDAEwtFn efun) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAWFtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDAWFtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } IDA_mem->ida_itol = IDA_WF; IDA_mem->ida_user_efun = TRUE; IDA_mem->ida_efun = efun; IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ #define gfun (IDA_mem->ida_gfun) #define glo (IDA_mem->ida_glo) #define ghi (IDA_mem->ida_ghi) #define grout (IDA_mem->ida_grout) #define iroots (IDA_mem->ida_iroots) #define rootdir (IDA_mem->ida_rootdir) #define gactive (IDA_mem->ida_gactive) /*-----------------------------------------------------------------*/ /* * IDARootInit * * IDARootInit initializes a rootfinding problem to be solved * during the integration of the DAE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is IDA_SUCCESS = 0 if no * errors occurred, or a negative value otherwise. */ int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g) { IDAMem IDA_mem; int i, nrt; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDARootInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning IDARootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); iroots = NULL; free(gactive); gactive = NULL; lrw -= 3 * (IDA_mem->ida_nrtfn); liw -= 3 * (IDA_mem->ida_nrtfn); } /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to zero and ida_gfun to NULL before returning */ if (nrt == 0) { IDA_mem->ida_nrtfn = nrt; gfun = NULL; return(IDA_SUCCESS); } /* If rerunning IDARootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == IDA_mem->ida_nrtfn) { if (g != gfun) { if (g == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); iroots = NULL; free(gactive); gactive = NULL; lrw -= 3*nrt; liw -= 3*nrt; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else { gfun = g; return(IDA_SUCCESS); } } else return(IDA_SUCCESS); } /* Set variable values in IDA memory block */ IDA_mem->ida_nrtfn = nrt; if (g == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else gfun = g; /* Allocate necessary memory and return */ glo = NULL; glo = (realtype *) malloc(nrt*sizeof(realtype)); if (glo == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } ghi = NULL; ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (ghi == NULL) { free(glo); glo = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } grout = NULL; grout = (realtype *) malloc(nrt*sizeof(realtype)); if (grout == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } iroots = NULL; iroots = (int *) malloc(nrt*sizeof(int)); if (iroots == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } rootdir = NULL; rootdir = (int *) malloc(nrt*sizeof(int)); if (rootdir == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } gactive = NULL; gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (gactive == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; iida_res) #define y0 (IDA_mem->ida_y0) #define yp0 (IDA_mem->ida_yp0) #define itol (IDA_mem->ida_itol) #define rtol (IDA_mem->ida_rtol) #define Satol (IDA_mem->ida_Satol) #define Vatol (IDA_mem->ida_Vatol) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define user_data (IDA_mem->ida_user_data) #define maxord (IDA_mem->ida_maxord) #define mxstep (IDA_mem->ida_mxstep) #define hin (IDA_mem->ida_hin) #define hmax_inv (IDA_mem->ida_hmax_inv) #define tstop (IDA_mem->ida_tstop) #define tstopset (IDA_mem->ida_tstopset) #define epcon (IDA_mem->ida_epcon) #define maxnef (IDA_mem->ida_maxnef) #define maxncf (IDA_mem->ida_maxncf) #define maxcor (IDA_mem->ida_maxcor) #define suppressalg (IDA_mem->ida_suppressalg) #define id (IDA_mem->ida_id) #define constraints (IDA_mem->ida_constraints) #define epiccon (IDA_mem->ida_epiccon) #define maxnh (IDA_mem->ida_maxnh) #define maxnj (IDA_mem->ida_maxnj) #define maxnit (IDA_mem->ida_maxnit) #define lsoff (IDA_mem->ida_lsoff) #define steptol (IDA_mem->ida_steptol) #define uround (IDA_mem->ida_uround) #define phi (IDA_mem->ida_phi) #define ewt (IDA_mem->ida_ewt) #define yy (IDA_mem->ida_yy) #define yp (IDA_mem->ida_yp) #define delta (IDA_mem->ida_delta) #define mm (IDA_mem->ida_mm) #define ee (IDA_mem->ida_ee) #define savres (IDA_mem->ida_savres) #define tempv1 (IDA_mem->ida_tempv1) #define tempv2 (IDA_mem->ida_tempv2) #define kk (IDA_mem->ida_kk) #define hh (IDA_mem->ida_hh) #define h0u (IDA_mem->ida_h0u) #define tn (IDA_mem->ida_tn) #define tretlast (IDA_mem->ida_tretlast) #define cj (IDA_mem->ida_cj) #define cjold (IDA_mem->ida_cjold) #define cjratio (IDA_mem->ida_cjratio) #define cjlast (IDA_mem->ida_cjlast) #define nbacktr (IDA_mem->ida_nbacktr) #define nst (IDA_mem->ida_nst) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define netf (IDA_mem->ida_netf) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define ns (IDA_mem->ida_ns) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define knew (IDA_mem->ida_knew) #define kused (IDA_mem->ida_kused) #define hused (IDA_mem->ida_hused) #define tolsf (IDA_mem->ida_tolsf) #define phase (IDA_mem->ida_phase) #define epsNewt (IDA_mem->ida_epsNewt) #define toldel (IDA_mem->ida_toldel) #define ss (IDA_mem->ida_ss) #define rr (IDA_mem->ida_rr) #define psi (IDA_mem->ida_psi) #define alpha (IDA_mem->ida_alpha) #define beta (IDA_mem->ida_beta) #define sigma (IDA_mem->ida_sigma) #define gamma (IDA_mem->ida_gamma) #define setupNonNull (IDA_mem->ida_setupNonNull) #define constraintsSet (IDA_mem->ida_constraintsSet) #define nrtfn (IDA_mem->ida_nrtfn) #define tlo (IDA_mem->ida_tlo) #define thi (IDA_mem->ida_thi) #define toutc (IDA_mem->ida_toutc) #define trout (IDA_mem->ida_trout) #define ttol (IDA_mem->ida_ttol) #define taskc (IDA_mem->ida_taskc) #define irfnd (IDA_mem->ida_irfnd) #define nge (IDA_mem->ida_nge) /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * IDASolve * * This routine is the main driver of the IDA package. * * It integrates over an independent variable interval defined by the user, * by calling IDAStep to take internal independent variable steps. * * The first time that IDASolve is called for a successfully initialized * problem, it computes a tentative initial step size. * * IDASolve supports two modes, specified by itask: * In the IDA_NORMAL mode, the solver steps until it passes tout and then * interpolates to obtain y(tout) and yp(tout). * In the IDA_ONE_STEP mode, it takes one internal step and returns. * * IDASolve returns integer values corresponding to success and failure as below: * * successful returns: * * IDA_SUCCESS * IDA_TSTOP_RETURN * * failed returns: * * IDA_ILL_INPUT * IDA_TOO_MUCH_WORK * IDA_MEM_NULL * IDA_TOO_MUCH_ACC * IDA_CONV_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL * IDA_CONSTR_FAIL * IDA_ERR_FAIL * IDA_REP_RES_ERR * IDA_RES_FAIL */ int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { long int nstloc; int sflag, istate, ier, irfndp, ir; realtype tdist, troundoff, ypnorm, rh, nrm; IDAMem IDA_mem; booleantype inactive_roots; /* Check for legal inputs in all cases. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASolve", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASolve", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal arguments */ if (yret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YRET_NULL); return(IDA_ILL_INPUT); } yy = yret; if (ypret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_YPRET_NULL); return(IDA_ILL_INPUT); } yp = ypret; if (tret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TRET_NULL); return(IDA_ILL_INPUT); } if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } if (itask == IDA_NORMAL) toutc = tout; taskc = itask; if (nst == 0) { /* This is the first call */ /* Check inputs to IDA for correctness and consistency */ if (IDA_mem->ida_SetupDone == FALSE) { ier = IDAInitialSetup(IDA_mem); if (ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = TRUE; } /* On first call, check for tout - tn too small, set initial hh, check for approach to tstop, and scale phi[1] by hh. Also check for zeros of root function g at and near t0. */ tdist = ABS(tout - tn); if (tdist == ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } troundoff = TWO*uround*(ABS(tn) + ABS(tout)); if (tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } hh = hin; if ( (hh != ZERO) && ((tout-tn)*hh < ZERO) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_HINIT); return(IDA_ILL_INPUT); } if (hh == ZERO) { hh = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, phi[1], ewt, suppressalg); if (ypnorm > HALF/hh) hh = HALF/ypnorm; if (tout < tn) hh = -hh; } rh = ABS(hh)*hmax_inv; if (rh > ONE) hh /= rh; if (tstopset) { if ( (tstop - tn)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } if ( (tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } h0u = hh; kk = 0; kused = 0; /* set in case of an error return before a step */ /* Check for exact zeros of the root functions at or near t0. */ if (nrtfn > 0) { ier = IDARcheck1(IDA_mem); if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck1", MSG_RTFUNC_FAILED, tn); return(IDA_RTFUNC_FAIL); } } N_VScale(hh, phi[1], phi[1]); /* set phi[1] = hh*y' */ /* Set the convergence test constants epsNewt and toldel */ epsNewt = epcon; toldel = PT0001 * epsNewt; } /* end of first-call block. */ /* Call lperf function and set nstloc for later performance testing. */ if (lperf != NULL) lperf(IDA_mem, 0); nstloc = 0; /* If not the first call, perform all stopping tests. */ if (nst > 0) { /* First, check for a root in the last step taken, other than the last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (nrtfn > 0) { irfndp = irfnd; ier = IDARcheck2(IDA_mem); if (ier == CLOSERT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDARcheck2", MSG_CLOSE_ROOTS, tlo); return(IDA_ILL_INPUT); } else if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck2", MSG_RTFUNC_FAILED, tlo); return(IDA_RTFUNC_FAIL); } else if (ier == RTFOUND) { tretlast = *tret = tlo; return(IDA_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if ( ABS(tn - tretlast) > troundoff ) { ier = IDARcheck3(IDA_mem); if (ier == IDA_SUCCESS) { /* no root found */ irfnd = 0; if ((irfndp == 1) && (itask == IDA_ONE_STEP)) { tretlast = *tret = tn; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); return(IDA_SUCCESS); } } else if (ier == RTFOUND) { /* a new root was found */ irfnd = 1; tretlast = *tret = tlo; return(IDA_ROOT_RETURN); } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); return(IDA_RTFUNC_FAIL); } } } /* end of root stop check */ /* Now test for all other stop conditions. */ istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) return(istate); } /* Looping point for internal steps. */ loop { /* Check for too many steps taken. */ if ( (mxstep>0) && (nstloc >= mxstep) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_MAX_STEPS, tn); istate = IDA_TOO_MUCH_WORK; *tret = tretlast = tn; break; /* Here yy=yret and yp=ypret already have the current solution. */ } /* Call lperf to generate warnings of poor performance. */ if (lperf != NULL) lperf(IDA_mem, 1); /* Reset and check ewt (if not first call). */ if (nst > 0) { ier = efun(phi[0], ewt, edata); if (ier != 0) { if (itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_EWT_NOW_FAIL, tn); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_EWT_NOW_BAD, tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; break; } } /* Check for too much accuracy requested. */ nrm = IDAWrmsNorm(IDA_mem, phi[0], ewt, suppressalg); tolsf = uround * nrm; if (tolsf > ONE) { tolsf *= TEN; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_TOO_MUCH_ACC, tn); istate = IDA_TOO_MUCH_ACC; *tret = tretlast = tn; if (nst > 0) ier = IDAGetSolution(IDA_mem, tn, yret, ypret); break; } /* Call IDAStep to take a step. */ sflag = IDAStep(IDA_mem); /* Process all failed-step cases, and exit loop. */ if (sflag != IDA_SUCCESS) { istate = IDAHandleFailure(IDA_mem, sflag); *tret = tretlast = tn; ier = IDAGetSolution(IDA_mem, tn, yret, ypret); break; } nstloc++; /* After successful step, check for stop conditions; continue or break. */ /* First check for root in the last step taken. */ if (nrtfn > 0) { ier = IDARcheck3(IDA_mem); if (ier == RTFOUND) { /* A new root was found */ irfnd = 1; istate = IDA_ROOT_RETURN; tretlast = *tret = tlo; break; } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDA", "IDARcheck3", MSG_RTFUNC_FAILED, tlo); istate = IDA_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (nst==1) { inactive_roots = FALSE; for (ir=0; irida_mxgnull > 0) && inactive_roots) { IDAProcessError(IDA_mem, IDA_WARNING, "IDA", "IDASolve", MSG_INACTIVE_ROOTS); } } } /* Now check all other stop conditions. */ istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) break; } /* End of step loop */ return(istate); } /* * ----------------------------------------------------------------- * Interpolated output * ----------------------------------------------------------------- */ /* * IDAGetDky * * This routine evaluates the k-th derivative of y(t) as the value of * the k-th derivative of the interpolating polynomial at the independent * variable t, and stores the results in the vector dky. It uses the current * independent variable value, tn, and the method order last used, kused. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. * IDA_BAD_DKY if the dky vector is NULL. * IDA_BAD_K if the requested k is not in the range 0,1,...,order used * */ int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (dky == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDA", "IDAGetDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDA", "IDAGetDky", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDA", "IDAGetDky", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; i0, the following conventions were adopted: - c_0(t) = 1 , c_0^(-1)(t)=0 - psij_1 stands for psi[-1]=0 when j=1 for psi[j-2] when j>1 */ if(i==0) { cjk[i] = 1; psij_1 = 0; }else { /* i i-1 1 c_i^(i) can be always updated since c_i^(i) = ----- -------- ... ----- psi_j psi_{j-1} psi_1 */ cjk[i] = cjk[i-1]*i/psi[i-1]; psij_1 = psi[i-1]; } /* update c_j^(i) */ /*j does not need to go till kused */ for(j=i+1; j<=kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / psi[j-1]; psij_1 = psi[j-1]; } /* save existing c_j^(i)'s */ for(j=i+1; j<=kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ N_VConst(ZERO, dky); for(j=k; j<=kused; j++) { N_VLinearSum(ONE, dky, cjk[j], phi[j], dky); } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Deallocation function * ----------------------------------------------------------------- */ /* * IDAFree * * This routine frees the problem memory allocated by IDAInit * Such memory includes all the vectors allocated by IDAAllocVectors, * and the memory lmem for the linear solver (deallocated by a call * to lfree). */ void IDAFree(void **ida_mem) { IDAMem IDA_mem; if (*ida_mem == NULL) return; IDA_mem = (IDAMem) (*ida_mem); IDAFreeVectors(IDA_mem); if (lfree != NULL) lfree(IDA_mem); if (nrtfn > 0) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; } free(*ida_mem); *ida_mem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * IDACheckNvector * * This routine checks if all required vector operations are present. * If any of them is missing it returns FALSE. */ static booleantype IDACheckNvector(N_Vector tmpl) { if ((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(FALSE); else return(TRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * IDAAllocVectors * * This routine allocates the IDA vectors ewt, tempv1, tempv2, and * phi[0], ..., phi[maxord]. * If all memory allocations are successful, IDAAllocVectors returns * TRUE. Otherwise all allocated memory is freed and IDAAllocVectors * returns FALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j, maxcol; /* Allocate ewt, ee, delta, tempv1, tempv2 */ ewt = N_VClone(tmpl); if (ewt == NULL) return(FALSE); ee = N_VClone(tmpl); if (ee == NULL) { N_VDestroy(ewt); return(FALSE); } delta = N_VClone(tmpl); if (delta == NULL) { N_VDestroy(ewt); N_VDestroy(ee); return(FALSE); } tempv1 = N_VClone(tmpl); if (tempv1 == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); return(FALSE); } tempv2= N_VClone(tmpl); if (tempv2 == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); N_VDestroy(tempv1); return(FALSE); } savres = tempv1; /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are allocated (for use as temporary vectors), regardless of maxord. */ maxcol = MAX(maxord,3); for (j=0; j <= maxcol; j++) { phi[j] = N_VClone(tmpl); if (phi[j] == NULL) { N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); N_VDestroy(tempv1); N_VDestroy(tempv2); for (i=0; i < j; i++) N_VDestroy(phi[i]); return(FALSE); } } /* Update solver workspace lengths */ lrw += (maxcol + 6)*lrw1; liw += (maxcol + 6)*liw1; /* Store the value of maxord used here */ IDA_mem->ida_maxord_alloc = maxord; return(TRUE); } /* * IDAfreeVectors * * This routine frees the IDA vectors allocated for IDA. */ static void IDAFreeVectors(IDAMem IDA_mem) { int j, maxcol; N_VDestroy(ewt); N_VDestroy(ee); N_VDestroy(delta); N_VDestroy(tempv1); N_VDestroy(tempv2); maxcol = MAX(IDA_mem->ida_maxord_alloc,3); for(j=0; j <= maxcol; j++) N_VDestroy(phi[j]); lrw -= (maxcol + 6)*lrw1; liw -= (maxcol + 6)*liw1; if (IDA_mem->ida_VatolMallocDone) { N_VDestroy(Vatol); lrw -= lrw1; liw -= liw1; } if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(constraints); lrw -= lrw1; liw -= liw1; } if (IDA_mem->ida_idMallocDone) { N_VDestroy(id); lrw -= lrw1; liw -= liw1; } } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * IDAInitialSetup * * This routine is called by IDASolve once at the first step. * It performs all checks on optional inputs and inputs to * IDAInit/IDAReInit that could not be done before. * * If no merror is encountered, IDAInitialSetup returns IDA_SUCCESS. * Otherwise, it returns an error flag and reported to the error * handler function. */ int IDAInitialSetup(IDAMem IDA_mem) { booleantype conOK; int ier; /* Test for more vector operations, depending on options */ if (suppressalg) if (id->ops->nvwrmsnormmask == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Test id vector for legality */ if (suppressalg && (id==NULL)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_MISSING_ID); return(IDA_ILL_INPUT); } /* Did the user specify tolerances? */ if (itol == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_NO_TOLS); return(IDA_ILL_INPUT); } /* Set data for efun */ if (IDA_mem->ida_user_efun) edata = user_data; else edata = IDA_mem; /* Initial error weight vector */ ier = efun(phi[0], ewt, edata); if (ier != 0) { if (itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_FAIL_EWT); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_BAD_EWT); return(IDA_ILL_INPUT); } /* Check to see if y0 satisfies constraints. */ if (constraintsSet) { conOK = N_VConstrMask(constraints, phi[0], tempv2); if (!conOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_Y0_FAIL_CONSTR); return(IDA_ILL_INPUT); } } /* Check that lsolve exists and call linit function if it exists. */ if (lsolve == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_LSOLVE_NULL); return(IDA_ILL_INPUT); } if (linit != NULL) { ier = linit(IDA_mem); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDAInitialSetup", MSG_LINIT_FAIL); return(IDA_LINIT_FAIL); } } return(IDA_SUCCESS); } /* * IDAEwtSet * * This routine is responsible for loading the error weight vector * ewt, according to itol, as follows: * (1) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol), i=0,...,Neq-1 * if itol = IDA_SS * (2) ewt[i] = 1 / (rtol * ABS(ycur[i]) + atol[i]), i=0,...,Neq-1 * if itol = IDA_SV * * IDAEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data) { IDAMem IDA_mem; int flag = 0; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; switch(itol) { case IDA_SS: flag = IDAEwtSetSS(IDA_mem, ycur, weight); break; case IDA_SV: flag = IDAEwtSetSV(IDA_mem, ycur, weight); break; } return(flag); } /* * IDAEwtSetSS * * This routine sets ewt as decribed above in the case itol=IDA_SS. * It tests for non-positive components before inverting. IDAEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv1); N_VScale(rtol, tempv1, tempv1); N_VAddConst(tempv1, Satol, tempv1); if (N_VMin(tempv1) <= ZERO) return(-1); N_VInv(tempv1, weight); return(0); } /* * IDAEwtSetSV * * This routine sets ewt as decribed above in the case itol=IDA_SV. * It tests for non-positive components before inverting. IDAEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv1); N_VLinearSum(rtol, tempv1, ONE, Vatol, tempv1); if (N_VMin(tempv1) <= ZERO) return(-1); N_VInv(tempv1, weight); return(0); } /* * ----------------------------------------------------------------- * Stopping tests * ----------------------------------------------------------------- */ /* * IDAStopTest1 * * This routine tests for stop conditions before taking a step. * The tests depend on the value of itask. * The variable tretlast is the previously returned value of tret. * * The return values are: * CONTINUE_STEPS if no stop conditions were found * IDA_SUCCESS for a normal return to the user * IDA_TSTOP_RETURN for a tstop-reached return to the user * IDA_ILL_INPUT for an illegal-input return to the user * * In the tstop cases, this routine may adjust the stepsize hh to cause * the next step to reach tstop exactly. */ static int IDAStopTest1(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { int ier; realtype troundoff; switch (itask) { case IDA_NORMAL: if (tstopset) { /* Test for tn past tstop, tn = tretlast, tn past tout, tn near tstop. */ if ( (tn - tstop)*hh > ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } } /* Test for tout = tretlast, and for tn past tout. */ if (tout == tretlast) { *tret = tretlast = tout; return(IDA_SUCCESS); } if ((tn - tout)*hh >= ZERO) { ier = IDAGetSolution(IDA_mem, tout, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout); return(IDA_ILL_INPUT); } *tret = tretlast = tout; return(IDA_SUCCESS); } if (tstopset) { troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (tstopset) { /* Test for tn past tstop, tn past tretlast, and tn near tstop. */ if ((tn - tstop)*hh > ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } } /* Test for tn past tretlast. */ if ((tn - tretlast)*hh > ZERO) { ier = IDAGetSolution(IDA_mem, tn, yret, ypret); *tret = tretlast = tn; return(IDA_SUCCESS); } if (tstopset) { troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, tstop, tn); return(IDA_ILL_INPUT); } *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); } return(-99); } /* * IDAStopTest2 * * This routine tests for stop conditions after taking a step. * The tests depend on the value of itask. * * The return values are: * CONTINUE_STEPS if no stop conditions were found * IDA_SUCCESS for a normal return to the user * IDA_TSTOP_RETURN for a tstop-reached return to the user * * In the two cases with tstop, this routine may reset the stepsize hh * to cause the next step to reach tstop exactly. * * In the two cases with ONE_STEP mode, no interpolation to tn is needed * because yret and ypret already contain the current y and y' values. * * Note: No test is made for an error return from IDAGetSolution here, * because the same test was made prior to the step. */ static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { int ier; realtype troundoff; switch (itask) { case IDA_NORMAL: /* Test for tn past tout. */ if ((tn - tout)*hh >= ZERO) { ier = IDAGetSolution(IDA_mem, tout, yret, ypret); *tret = tretlast = tout; return(IDA_SUCCESS); } if (tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED*uround*(ABS(tn) + ABS(hh)); if (ABS(tn - tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, tstop, yret, ypret); *tret = tretlast = tstop; tstopset = FALSE; return(IDA_TSTOP_RETURN); } if ((tn + hh - tstop)*hh > ZERO) hh = (tstop - tn)*(ONE-FOUR*uround); } *tret = tretlast = tn; return(IDA_SUCCESS); } return -99; } /* * ----------------------------------------------------------------- * Error handler * ----------------------------------------------------------------- */ /* * IDAHandleFailure * * This routine prints error messages for all cases of failure by * IDAStep. It returns to IDASolve the value that it is to return to * the user. */ static int IDAHandleFailure(IDAMem IDA_mem, int sflag) { /* Depending on sflag, print error message and return error flag */ switch (sflag) { case IDA_ERR_FAIL: IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDA", "IDASolve", MSG_ERR_FAILS, tn, hh); return(IDA_ERR_FAIL); case IDA_CONV_FAIL: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDASolve", MSG_CONV_FAILS, tn, hh); return(IDA_CONV_FAIL); case IDA_LSETUP_FAIL: IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDASolve", MSG_SETUP_FAILED, tn); return(IDA_LSETUP_FAIL); case IDA_LSOLVE_FAIL: IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDASolve", MSG_SOLVE_FAILED, tn); return(IDA_LSOLVE_FAIL); case IDA_REP_RES_ERR: IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDA", "IDASolve", MSG_REP_RES_ERR, tn); return(IDA_REP_RES_ERR); case IDA_RES_FAIL: IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDASolve", MSG_RES_NONRECOV, tn); return(IDA_RES_FAIL); case IDA_CONSTR_FAIL: IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDASolve", MSG_FAILED_CONSTR, tn); return(IDA_CONSTR_FAIL); } return -99; } /* * ----------------------------------------------------------------- * Main IDAStep function * ----------------------------------------------------------------- */ /* * IDAStep * * This routine performs one internal IDA step, from tn to tn + hh. * It calls other routines to do all the work. * * It solves a system of differential/algebraic equations of the form * F(t,y,y') = 0, for one step. In IDA, tt is used for t, * yy is used for y, and yp is used for y'. The function F is supplied as 'res' * by the user. * * The methods used are modified divided difference, fixed leading * coefficient forms of backward differentiation formulas. * The code adjusts the stepsize and order to control the local error per step. * * The main operations done here are as follows: * * initialize various quantities; * * setting of multistep method coefficients; * * solution of the nonlinear system for yy at t = tn + hh; * * deciding on order reduction and testing the local error; * * attempting to recover from failure in nonlinear solver or error test; * * resetting stepsize and order for the next step. * * updating phi and other state data if successful; * * On a failure in the nonlinear system solution or error test, the * step may be reattempted, depending on the nature of the failure. * * Variables or arrays (all in the IDAMem structure) used in IDAStep are: * * tt -- Independent variable. * yy -- Solution vector at tt. * yp -- Derivative of solution vector after successful stelp. * res -- User-supplied function to evaluate the residual. See the * description given in file ida.h . * lsetup -- Routine to prepare for the linear solver call. It may either * save or recalculate quantities used by lsolve. (Optional) * lsolve -- Routine to solve a linear system. A prior call to lsetup * may be required. * hh -- Appropriate step size for next step. * ewt -- Vector of weights used in all convergence tests. * phi -- Array of divided differences used by IDAStep. This array is composed * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum * order for the problem, maxord, plus 1. * * Return values are: * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR * IDA_LSOLVE_FAIL IDA_ERR_FAIL * IDA_CONSTR_FAIL IDA_CONV_FAIL * IDA_REP_RES_ERR */ static int IDAStep(IDAMem IDA_mem) { realtype saved_t, ck; realtype err_k, err_km1; int ncf, nef; int nflag, kflag; saved_t = tn; ncf = nef = 0; if (nst == ZERO){ kk = 1; kused = 0; hused = ZERO; psi[0] = hh; cj = ONE/hh; phase = 0; ns = 0; } /* To prevent 'unintialized variable' warnings */ err_k = ZERO; err_km1 = ZERO; /* Looping point for attempts to take a step */ loop { /*----------------------- Set method coefficients -----------------------*/ IDASetCoeffs(IDA_mem, &ck); kflag = IDA_SUCCESS; /*---------------------------------------------------- If tn is past tstop (by roundoff), reset it to tstop. -----------------------------------------------------*/ tn = tn + hh; if (tstopset) { if ((tn - tstop)*hh > ZERO) tn = tstop; } /*----------------------- Advance state variables -----------------------*/ /* Nonlinear system solution */ nflag = IDANls(IDA_mem); /* If NLS was successful, perform error test */ if (nflag == IDA_SUCCESS) nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &ncfn, &ncf, &netf, &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(nst==0) IDAReset(IDA_mem); continue; } /* kflag == IDA_SUCCESS */ break; } /* Nonlinear system solve and error test were both successful; update data, and consider change of step and/or order */ IDACompleteStep(IDA_mem, err_k, err_km1); /* Rescale ee vector to be the estimated local error Notes: (1) altering the value of ee is permissible since it will be re-initialized to the zero vector by IDASolve()->IDAStep()->IDANls()->IDANewtonIter() before it is needed again (2) the value of ee is only valid if IDAHandleNFlag() returns either PREDICT_AGAIN or IDA_SUCCESS */ N_VScale(ck, ee, ee); return(IDA_SUCCESS); } /* * IDASetCoeffs * * This routine computes the coefficients relevant to the current step. * The counter ns counts the number of consecutive steps taken at * constant stepsize h and order k, up to a maximum of k + 2. * Then the first ns components of beta will be one, and on a step * with ns = k + 2, the coefficients alpha, etc. need not be reset here. * Also, IDACompleteStep prohibits an order increase until ns = k + 2. */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck) { int i; realtype temp1, temp2, alpha0, alphas; /* Set coefficients for the current stepsize h */ if (hh != hused || kk != kused) ns = 0; ns = MIN(ns+1,kused+2); if (kk+1 >= ns){ beta[0] = ONE; alpha[0] = ONE; temp1 = hh; gamma[0] = ZERO; sigma[0] = ONE; for(i=1;i<=kk;i++){ temp2 = psi[i-1]; psi[i-1] = temp1; beta[i] = beta[i-1] * psi[i-1] / temp2; temp1 = temp2 + hh; alpha[i] = hh / temp1; sigma[i] = i * sigma[i-1] * alpha[i]; gamma[i] = gamma[i-1] + alpha[i-1] / hh; } psi[kk] = temp1; } /* compute alphas, alpha0 */ alphas = ZERO; alpha0 = ZERO; for(i=0;i temp2) callSetup = TRUE;} {if (cj != cjlast) ss=HUNDRED;} } /* Begin the main loop. This loop is traversed at most twice. The second pass only occurs when the first pass had a recoverable failure with old Jacobian data */ loop{ /* Compute predicted values for yy and yp, and compute residual there. */ IDAPredict(IDA_mem); retval = res(tn, yy, yp, delta, user_data); nre++; if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); /* If indicated, call linear solver setup function and reset parameters. */ if (callSetup){ nsetups++; retval = lsetup(IDA_mem, yy, yp, delta, tempv1, tempv2, tempv3); cjold = cj; cjratio = ONE; ss = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); } /* Call the Newton iteration routine. */ retval = IDANewtonIter(IDA_mem); /* Retry the current step on recoverable failure with old Jacobian data. */ tryAgain = (retval>0)&&(setupNonNull) &&(!callSetup); if (tryAgain){ callSetup = TRUE; continue; } else break; } /* end of loop */ if (retval != IDA_SUCCESS) return(retval); /* If otherwise successful, check and enforce inequality constraints. */ if (constraintsSet){ /* Check constraints and get mask vector mm, set where constraints failed */ constraintsPassed = N_VConstrMask(constraints,yy,mm); if (constraintsPassed) return(IDA_SUCCESS); else { N_VCompare(ONEPT5, constraints, tempv1); /* a , where a[i] =1. when |c[i]| = 2 , c the vector of constraints */ N_VProd(tempv1, constraints, tempv1); /* a * c */ N_VDiv(tempv1, ewt, tempv1); /* a * c * wt */ N_VLinearSum(ONE, yy, -PT1, tempv1, tempv1);/* y - 0.1 * a * c * wt */ N_VProd(tempv1, mm, tempv1); /* v = mm*(y-.1*a*c*wt) */ vnorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, FALSE); /* ||v|| */ /* If vector v of constraint corrections is small in norm, correct and accept this step */ if (vnorm <= epsNewt){ N_VLinearSum(ONE, ee, -ONE, tempv1, ee); /* ee <- ee - v */ return(IDA_SUCCESS); } else { /* Constraints not met -- reduce h by computing rr = h'/h */ N_VLinearSum(ONE, phi[0], -ONE, yy, tempv1); N_VProd(mm, tempv1, tempv1); rr = PT9*N_VMinQuotient(phi[0], tempv1); rr = MAX(rr,PT1); return(IDA_CONSTR_RECVR); } } } return(IDA_SUCCESS); } /* * IDAPredict * * This routine predicts the new values for vectors yy and yp. */ static void IDAPredict(IDAMem IDA_mem) { int j; N_VScale(ONE, phi[0], yy); N_VConst(ZERO, yp); for(j=1; j<=kk; j++) { N_VLinearSum(ONE, phi[j], ONE, yy, yy); N_VLinearSum(gamma[j], phi[j], ONE, yp, yp); } } /* * IDANewtonIter * * This routine performs the Newton iteration. * It assumes that delta contains the initial residual vector on entry. * If the iteration succeeds, it returns the value IDA_SUCCESS = 0. * If not, it returns either: * a positive value (for a recoverable failure), namely one of: * IDA_RES_RECVR * IDA_LSOLVE_RECVR * IDA_NCONV_RECVR * or * a negative value (for a nonrecoverable failure), namely one of: * IDA_RES_FAIL * IDA_LSOLVE_FAIL * * NOTE: This routine uses N_Vector savres, which is preset to tempv1. */ static int IDANewtonIter(IDAMem IDA_mem) { int mnewt, retval; realtype delnrm, oldnrm, rate; /* Initialize counter mnewt and cumulative correction vector ee. */ mnewt = 0; N_VConst(ZERO, ee); /* Initialize oldnrm to avoid compiler warning message */ oldnrm = ZERO; /* Looping point for Newton iteration. Break out on any error. */ loop { nni++; /* Save a copy of the residual vector in savres. */ N_VScale(ONE, delta, savres); /* Call the lsolve function to get correction vector delta. */ retval = lsolve(IDA_mem, delta, ewt, yy, yp, savres); if (retval < 0) return(IDA_LSOLVE_FAIL); if (retval > 0) return(IDA_LSOLVE_RECVR); /* Apply delta to yy, yp, and ee, and get norm(delta). */ N_VLinearSum(ONE, yy, -ONE, delta, yy); N_VLinearSum(ONE, ee, -ONE, delta, ee); N_VLinearSum(ONE, yp, -cj, delta, yp); delnrm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); /* Test for convergence, first directly, then with rate estimate. */ if (mnewt == 0){ oldnrm = delnrm; if (delnrm <= toldel) return(IDA_SUCCESS); } else { rate = RPowerR( delnrm/oldnrm, ONE/mnewt ); if (rate > RATEMAX) return(IDA_NCONV_RECVR); ss = rate/(ONE - rate); } if (ss*delnrm <= epsNewt) return(IDA_SUCCESS); /* Not yet converged. Increment mnewt and test for max allowed. */ mnewt++; if (mnewt >= maxcor) {retval = IDA_NCONV_RECVR; break;} /* Call res for new residual and check error flag from res. */ retval = res(tn, yy, yp, delta, user_data); nre++; if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); /* Loop for next iteration. */ } /* end of Newton iteration loop */ /* All error returns exit here. */ return(retval); } /* * ----------------------------------------------------------------- * Error test * ----------------------------------------------------------------- */ /* * IDATestError * * This routine estimates errors at orders k, k-1, k-2, decides * whether or not to suggest an order decrease, and performs * the local error test. * * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDATestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1) { realtype err_km2; /* estimated error at k-2 */ realtype enorm_k, enorm_km1, enorm_km2; /* error norms */ realtype terr_k, terr_km1, terr_km2; /* local truncation error norms */ /* Compute error for order k. */ enorm_k = IDAWrmsNorm(IDA_mem, ee, ewt, suppressalg); *err_k = sigma[kk] * enorm_k; terr_k = (kk+1) * (*err_k); knew = kk; if ( kk > 1 ) { /* Compute error at order k-1 */ N_VLinearSum(ONE, phi[kk], ONE, ee, delta); enorm_km1 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); *err_km1 = sigma[kk-1] * enorm_km1; terr_km1 = kk * (*err_km1); if ( kk > 2 ) { /* Compute error at order k-2 */ N_VLinearSum(ONE, phi[kk-1], ONE, delta, delta); enorm_km2 = IDAWrmsNorm(IDA_mem, delta, ewt, suppressalg); err_km2 = sigma[kk-2] * enorm_km2; terr_km2 = (kk-1) * err_km2; /* Decrease order if errors are reduced */ if (MAX(terr_km1, terr_km2) <= terr_k) knew = kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) knew = kk - 1; } } /* Perform error test */ if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDARestore * * This routine restores tn, psi, and phi in the event of a failure. * It changes back phi-star to phi (changed in IDASetCoeffs) */ static void IDARestore(IDAMem IDA_mem, realtype saved_t) { int j; tn = saved_t; for (j = 1; j <= kk; j++) psi[j-1] = psi[j] - hh; for (j = ns; j <= kk; j++) N_VScale(ONE/beta[j], phi[j], phi[j]); } /* * ----------------------------------------------------------------- * Handler for convergence and/or error test failures * ----------------------------------------------------------------- */ /* * IDAHandleNFlag * * This routine handles failures indicated by the input variable nflag. * Positive values indicate various recoverable failures while negative * values indicate nonrecoverable failures. This routine adjusts the * step size for recoverable failures. * * Possible nflag values (input): * * --convergence failures-- * IDA_RES_RECVR > 0 * IDA_LSOLVE_RECVR > 0 * IDA_CONSTR_RECVR > 0 * IDA_NCONV_RECVR > 0 * IDA_RES_FAIL < 0 * IDA_LSOLVE_FAIL < 0 * IDA_LSETUP_FAIL < 0 * * --error test failure-- * ERROR_TEST_FAIL > 0 * * Possible kflag values (output): * * --recoverable-- * PREDICT_AGAIN * * --nonrecoverable-- * IDA_CONSTR_FAIL * IDA_REP_RES_ERR * IDA_ERR_FAIL * IDA_CONV_FAIL * IDA_RES_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL */ static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr) { realtype err_knew; phase = 1; if (nflag != ERROR_TEST_FAIL) { /*----------------------- Nonlinear solver failed -----------------------*/ (*ncfPtr)++; /* local counter for convergence failures */ (*ncfnPtr)++; /* global counter for convergence failures */ if (nflag < 0) { /* nonrecoverable failure */ return(nflag); } else { /* recoverable failure */ /* Reduce step size for a new prediction Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */ if (nflag != IDA_CONSTR_RECVR) rr = QUARTER; hh *= rr; /* Test if there were too many convergence failures */ if (*ncfPtr < maxncf) return(PREDICT_AGAIN); else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); else return(IDA_CONV_FAIL); } } else { /*----------------- Error Test failed -----------------*/ (*nefPtr)++; /* local counter for error test failures */ (*netfPtr)++; /* global counter for error test failures */ if (*nefPtr == 1) { /* On first error test failure, keep current order or lower order by one. Compute new stepsize based on differences of the solution. */ err_knew = (kk==knew)? err_k : err_km1; kk = knew; rr = PT9 * RPowerR( TWO * err_knew + PT0001,(-ONE/(kk+1)) ); rr = MAX(QUARTER, MIN(PT9,rr)); hh *=rr; return(PREDICT_AGAIN); } else if (*nefPtr == 2) { /* On second error test failure, use current order or decrease order by one. Reduce stepsize by factor of 1/4. */ kk = knew; rr = QUARTER; hh *= rr; return(PREDICT_AGAIN); } else if (*nefPtr < maxnef) { /* On third and subsequent error test failures, set order to 1. Reduce stepsize by factor of 1/4. */ kk = 1; rr = QUARTER; hh *= rr; return(PREDICT_AGAIN); } else { /* Too many error test failures */ return(IDA_ERR_FAIL); } } } /* * IDAReset * * This routine is called only if we need to predict again at the * very first step. In such a case, reset phi[1] and psi[0]. */ static void IDAReset(IDAMem IDA_mem) { psi[0] = hh; N_VScale(rr, phi[1], phi[1]); } /* * ----------------------------------------------------------------- * Function called after a successful step * ----------------------------------------------------------------- */ /* * IDACompleteStep * * This routine completes a successful step. It increments nst, * saves the stepsize and order used, makes the final selection of * stepsize and order for the next step, and updates the phi array. */ static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1) { int j, kdiff, action; realtype terr_k, terr_km1, terr_kp1; realtype err_knew, err_kp1; realtype enorm, tmp, hnew; nst++; kdiff = kk - kused; kused = kk; hused = hh; if ( (knew == kk-1) || (kk == maxord) ) phase = 1; /* For the first few steps, until either a step fails, or the order is reduced, or the order reaches its maximum, we raise the order and double the stepsize. During these steps, phase = 0. Thereafter, phase = 1, and stepsize and order are set by the usual local error algorithm. Note that, after the first step, the order is not increased, as not all of the neccessary information is available yet. */ if (phase == 0) { if(nst > 1) { kk++; hnew = TWO * hh; if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; hh = hnew; } } else { action = UNSET; /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ if (knew == kk-1) {action = LOWER; goto takeaction;} if (kk == maxord) {action = MAINTAIN; goto takeaction;} if ( (kk+1 >= ns ) || (kdiff == 1)) {action = MAINTAIN; goto takeaction;} /* Estimate the error at order k+1, unless already decided to reduce order, or already using maximum order, or stepsize has not been constant, or order was just raised. */ N_VLinearSum (ONE, ee, -ONE, phi[kk+1], tempv1); enorm = IDAWrmsNorm(IDA_mem, tempv1, ewt, suppressalg); err_kp1= enorm/(kk+2); /* Choose among orders k-1, k, k+1 using local truncation error norms. */ terr_k = (kk+1) * err_k; terr_kp1 = (kk+2) * err_kp1; if (kk == 1) { if (terr_kp1 >= HALF * terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } else { terr_km1 = kk * err_km1; if (terr_km1 <= MIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;} else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } takeaction: /* Set the estimated error norm and, on change of order, reset kk. */ if (action == RAISE) { kk++; err_knew = err_kp1; } else if (action == LOWER) { kk--; err_knew = err_km1; } else { err_knew = err_k; } /* Compute rr = tentative ratio hnew/hh from error norm estimate. Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is. If hh is reduced, hnew/hh is restricted to be between .5 and .9. */ hnew = hh; rr = RPowerR( (TWO * err_knew + PT0001) , (-ONE/(kk+1) ) ); if (rr >= TWO) { hnew = TWO * hh; if( (tmp = ABS(hnew)*hmax_inv) > ONE ) hnew /= tmp; } else if (rr <= ONE ) { rr = MAX(HALF, MIN(PT9,rr)); hnew = hh * rr; } hh = hnew; } /* end of phase if block */ /* Save ee for possible order increase on next step */ if (kused < maxord) { N_VScale(ONE, ee, phi[kused+1]); } /* Update phi arrays */ N_VLinearSum(ONE, ee, ONE, phi[kused], phi[kused]); for (j= kused-1; j>=0; j--) N_VLinearSum(ONE, phi[j], ONE, phi[j+1], phi[j]); } /* * ----------------------------------------------------------------- * Interpolated output * ----------------------------------------------------------------- */ /* * IDAGetSolution * * This routine evaluates y(t) and y'(t) as the value and derivative of * the interpolating polynomial at the independent variable t, and stores * the results in the vectors yret and ypret. It uses the current * independent variable value, tn, and the method order last used, kused. * This function is called by IDASolve with t = tout, t = tn, or t = tstop. * * If kused = 0 (no step has been taken), or if t = tn, then the order used * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0]. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret) { IDAMem IDA_mem; realtype tfuzz, tp, delt, c, d, gam; int j, kord; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDAGetSolution", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * uround * (ABS(tn) + ABS(hh)); if (hh < ZERO) tfuzz = - tfuzz; tp = tn - hused - tfuzz; if ((t - tp)*hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDA", "IDAGetSolution", MSG_BAD_T, t, tn-hused, tn); return(IDA_BAD_T); } /* Initialize yret = phi[0], ypret = 0, and kord = (kused or 1). */ N_VScale (ONE, phi[0], yret); N_VConst (ZERO, ypret); kord = kused; if (kused == 0) kord = 1; /* Accumulate multiples of columns phi[j] into yret and ypret. */ delt = t - tn; c = ONE; d = ZERO; gam = delt/psi[0]; for (j=1; j <= kord; j++) { d = d*gam + c/psi[j-1]; c = c*gam; gam = (delt + psi[j-1])/psi[j]; N_VLinearSum(ONE, yret, c, phi[j], yret); N_VLinearSum(ONE, ypret, d, phi[j], ypret); } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Norm function * ----------------------------------------------------------------- */ /* * IDAWrmsNorm * * Returns the WRMS norm of vector x with weights w. * If mask = TRUE, the weight vector w is masked by id, i.e., * nrm = N_VWrmsNormMask(x,w,id); * Otherwise, * nrm = N_VWrmsNorm(x,w); * * mask = FALSE when the call is made from the nonlinear solver. * mask = suppressalg otherwise. */ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask) { realtype nrm; if (mask) nrm = N_VWrmsNormMask(x, w, id); else nrm = N_VWrmsNorm(x, w); return(nrm); } /* * ----------------------------------------------------------------- * Functions for rootfinding * ----------------------------------------------------------------- */ /* * IDARcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * IDA_SUCCESS = 0 otherwise. */ static int IDARcheck1(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < nrtfn; i++) iroots[i] = 0; tlo = tn; ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; /* Evaluate g at initial t and check for zero values. */ retval = gfun (tlo, phi[0], phi[1], glo, user_data); nge = 1; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(glo[i]) == ZERO) { zroot = TRUE; gactive[i] = FALSE; } } if (!zroot) return(IDA_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = MAX(ttol/ABS(hh), PT1); smallh = hratio*hh; tplus = tlo + smallh; N_VLinearSum(ONE, phi[0], smallh, phi[1], yy); retval = gfun (tplus, yy, phi[1], ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < nrtfn; i++) { if (!gactive[i] && ABS(ghi[i]) != ZERO) { gactive[i] = TRUE; glo[i] = ghi[i]; } } return(IDA_SUCCESS); } /* * IDARcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * IDASolve. This may be the previous tn, the previous tout value, * or the last root location. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * CLOSERT (>0) if a close pair of zeros was found, or * RTFOUND (>0) if a new zero of g was found near tlo, or * IDA_SUCCESS (=0) otherwise. */ static int IDARcheck2(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (irfnd == 0) return(IDA_SUCCESS); (void) IDAGetSolution(IDA_mem, tlo, yy, yp); retval = gfun (tlo, yy, yp, glo, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) iroots[i] = 0; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(glo[i]) == ZERO) { zroot = TRUE; iroots[i] = 1; } } if (!zroot) return(IDA_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; smallh = (hh > ZERO) ? ttol : -ttol; tplus = tlo + smallh; if ( (tplus - tn)*hh >= ZERO) { hratio = smallh/hh; N_VLinearSum(ONE, yy, hratio, phi[1], yy); } else { (void) IDAGetSolution(IDA_mem, tplus, yy, yp); } retval = gfun (tplus, yy, yp, ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if (iroots[i] == 1) return(CLOSERT); zroot = TRUE; iroots[i] = 1; } else { if (iroots[i] == 1) glo[i] = ghi[i]; } } if (zroot) return(RTFOUND); return(IDA_SUCCESS); } /* * IDARcheck3 * * This routine interfaces to IDARootfind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * RTFOUND (>0) if a root of g was found, or * IDA_SUCCESS (=0) otherwise. */ static int IDARcheck3(IDAMem IDA_mem) { int i, ier, retval; /* Set thi = tn or tout, whichever comes first. */ if (taskc == IDA_ONE_STEP) thi = tn; if (taskc == IDA_NORMAL) { thi = ( (toutc - tn)*hh >= ZERO) ? tn : toutc; } /* Get y and y' at thi. */ (void) IDAGetSolution(IDA_mem, thi, yy, yp); /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */ retval = gfun (thi, yy, yp, ghi, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); ttol = (ABS(tn) + ABS(hh))*uround*HUNDRED; ier = IDARootfind(IDA_mem); if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL); for(i=0; i 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to TRUE for all i=0,...,nrtfn-1, but it may be * reset to FALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on TRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (ABS(tlo), ABS(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, and must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL (<0) if the g function failed, or * RTFOUND = 1 if a root of g was found, or * IDA_SUCCESS = 0 otherwise. * */ static int IDARootfind(IDAMem IDA_mem) { realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { trout = thi; for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; if (!zroot) return(IDA_SUCCESS); for (i = 0; i < nrtfn; i++) { iroots[i] = 0; if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alph to avoid compiler warning */ alph = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; loop { /* Looping point */ /* Set weight alph. On the first two passes, set alph = 1. Thereafter, reset alph according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alph = 1. If the sides were the same, then double alph (if high side), or halve alph (if low side). The next guess tmid is the secant method value if alph = 1, but is closer to tlo if alph < 1, and closer to thi if alph > 1. */ if (sideprev == side) { alph = (side == 2) ? alph*TWO : alph*HALF; } else { alph = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alph*glo[imax]); if (ABS(tmid - tlo) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = tlo + fracsub*(thi - tlo); } if (ABS(thi - tmid) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = thi - fracsub*(thi - tlo); } (void) IDAGetSolution(IDA_mem, tmid, yy, yp); retval = gfun (tmid, yy, yp, grout, user_data); nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; sideprev = side; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(grout[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(grout[i]/(grout[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (ABS(thi - tlo) <= ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ tlo = tmid; for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (ABS(thi - tlo) <= ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ trout = thi; for (i = 0; i < nrtfn; i++) { grout[i] = ghi[i]; iroots[i] = 0; if(!gactive[i]) continue; if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ================================================================= * IDA error message handling functions * ================================================================= */ /* * IDAProcessError is a high level error handling function * - if ida_mem==NULL it prints the error message to stderr * - otherwise, it sets-up and calls the error hadling function * pointed to by ida_ehfun */ #define ehfun (IDA_mem->ida_ehfun) #define eh_data (IDA_mem->ida_eh_data) void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to IDAProcessError) */ va_start(ap, msgfmt); if (IDA_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, msgfmt); fprintf(stderr, "\n\n"); #endif } else { /* We can call ehfun */ /* Compose the message */ vsprintf(msg, msgfmt, ap); /* Call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* IDAErrHandler is the default error handling function. It sends the error message to the stream pointed to by ida_errfp */ #define errfp (IDA_mem->ida_errfp) void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { IDAMem IDA_mem; char err_type[10]; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; if (error_code == IDA_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (errfp!=NULL) { fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(errfp," %s\n\n",msg); } #endif return; } sundials-2.5.0/src/ida/fcmix/0000755000175000017500000000000011767174700016666 5ustar sylvestresylvestresundials-2.5.0/src/ida/fcmix/fidalapband.c0000600000175000017500000000665011741421215021242 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA/IDALAPACK, for the case of * a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* function names, prototypes, global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_BJAC(long int*, long int*, long int*, long int*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_BANDSETJAC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDADlsSetBandJacFn(IDA_idamem, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDADlsSetBandJacFn(IDA_idamem, FIDABandJac); } return; } /*************************************************/ int FIDALapackBandJac(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; realtype h; long int eband; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data, &c_j, jacdata, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidaewt.c0000600000175000017500000000454511741421215020441 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:29:00 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA, for the case of a * user-supplied error weight calculation routine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual function names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ /*************************************************/ /* Prototype of user-supplied Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage (IDAEwtFn) */ extern "C" { #endif extern void FIDA_EWT(realtype*, realtype*, /* Y, EWT */ long int*, realtype*, /* IPAR, RPAR */ int*); /* IER */ #ifdef __cplusplus } #endif /*************************************************/ /* * User-callable function to interface to IDASetEwtFn. */ void FIDA_EWTSET(int *flag, int *ier) { *ier = 0; if (*flag != 0) { *ier = IDAWFtolerances(IDA_idamem, FIDAEwtSet); } return; } /*************************************************/ /* * C function to interface between IDA and a Fortran subroutine FIDAVEWT. */ int FIDAEwtSet(N_Vector y, N_Vector ewt, void *user_data) { int ier; realtype *y_data, *ewt_data; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ y_data = ewt_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; y_data = N_VGetArrayPointer(y); ewt_data = N_VGetArrayPointer(ewt); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_EWT(y_data, ewt_data, IDA_userdata->ipar, IDA_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidajtimes.c0000600000175000017500000000675111741421215021136 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:29:00 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The C function FIDAJtimes is to interface between the * IDASPILS modules and the user-supplied Jacobian-vector * product routine FIDAJTIMES. Note the use of the generic name * FIDA_JTIMES below. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual fn. names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_JTIMES(realtype*, realtype*, realtype*, /* T, Y, YP */ realtype*, realtype*, realtype*, /* R, V, FJV */ realtype*, realtype*, realtype*, /* CJ, EWT, H */ long int*, realtype*, /* IPAR, RPAR */ realtype*, realtype*, /* WK1, WK2 */ int*); /* IER */ #ifdef __cplusplus } #endif /*************************************************/ void FIDA_SPILSSETJAC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDASpilsSetJacTimesVecFn(IDA_idamem, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDASpilsSetJacTimesVecFn(IDA_idamem, FIDAJtimes); } return; } /*************************************************/ int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *yy_data, *yp_data, *rr_data, *vdata, *Jvdata, *ewtdata; realtype *v1data, *v2data; realtype h; FIDAUserData IDA_userdata; int ier; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = vdata = Jvdata = ewtdata = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); vdata = N_VGetArrayPointer(v); Jvdata = N_VGetArrayPointer(Jv); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_JTIMES(&t, yy_data, yp_data, rr_data, vdata, Jvdata, &c_j, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidalapdense.c0000600000175000017500000000652111741421215021431 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA/IDALAPACK, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual function names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_DJAC(long int*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_LAPACKDENSESETJAC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDADlsSetDenseJacFn(IDA_idamem, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDADlsSetDenseJacFn(IDA_idamem, FIDADenseJac); } return; } /*************************************************/ int FIDALapackDenseJac(long int N, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; realtype h; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); jacdata = DENSE_COL(Jac,0); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine*/ FIDA_DJAC(&N, &t, yy_data, yp_data, rr_data, jacdata, &c_j, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/CMakeLists.txt0000600000175000017500000000231711741421215021405 0ustar sylvestresylvestre# CMakeLists.txt file for the FIDA library # Add variable fida_SOURCES with the sources for the FIDA library SET(fida_SOURCES fidaband.c fidabbd.c fida.c fidadense.c fidaewt.c fidajtimes.c fidapreco.c fidaroot.c ) IF(LAPACK_FOUND) SET(fida_BL_SOURCES fidalapack.c fidalapdense.c fidalapband.c) ELSE(LAPACK_FOUND) SET(fida_BL_SOURCES "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files (both for fida and ida) INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(..) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Only build STATIC libraries (we cannot build shared libraries # for the FCMIX interfaces due to unresolved symbol errors # coming from inexistent user-provided functions) # Add the build target for the FIDA library ADD_LIBRARY(sundials_fida_static STATIC ${fida_SOURCES} ${fida_BL_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_fida_static PROPERTIES OUTPUT_NAME sundials_fida CLEAN_DIRECT_OUTPUT 1) # Install the FIDA library INSTALL(TARGETS sundials_fida_static DESTINATION lib) # MESSAGE(STATUS "Added IDA FCMIX module") sundials-2.5.0/src/ida/fcmix/Makefile.in0000600000175000017500000001056011741421215020711 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.8 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2005, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FIDA module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../../.. INCLUDES = -I$(top_srcdir)/include -I$(top_srcdir)/src/ida -I$(top_builddir)/include LIB_REVISION = 1:0:0 FIDA_LIB = libsundials_fida.la FIDA_SRC_FILES = fida.c fidaband.c fidadense.c fidajtimes.c fidapreco.c fidaewt.c fidaroot.c fidabbd.c FIDA_BL_SRC_FILES = fidalapack.c fidalapdense.c fidalapband.c FIDA_OBJ_FILES = $(FIDA_SRC_FILES:.c=.o) FIDA_BL_OBJ_FILES = $(FIDA_BL_SRC_FILES:.c=.o) FIDA_LIB_FILES = $(FIDA_SRC_FILES:.c=.lo) FIDA_BL_LIB_FILES = $(FIDA_BL_SRC_FILES:.c=.lo) mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(FIDA_LIB) $(FIDA_LIB): $(FIDA_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: $(FIDA_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FIDA_LIB) $(FIDA_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) lib_with_bl: $(FIDA_LIB_FILES) $(FIDA_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FIDA_LIB) $(FIDA_LIB_FILES) $(FIDA_BL_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) install: $(FIDA_LIB) $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(FIDA_LIB) $(libdir) uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(FIDA_LIB) clean: $(LIBTOOL) --mode=clean rm -f $(FIDA_LIB) rm -f $(FIDA_LIB_FILES) rm -f $(FIDA_BL_LIB_FILES) rm -f $(FIDA_OBJ_FILES) rm -f $(FIDA_BL_OBJ_FILES) distclean: clean rm -f Makefile fida.lo: $(srcdir)/fida.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fida.c fidaewt.lo: $(srcdir)/fidaewt.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaewt.c fidaband.lo: $(srcdir)/fidaband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaband.c fidadense.lo: $(srcdir)/fidadense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidadense.c fidalapack.lo: $(srcdir)/fidalapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapack.c fidalapband.lo: $(srcdir)/fidalapband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapband.c fidalapdense.lo: $(srcdir)/fidalapdense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidalapdense.c fidajtimes.lo: $(srcdir)/fidajtimes.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidajtimes.c fidapreco.lo: $(srcdir)/fidapreco.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidapreco.c fidabbd.lo: $(srcdir)/fidabbd.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidabbd.c fidaroot.lo: $(srcdir)/fidaroot.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fidaroot.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/ida/fcmix/fida.c0000600000175000017500000004640211741421215017717 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the Fortran interface to * the IDA package. See fida.h for usage. * NOTE: Some routines are necessarily stored elsewhere to avoid * linking problems. * ----------------------------------------------------------------- */ #include #include #include #include "fida.h" /* function names, prototypes, global variables */ #include "ida_impl.h" /* definition of IDAMem type */ #include /* prototypes for IDABAND interface routines */ #include /* prototypes for IDADENSE interface routines */ #include /* prototypes for IDASPTFQMR interface routines */ #include /* prototypes for IDASPBCG interface routines */ #include /* prototypes for IDASPGMR interface routines */ /*************************************************/ /* Definitions for global variables shared amongst various routines */ N_Vector F2C_IDA_ypvec, F2C_IDA_ewtvec; void *IDA_idamem; long int *IDA_iout; realtype *IDA_rout; int IDA_ls; int IDA_nrtfn; /*************************************************/ /* private constant(s) */ #define ZERO RCONST(0.0) /*************************************************/ /* Prototype of user-supplied Fortran routine (IDAResFn) */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_RESFUN(realtype*, /* T */ realtype*, /* Y */ realtype*, /* YP */ realtype*, /* R */ long int*, /* IPAR */ realtype*, /* RPAR */ int*); /* IER */ #ifdef __cplusplus } #endif /*************************************************/ void FIDA_MALLOC(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, long int *iout, realtype *rout, long int *ipar, realtype *rpar, int *ier) { N_Vector Vatol; FIDAUserData IDA_userdata; *ier = 0; /* Check for required vector operations */ if ((F2C_IDA_vec->ops->nvgetarraypointer == NULL) || (F2C_IDA_vec->ops->nvsetarraypointer == NULL)) { *ier = -1; printf("A required vector operation is not implemented.\n\n"); return; } /* Initialize all pointers to NULL */ IDA_idamem = NULL; Vatol = NULL; F2C_IDA_ypvec = F2C_IDA_ewtvec = NULL; /* Create IDA object */ IDA_idamem = IDACreate(); if (IDA_idamem == NULL) { *ier = -1; return; } /* Set and attach user data */ IDA_userdata = NULL; IDA_userdata = (FIDAUserData) malloc(sizeof *IDA_userdata); if (IDA_userdata == NULL) { *ier = -1; return; } IDA_userdata->rpar = rpar; IDA_userdata->ipar = ipar; *ier = IDASetUserData(IDA_idamem, IDA_userdata); if(*ier != IDA_SUCCESS) { free(IDA_userdata); IDA_userdata = NULL; *ier = -1; return; } /* Attach user's yy0 to F2C_IDA_vec */ N_VSetArrayPointer(yy0, F2C_IDA_vec); /* Create F2C_IDA_ypvec and attach user's yp0 to it */ F2C_IDA_ypvec = NULL; F2C_IDA_ypvec = N_VCloneEmpty(F2C_IDA_vec); if (F2C_IDA_ypvec == NULL) { free(IDA_userdata); IDA_userdata = NULL; *ier = -1; } N_VSetArrayPointer(yp0, F2C_IDA_ypvec); /* Call IDAInit */ *ier = IDAInit(IDA_idamem, FIDAresfn, *t0, F2C_IDA_vec, F2C_IDA_ypvec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); /* On failure, clean-up and exit */ if (*ier != IDA_SUCCESS) { N_VDestroy(F2C_IDA_ypvec); free(IDA_userdata); IDA_userdata = NULL; *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = IDASStolerances(IDA_idamem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol= N_VCloneEmpty(F2C_IDA_vec); if (Vatol == NULL) { free(IDA_userdata); IDA_userdata = NULL; *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, clean-up and exit */ if (*ier != IDA_SUCCESS) { free(IDA_userdata); IDA_userdata = NULL; *ier = -1; return; } /* Grab optional output arrays and store them in global variables */ IDA_iout = iout; IDA_rout = rout; /* Store the unit roundoff in rout for user access */ IDA_rout[5] = UNIT_ROUNDOFF; /* Set F2C_IDA_ewtvec on NULL */ F2C_IDA_ewtvec = NULL; return; } /*************************************************/ void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, int *ier) { N_Vector Vatol; *ier = 0; /* Initialize all pointers to NULL */ Vatol = NULL; /* Attach user's yy0 to F2C_IDA_vec */ N_VSetArrayPointer(yy0, F2C_IDA_vec); /* Attach user's yp0 to F2C_IDA_ypvec */ N_VSetArrayPointer(yp0, F2C_IDA_ypvec); /* Call IDAReInit */ *ier = IDAReInit(IDA_idamem, *t0, F2C_IDA_vec, F2C_IDA_ypvec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } /* Set tolerances */ switch (*iatol) { case 1: *ier = IDASStolerances(IDA_idamem, *rtol, *atol); break; case 2: Vatol = NULL; Vatol= N_VCloneEmpty(F2C_IDA_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); N_VDestroy(Vatol); break; } /* On failure, exit */ if (*ier != IDA_SUCCESS) { *ier = -1; return; } return; } /*************************************************/ void FIDA_SETIIN(char key_name[], long int *ival, int *ier, int key_len) { if (!strncmp(key_name,"MAX_ORD", (size_t)key_len)) *ier = IDASetMaxOrd(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_NSTEPS", (size_t)key_len)) *ier = IDASetMaxNumSteps(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_ERRFAIL", (size_t)key_len)) *ier = IDASetMaxErrTestFails(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_NITERS", (size_t)key_len)) *ier = IDASetMaxNonlinIters(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_CONVFAIL", (size_t)key_len)) *ier = IDASetMaxConvFails(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"SUPPRESS_ALG", (size_t)key_len)) *ier = IDASetSuppressAlg(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_NSTEPS_IC", (size_t)key_len)) *ier = IDASetMaxNumStepsIC(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_NITERS_IC", (size_t)key_len)) *ier = IDASetMaxNumItersIC(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"MAX_NJE_IC", (size_t)key_len)) *ier = IDASetMaxNumJacsIC(IDA_idamem, (int) *ival); else if (!strncmp(key_name,"LS_OFF_IC", (size_t)key_len)) *ier = IDASetLineSearchOffIC(IDA_idamem, (int) *ival); else { *ier = -99; printf("FIDASETIIN: Unrecognized key.\n\n"); } } /***************************************************************************/ void FIDA_SETRIN(char key_name[], realtype *rval, int *ier, int key_len) { if (!strncmp(key_name,"INIT_STEP", (size_t)key_len)) *ier = IDASetInitStep(IDA_idamem, *rval); else if (!strncmp(key_name,"MAX_STEP", (size_t)key_len)) *ier = IDASetMaxStep(IDA_idamem, *rval); else if (!strncmp(key_name,"STOP_TIME", (size_t)key_len)) *ier = IDASetStopTime(IDA_idamem, *rval); else if (!strncmp(key_name,"NLCONV_COEF", (size_t)key_len)) *ier = IDASetNonlinConvCoef(IDA_idamem, *rval); else if (!strncmp(key_name,"NLCONV_COEF_IC", (size_t)key_len)) *ier = IDASetNonlinConvCoefIC(IDA_idamem, *rval); else if (!strncmp(key_name,"STEP_TOL_IC", (size_t)key_len)) *ier = IDASetStepToleranceIC(IDA_idamem, *rval); else { *ier = -99; printf("FIDASETRIN: Unrecognized key.\n\n"); } } /*************************************************/ void FIDA_SETVIN(char key_name[], realtype *vval, int *ier, int key_len) { N_Vector Vec; *ier = 0; if (!strncmp(key_name,"ID_VEC", (size_t)key_len)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_IDA_vec); if (Vec == NULL) { *ier = -1; return; } N_VSetArrayPointer(vval, Vec); IDASetId(IDA_idamem, Vec); N_VDestroy(Vec); } else if (!strncmp(key_name,"CONSTR_VEC", (size_t)key_len)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_IDA_vec); if (Vec == NULL) { *ier = -1; return; } N_VSetArrayPointer(vval, Vec); IDASetConstraints(IDA_idamem, Vec); N_VDestroy(Vec); } else { *ier = -99; printf("FIDASETVIN: Unrecognized key.\n\n"); } } /*************************************************/ void FIDA_TOLREINIT(int *iatol, realtype *rtol, realtype *atol, int *ier) { int itol; N_Vector Vatol=NULL; *ier = 0; itol = -1; if (*iatol == 1) { *ier = IDASStolerances(IDA_idamem, *rtol, *atol); } else { Vatol = NULL; Vatol = N_VCloneEmpty(F2C_IDA_vec); if (Vatol == NULL) { *ier = -1; return; } N_VSetArrayPointer(atol, Vatol); *ier = IDASVtolerances(IDA_idamem, *rtol, Vatol); N_VDestroy(Vatol); } return; } /*************************************************/ void FIDA_CALCIC(int *icopt, realtype *tout1, int *ier) { *ier = 0; *ier = IDACalcIC(IDA_idamem, *icopt, *tout1); return; } /*************************************************/ void FIDA_SPTFQMR(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; *ier = IDASptfqmr(IDA_idamem, *maxl); if (*ier != IDASPILS_SUCCESS) return; if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPTFQMR; return; } /*************************************************/ void FIDA_SPBCG(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; *ier = IDASpbcg(IDA_idamem, *maxl); if (*ier != IDASPILS_SUCCESS) return; if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPBCG; return; } /*************************************************/ void FIDA_SPGMR(int *maxl, int *gstype, int *maxrs, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; *ier = IDASpgmr(IDA_idamem, *maxl); if (*ier != IDASPILS_SUCCESS) return; if (*gstype != 0) { *ier = IDASpilsSetGSType(IDA_idamem, *gstype); if (*ier != IDASPILS_SUCCESS) return; } if (*maxrs != 0) { *ier = IDASpilsSetMaxRestarts(IDA_idamem, *maxrs); if (*ier != IDASPILS_SUCCESS) return; } if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPGMR; return; } /*************************************************/ void FIDA_DENSE(long int *neq, int *ier) { *ier = 0; *ier = IDADense(IDA_idamem, *neq); IDA_ls = IDA_LS_DENSE; return; } /*************************************************/ void FIDA_BAND(long int *neq, long int *mupper, long int *mlower, int *ier) { *ier = 0; *ier = IDABand(IDA_idamem, *neq, *mupper, *mlower); IDA_ls = IDA_LS_BAND; return; } /*************************************************/ void FIDA_SPTFQMRREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; if (*maxl > 0) { *ier = IDASpilsSetMaxl(IDA_idamem, *maxl); if (*ier != IDASPILS_SUCCESS) return; } if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPTFQMR; return; } /*************************************************/ void FIDA_SPBCGREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; if (*maxl > 0) { *ier = IDASpilsSetMaxl(IDA_idamem, *maxl); if (*ier != IDASPILS_SUCCESS) return; } if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPBCG; return; } /*************************************************/ void FIDA_SPGMRREINIT(int *gstype, int *maxrs, realtype *eplifac, realtype *dqincfac, int *ier) { *ier = 0; if (*gstype != 0) { *ier = IDASpilsSetGSType(IDA_idamem, *gstype); if (*ier != IDASPILS_SUCCESS) return; } if (*maxrs != 0) { *ier = IDASpilsSetMaxRestarts(IDA_idamem, *maxrs); if (*ier != IDASPILS_SUCCESS) return; } if (*eplifac != ZERO) { *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac); if (*ier != IDASPILS_SUCCESS) return; } if (*dqincfac != ZERO) { *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac); if (*ier != IDASPILS_SUCCESS) return; } IDA_ls = IDA_LS_SPGMR; return; } /*************************************************/ void FIDA_SOLVE(realtype *tout, realtype *tret, realtype *yret, realtype *ypret, int *itask, int *ier) { int klast, kcur; *ier = 0; /* Attach user data to vectors */ N_VSetArrayPointer(yret, F2C_IDA_vec); N_VSetArrayPointer(ypret, F2C_IDA_ypvec); *ier = IDASolve(IDA_idamem, *tout, tret, F2C_IDA_vec, F2C_IDA_ypvec, *itask); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VSetArrayPointer(NULL, F2C_IDA_ypvec); /* Set optional outputs */ IDAGetWorkSpace(IDA_idamem, &IDA_iout[0], /* LENRW */ &IDA_iout[1]); /* LENIW */ IDAGetIntegratorStats(IDA_idamem, &IDA_iout[2], /* NST */ &IDA_iout[3], /* NRE */ &IDA_iout[7], /* NSETUPS */ &IDA_iout[4], /* NETF */ &klast, /* KLAST */ &kcur, /* KCUR */ &IDA_rout[0], /* HINUSED */ &IDA_rout[1], /* HLAST */ &IDA_rout[2], /* HCUR */ &IDA_rout[3]); /* TCUR */ IDA_iout[8] = (long int) klast; IDA_iout[9] = (long int) kcur; IDAGetNonlinSolvStats(IDA_idamem, &IDA_iout[6], /* NNI */ &IDA_iout[5]); /* NCFN */ IDAGetNumBacktrackOps(IDA_idamem, &IDA_iout[10]); /* NBCKTRK */ IDAGetTolScaleFactor(IDA_idamem, &IDA_rout[4]); /* TOLSFAC */ /* Root finding is on */ if (IDA_nrtfn != 0) IDAGetNumGEvals(IDA_idamem, &IDA_iout[11]); /* NGE */ switch(IDA_ls) { case IDA_LS_DENSE: case IDA_LS_BAND: case IDA_LS_LAPACKDENSE: case IDA_LS_LAPACKBAND: IDADlsGetWorkSpace(IDA_idamem, &IDA_iout[12], &IDA_iout[13]); /* LENRWLS, LENIWLS */ IDADlsGetLastFlag(IDA_idamem, &IDA_iout[14]); /* LSTF */ IDADlsGetNumResEvals(IDA_idamem, &IDA_iout[15]); /* NRE */ IDADlsGetNumJacEvals(IDA_idamem, &IDA_iout[16]); /* NJE */ break; case IDA_LS_SPGMR: case IDA_LS_SPBCG: case IDA_LS_SPTFQMR: IDASpilsGetWorkSpace(IDA_idamem, &IDA_iout[12], &IDA_iout[13]); /* LENRWLS, LENIWLS */ IDASpilsGetLastFlag(IDA_idamem, &IDA_iout[14]); /* LSTF */ IDASpilsGetNumResEvals(IDA_idamem, &IDA_iout[15]); /* NRE */ IDASpilsGetNumJtimesEvals(IDA_idamem, &IDA_iout[16]); /* NJE */ IDASpilsGetNumPrecEvals(IDA_idamem, &IDA_iout[17]); /* NPE */ IDASpilsGetNumPrecSolves(IDA_idamem, &IDA_iout[18]); /* NPS */ IDASpilsGetNumLinIters(IDA_idamem, &IDA_iout[19]); /* NLI */ IDASpilsGetNumConvFails(IDA_idamem, &IDA_iout[20]); /* NCFL */ break; } return; } /*************************************************/ void FIDA_GETDKY(realtype *t, int *k, realtype *dky, int *ier) { /* Attach user data to vectors */ N_VSetArrayPointer(dky, F2C_IDA_vec); *ier = 0; *ier = IDAGetDky(IDA_idamem, *t, *k, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; } /*************************************************/ void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(eweight, F2C_IDA_vec); *ier = 0; *ier = IDAGetErrWeights(IDA_idamem, F2C_IDA_vec); /* Reset data pointer */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; } /*************************************************/ void FIDA_GETESTLOCALERR(realtype *ele, int *ier) { /* Attach user data to vector */ N_VSetArrayPointer(ele, F2C_IDA_vec); *ier = 0; *ier = IDAGetEstLocalErrors(IDA_idamem, F2C_IDA_vec); /* Reset data pointers */ N_VSetArrayPointer(NULL, F2C_IDA_vec); return; } /*************************************************/ void FIDA_FREE(void) { IDAMem ida_mem; ida_mem = (IDAMem) IDA_idamem; free(ida_mem->ida_user_data); ida_mem->ida_user_data = NULL; IDAFree(&IDA_idamem); /* Free F2C_IDA_vec */ N_VSetArrayPointer(NULL, F2C_IDA_vec); N_VDestroy(F2C_IDA_vec); /* Free F2C_IDA_ypvec */ N_VSetArrayPointer(NULL, F2C_IDA_ypvec); N_VDestroy(F2C_IDA_ypvec); /* Free F2C_IDA_ewtvec */ if (F2C_IDA_ewtvec != NULL) N_VDestroy(F2C_IDA_ewtvec); return; } /*************************************************/ int FIDAresfn(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { int ier; realtype *yy_data, *yp_data, *rr_data; FIDAUserData IDA_userdata; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_RESFUN(&t, yy_data, yp_data, rr_data, IDA_userdata->ipar, IDA_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidabbd.c0000600000175000017500000001077611741421215020374 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This module contains the routines necessary to interface with the * IDABBDPRE module and user-supplied Fortran routines. * The routines here call the generically named routines and provide * a standard interface to the C code of the IDABBDPRE package. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* function names, prototypes, global variables */ #include "fidabbd.h" /* prototypes of interfaces to IDABBD */ #include /* prototypes of IDABBDPRE functions and macros */ #include /* prototypes of IDASPGMR interface routines */ #include /* prototypes of IDASPBCG interface routines */ #include /* prototypes of IDASPTFQMR interface routines */ /*************************************************/ /* private constant(s) */ #define ZERO RCONST(0.0) /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_GLOCFN(long int*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, int*); extern void FIDA_COMMFN(long int*, realtype*, realtype*, realtype*, long int*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_BBDINIT(long int *Nloc, long int *mudq, long int *mldq, long int *mu, long int *ml, realtype *dqrely, int *ier) { *ier = IDABBDPrecInit(IDA_idamem, *Nloc, *mudq, *mldq, *mu, *ml, *dqrely, (IDABBDLocalFn) FIDAgloc, (IDABBDCommFn) FIDAcfn); return; } /*************************************************/ void FIDA_BBDREINIT(long int *Nloc, long int *mudq, long int *mldq, realtype *dqrely, int *ier) { *ier = 0; *ier = IDABBDPrecReInit(IDA_idamem, *mudq, *mldq, *dqrely); return; } /*************************************************/ int FIDAgloc(long int Nloc, realtype t, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data) { realtype *yy_data, *yp_data, *gval_data; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = gval_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); gval_data = N_VGetArrayPointer(gval); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_GLOCFN(&Nloc, &t, yy_data, yp_data, gval_data, IDA_userdata->ipar, IDA_userdata->rpar, &ier); return(ier); } /*************************************************/ int FIDAcfn(long int Nloc, realtype t, N_Vector yy, N_Vector yp, void *user_data) { realtype *yy_data, *yp_data; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_COMMFN(&Nloc, &t, yy_data, yp_data, IDA_userdata->ipar, IDA_userdata->rpar, &ier); return(ier); } /*************************************************/ void FIDA_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd) { IDABBDPrecGetWorkSpace(IDA_idamem, lenrwbbd, leniwbbd); IDABBDPrecGetNumGfnEvals(IDA_idamem, ngebbd); return; } sundials-2.5.0/src/ida/fcmix/fidaroot.h0000600000175000017500000001200411741421215020617 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Alan C. Hindmarsh @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the rootfinding * feature of IDA. * ----------------------------------------------------------------- */ /* * ============================================================================== * * FIDAROOT Interface Package * * The FIDAROOT interface package allows programs written in FORTRAN to * use the rootfinding feature of the IDA solver module. * * The user-callable functions constituting the FIDAROOT package are the * following: FIDAROOTINIT, FIDAROOTINFO, and FIDAROOTFREE. The corresponding * IDA subroutine called by each interface function is given below. * * ------------------ --------------------- * | FIDAROOT routine | | IDA function called | * ------------------ --------------------- * FIDAROOTINIT -> IDARootInit * FIDAROOTINFO -> IDAGetRootInfo * FIDAROOTFREE -> IDARootInit * * FIDAROOTFN is a user-supplied subroutine defining the functions whose * roots are sought. * * ============================================================================== * * Usage of the FIDAROOT Interface Package * * 1. In order to use the rootfinding feature of the IDA package the user must * define the following subroutine: * * SUBROUTINE FIDAROOTFN (T, Y, YP, G, IPAR, RPAR, IER) * DIMENSION Y(*), YP(*), G(*) * * The arguments are: * T = independent variable value t [input] * Y = dependent variable vector y [input] * YP = dependent variable derivative vector y' [input] * G = function values g(t,y,y') [output] * IPAR, RPAR = user (integer and real) data [input/output] * IER = return flag (set on 0 if successful, non-zero if an error occurred) * * 2. After calling FIDAMALLOC but prior to calling FIDASOLVE, the user must * allocate and initialize memory for the FIDAROOT module by making the * following call: * * CALL FIDAROOTINIT (NRTFN, IER) * * The arguments are: * NRTFN = total number of root functions [input] * IER = return completion flag (0 = success, -1 = IDA memory NULL and * -14 = memory allocation error) [output] * * 3. After calling FIDA, to see whether a root was found, test the FIDA * return flag IER. The value IER = 2 means one or more roots were found. * * 4. If a root was found, and if NRTFN > 1, then to determine which root * functions G(*) were found to have a root, make the following call: * CALL FIDAROOTINFO (NRTFN, INFO, IER) * The arguments are: * NRTFN = total number of root functions [input] * INFO = integer array of length NRTFN, with values 0 or 1 [output] * For i = 1,...,NRTFN, G(i) was found to have a root if INFO(i) = 1. * IER = completion flag (0 = success, negative = failure) * * 5. The total number of calls made to the root function (FIDAROOTFN), * NGE, can be obtained from IOUT(12). * * If the FIDA/IDA memory block is reinitialized to solve a different * problem via a call to FIDAREINIT, then the counter variable NGE is cleared * (reset to zero). * * 6. To free the memory resources allocated by a prior call to FIDAROOTINIT, * make the following call: * CALL FIDAROOTFREE * See the IDA documentation for additional information. * * ============================================================================== */ #ifndef _FIDAROOT_H #define _FIDAROOT_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* header files */ #include /* definition of type N_Vector */ #include /* definition of SUNDIALS type realtype */ /* Definitions of interface function names */ #if defined(SUNDIALS_F77_FUNC) #define FIDA_ROOTINIT SUNDIALS_F77_FUNC(fidarootinit, FIDAROOTINIT) #define FIDA_ROOTINFO SUNDIALS_F77_FUNC(fidarootinfo, FIDAROOTINFO) #define FIDA_ROOTFREE SUNDIALS_F77_FUNC(fidarootfree, FIDAROOTFREE) #define FIDA_ROOTFN SUNDIALS_F77_FUNC(fidarootfn, FIDAROOTFN) #else #define FIDA_ROOTINIT fidarootinit_ #define FIDA_ROOTINFO fidarootinfo_ #define FIDA_ROOTFREE fidarootfree_ #define FIDA_ROOTFN fidarootfn_ #endif /* Prototypes of exported function */ void FIDA_ROOTINIT(int *nrtfn, int *ier); void FIDA_ROOTINFO(int *nrtfn, int *info, int *ier); void FIDA_ROOTFREE(void); /* Prototype of function called by IDA module */ int FIDArootfunc(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/fcmix/fidalapack.c0000600000175000017500000000257211741421215021073 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/11/22 00:12:50 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA/IDALAPACK. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual function names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ void FIDA_LAPACKDENSE(int *neq, int *ier) { *ier = 0; *ier = IDALapackDense(IDA_idamem, *neq); IDA_ls = IDA_LS_LAPACKDENSE; return; } /*************************************************/ void FIDA_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier) { *ier = 0; *ier = IDALapackBand(IDA_idamem, *neq, *mupper, *mlower); IDA_ls = IDA_LS_LAPACKBAND; return; } /*************************************************/ sundials-2.5.0/src/ida/fcmix/fida.h0000600000175000017500000010510311741421215017716 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for FIDA, the Fortran interface to * the IDA package. * ----------------------------------------------------------------- */ /* * ============================================================================= * * FIDA Interface Package * * The FIDA Interface Package is a package of C functions which support * the use of the IDA solver, for the solution of DAE systems, in a * mixed Fortran/C setting. While IDA is written in C, it is assumed * here that the user's calling program and user-supplied problem-defining * routines are written in Fortran. This package provides the necessary * interface to IDA for both the serial and the parallel NVECTOR * implementations. * * The user-callable functions, with the corresponding IDA functions, * are as follows: * * FNVINITS* and FNVINITP* interface to N_VNew_Serial and * N_VNew_Parallel, respectively * * FIDAMALLOC interfaces to IDACreate and IDAInit * * FIDAREINIT interfaces to IDAReInit * * FIDASETIIN, FIDASETRIN, FIDASETVIN interface to IDASet* * * FIDATOLREINIT interfaces to IDASetTolerances * * FIDACALCIC interfaces to IDACalcIC * * FIDAEWTSET interfaces to IDAWFtolerances * * FIDADENSE interfaces to IDADense * FIDADENSESETJAC interfaces to IDADenseSetJacFn * * FIDABAND interfaces to IDABand * FIDABANDSETJAC interfaces to IDABandSetJacFn * * FIDASPTFQMR/FIDASPTFQMRREINIT interface to IDASptfqmr and IDASptfqmrSet* * FIDASPBCG/FIDASPBCGREINIT interface to IDASpbcg and IDASpbcgSet* * FIDASPGMR/FIDASPGMRREINIT interface to IDASpgmr and IDASpgmrSet* * FIDASPILSSETJAC interfaces to IDASpilsSetJacFn * FIDASPILSSETPREC interfaces to IDASpilsSetPreconditioner * * FIDASOLVE interfaces to IDASolve, IDAGet*, and IDA*Get* * * FIDAGETDKY interfaces to IDAGetDky * * FIDAGETERRWEIGHTS interfaces to IDAGetErrWeights * * FIDAGETESTLOCALERR interfaces to IDAGetEstLocalErrors * * FIDAFREE interfaces to IDAFree * * The user-supplied functions, each listed with the corresponding interface * function which calls it (and its type within IDA), are as follows: * FIDARESFUN is called by the interface function FIDAresfn of type IDAResFn * FIDADJAC is called by the interface fn. FIDADenseJac of type IDADenseJacFn * FIDABJAC is called by the interface fn. FIDABandJac of type IDABandJacFn * FIDAPSOL is called by the interface fn. FIDAPSol of type IDASpilsPrecSolveFn * FIDAPSET is called by the interface fn. FIDAPSet of type IDASpilsPrecSetupFn * FIDAJTIMES is called by interface fn. FIDAJtimes of type IDASpilsJacTimesVecFn * FIDAEWT is called by interface fn. FIDAEwtSet of type IDAEwtFn * In contrast to the case of direct use of IDA, the names of all user-supplied * routines here are fixed, in order to maximize portability for the resulting * mixed-language program. * * Important note on portability: * In this package, the names of the interface functions, and the names of * the Fortran user routines called by them, appear as dummy names * which are mapped to actual values by a series of definitions in the * header file fida.h. * * ============================================================================= * * Usage of the FIDA Interface Package * * The usage of FIDA requires calls to a few different interface * functions, depending on the method options selected, and one or more * user-supplied routines which define the problem to be solved. These * function calls and user routines are summarized separately below. * * Some details are omitted, and the user is referred to the user documents * on IDA for more complete documentation. Information on the * arguments of any given user-callable interface routine, or of a given * user-supplied function called by an interface function, can be found in * the documentation on the corresponding function in the IDA package. * * The number labels on the instructions below end with s for instructions * that apply to the serial version of IDA only, and end with p for * those that apply to the parallel version only. * * ----------------------------------------------------------------------------- * * (1) User-supplied residual routine: FIDARESFUN * The user must in all cases supply the following Fortran routine * SUBROUTINE FIDARESFUN(T, Y, YP, R, IPAR, RPAR, IER) * DIMENSION Y(*), YP(*), R(*), IPAR(*), RPAR(*) * It must set the R array to F(t,y,y'), the residual of the DAE * system, as a function of T = t, the array Y = y, and the array YP = y'. * Here Y, YP and R are distributed vectors. * IPAR and RPAR are arrays of integer and real user data, respectively, * as passed to FIDAMALLOC. * * (2s) Optional user-supplied dense Jacobian approximation routine: FIDADJAC * As an option when using the DENSE linear solver, the user may supply a * routine that computes a dense approximation of the system Jacobian * J = df/dy. If supplied, it must have the following form: * SUBROUTINE FIDADJAC(NEQ, T, Y, YP, R, DJAC, CJ, EWT, H, * 1 IPAR, RPAR, WK1, WK2, WK3, IER) * DIMENSION Y(*), YP(*), R(*), EWT(*), DJAC(NEQ,*), * 1 IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) * This routine must compute the Jacobian and store it columnwise in DJAC. * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. * * (3s) Optional user-supplied band Jacobian approximation routine: FIDABJAC * As an option when using the BAND linear solver, the user may supply a * routine that computes a band approximation of the system Jacobian * J = df/dy. If supplied, it must have the following form: * SUBROUTINE FIDABJAC(NEQ, MU, ML, MDIM, T, Y, YP, R, CJ, * 1 BJAC, EWT, H, IPAR, RPAR, WK1, WK2, WK3, IER) * DIMENSION Y(*), YP(*), R(*), EWT(*), BJAC(MDIM,*), * 1 IPAR(*), RPAR(*), WK1(*), WK2(*), WK3(*) * This routine must load the MDIM by N array BJAC with the Jacobian matrix at the * current (t,y,y') in band form. Store in BJAC(k,j) the Jacobian element J(i,j) * with k = i - j + MU + 1 (k = 1 ... ML+MU+1) and j = 1 ... N. * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. * * (4) Optional user-supplied Jacobian-vector product routine: FIDAJTIMES * As an option when using the SPGMR/SPBCG/SPTFQMR linear solver, the user may * supply a routine that computes the product of the system Jacobian J = df/dy * and a given vector v. If supplied, it must have the following form: * SUBROUTINE FIDAJTIMES(T, Y, YP, R, V, FJV, CJ, EWT, H, * 1 IPAR, RPAR, WK1, WK2, IER) * DIMENSION V(*), FJV(*), Y(*), YP(*), R(*), EWT(*), * 1 IPAR(*), RPAR(*), WK1(*), WK2(*) * This routine must compute the product vector Jv, where the vector v is stored * in V, and store the product in FJV. On return, set IER = 0 if FIDAJTIMES was * successful, and nonzero otherwise. * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. * * (5) Optional user-supplied error weight vector routine: FIDAEWT * As an option to providing the relative and absolute tolerances, the user * may supply a routine that computes the weights used in the WRMS norms. * If supplied, it must have the following form: * SUBROUTINE FIDAEWT(Y, EWT, IPAR, RPAR, IER) * DIMENSION Y(*), EWT(*) * It must store the error weights in EWT, given the current solution vector Y. * On return, set IER = 0 if successful, and nonzero otherwise. * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. * * ----------------------------------------------------------------------------- * * (6) Initialization: FNVINITS / FNVINITP , FIDAMALLOC, FIDAREINIT, * FIDATOLREINIT, and FIDACALCIC * * (6.1s) To initialize the serial machine environment, the user must make * the following call: * CALL FNVINITS(KEY, NEQ, IER) * The arguments are: * KEY = 2 for IDA * NEQ = size of vectors * IER = return completion flag. Values are 0 = success, -1 = failure. * * (6.1p) To initialize the parallel machine environment, the user must make * one of the following calls: * CALL FNVINITP(KEY, NLOCAL, NGLOBAL, IER) * -or- * CALL FNVINITP(COMM, KEY, NLOCAL, NGLOBAL, IER) * The arguments are: * COMM = MPI communicator (e.g., MPI_COMM_WORLD) * KEY = 2 for IDA * NLOCAL = local size of vectors on this processor * NGLOBAL = the system size, and the global size of vectors (the sum * of all values of NLOCAL) * IER = return completion flag. Values are 0 = success, -1 = failure. * NOTE: The COMM argument passed to the FNVINITP routine is only supported if * the MPI implementation used to build SUNDIALS includes the MPI_Comm_f2c * function from the MPI-2 specification. To check if the function is supported * look for the line "#define SUNDIALS_MPI_COMM_F2C 1" in the sundials_config.h * header file. * * (6.2) To set various problem and solution parameters and allocate * internal memory, make the following call: * CALL FIDAMALLOC(T0, Y0, YP0, IATOL, RTOL, ATOL, * 1 IOUT, ROUT, IPAR, RPAR, IER) * The arguments are: * T0 = initial value of t * Y0 = array of initial conditions, y(t0) * YP0 = value of y'(t0) * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array. * If IATOL = 3, then the user must supply a routine FIDAEWT to compute * the error weight vector. * RTOL = relative tolerance (scalar) * ATOL = absolute tolerance (scalar or array) * IOUT = array of length at least 21 for integer optional outputs * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * ROUT = array of length at least 6 for real optional outputs * IPAR = array with user integer data * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * RPAR = array with user real data * IER = return completion flag. Values are 0 = SUCCESS, and -1 = failure. * See printed message for details in case of failure. * * The user data arrays IPAR and RPAR are passed unmodified to all subsequent * calls to user-provided routines. Modifications to either array inside a * user-provided routine will be propagated. Using these two arrays, the user * can dispense with Common blocks to pass data betwen user-provided routines. * * The optional outputs are: * LENRW = IOUT( 1) -> IDAGetWorkSpace * LENIW = IOUT( 2) -> IDAGetWorkSpace * NST = IOUT( 3) -> IDAGetNumSteps * NRE = IOUT( 4) -> IDAGetNumResEvals * NETF = IOUT( 5) -> IDAGetNumErrTestFails * NCFN = IOUT( 6) -> IDAGetNumNonlinSolvConvFails * NNI = IOUT( 7) -> IDAGetNumNonlinSolvIters * NSETUPS = IOUT( 8) -> IDAGetNumLinSolvSetups * KLAST = IOUT( 9) -> IDAGetLastOrder * KCUR = IOUT(10) -> IDAGetCurrentOrder * NBCKTRK = IOUT(11) -> IDAGetNumBacktrackOps * NGE = IOUT(12) -> IDAGetNumGEvals * * HINUSED = ROUT( 1) -> IDAGetActualInitStep * HLAST = ROUT( 2) -> IDAGetLastStep * HCUR = ROUT( 3) -> IDAGetCurrentStep * TCUR = ROUT( 4) -> IDAGetCurrentTime * TOLSFAC = ROUT( 5) -> IDAGetTolScaleFactor * UNITRND = ROUT( 6) -> UNIT_ROUNDOFF * * * If the user program includes the FIDAEWT routine for the evaluation of the * error weights, the following call must be made * CALL FIDAEWTSET(FLAG, IER) * with FLAG = 1 to specify that FIDAEWT is provided. * The return flag IER is 0 if successful, and nonzero otherwise. * * (6.3) To set various integer optional inputs, make the folowing call: * CALL FIDASETIIN(KEY, VALUE, IER) * to set the optional input specified by the character key KEY to the * integer value VAL. * KEY is one of the following: MAX_ORD, MAX_NSTEPS, MAX_ERRFAIL, MAX_NITERS, * MAX_CONVFAIL, SUPPRESS_ALG, MAX_NSTEPS_IC, MAX_NITERS_IC, MAX_NJE_IC, LS_OFF_IC. * * To set various real optional inputs, make the folowing call: * CALL FIDASETRIN(KEY, VALUE, IER) * to set the optional input specified by the character key KEY to the * real value VAL. * KEY is one of the following: INIT_STEP, MAX_STEP, MIIN_STEP, STOP_TIME, * NLCONV_COEF. * * To set the vector of variable IDs or the vector of constraints, make * the following call: * CALL FIDASETVIN(KEY, ARRAY, IER) * where ARRAY is an array of reals and KEY is 'ID_VEC' or 'CONSTR_VEC'. * * FIDASETIIN, FIDASETRIN, and FIDASETVIN return IER=0 if successful and * IER<0 if an error occured. * * (6.4) To re-initialize the FIDA solver for the solution of a new problem * of the same size as one already solved, make the following call: * CALL FIDAREINIT(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, IER) * The arguments have the same names and meanings as those of FIDAMALLOC. * FIDAREINIT performs the same initializations as FIDAMALLOC, but does no memory * allocation for IDA data structures, using instead the existing internal memory * created by the previous FIDAMALLOC call. The call to specify the linear system * solution method may or may not be needed. See below. * * (6.5) To modify the tolerance parameters, make the following call: * CALL FIDATOLREINIT(IATOL, RTOL, ATOL, IER) * The arguments have the same names and meanings as those of FIDAMALLOC. * FIDATOLREINIT simple calls IDASetTolerances with the given arguments. * * (6.6) To compute consistent initial conditions for an index-one DAE system, * make the following call: * CALL FIDACALCIC(ICOPT, TOUT, IER) * The arguments are: * ICOPT = specifies the option: 1 = IDA_YP_YDP_INIT, 2 = IDA_Y_INIT. * (See user guide for additional details.) * TOUT = the first value of t at which a solution will be requested * (from FIDASOLVE). * IER = return completion flag. * * ----------------------------------------------------------------------------- * * (7) Specification of linear system solution method. * FIDA presently includes four choices for the treatment of these systems, * and the user of FIDA must call a routine with a specific name to make the * desired choice. * * (7.1s) DENSE treatment of the linear system. * The user must make the call * CALL FIDADENSE(NEQ, IER) * The arguments are: * NEQ = size of vectors * IER = error return flag: 0 = success , negative value = an error occured * * If the user program includes the FIDADJAC routine for the evaluation of the * dense approximation to the Jacobian, the following call must be made * CALL FIDADENSESETJAC(FLAG, IER) * with FLAG = 1 to specify that FIDADJAC is provided. (FLAG = 0 specifies * using the internal finite differences approximation to the Jacobian.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Optional outputs specific to the DENSE case are: * LENRWLS = IOUT(13) -> IDADenseGetWorkSpace * LENIWLS = IOUT(14) -> IDADenseGetWorkSpace * LSTF = IOUT(15) -> IDADenseGetLastFlag * NRELS = IOUT(16) -> IDADenseGetNumResEvals * NJE = IOUT(17) -> IDADenseGetNumJacEvals * * (7.2s) BAND treatment of the linear system * The user must make the call * CALL FIDABAND(NEQ, MU, ML, IER) * The arguments are: * NEQ = size of vectors * MU = upper bandwidth * ML = lower bandwidth * IER = error return flag: 0 = success , negative value = an error occured * * If the user program includes the FIDABJAC routine for the evaluation of the * band approximation to the Jacobian, the following call must be made * CALL FIDABANDSETJAC (FLAG, IER) * with FLAG = 1 to specify that FIDABJAC is provided. (FLAG = 0 specifies * using the internal finite differences approximation to the Jacobian.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Optional outputs specific to the BAND case are: * LENRWLS = IOUT(13) -> IDABandGetWorkSpace * LENIWLS = IOUT(14) -> IDABandGetWorkSpace * LSTF = IOUT(15) -> IDABandGetLastFlag * NRELS = IOUT(16) -> IDABandGetNumResEvals * NJE = IOUT(17) -> IDABandGetNumJacEvals * * (7.3) SPGMR treatment of the linear systems. * For the Scaled Preconditioned GMRES solution of the linear systems, * the user must make the following call: * CALL FIDASPGMR(MAXL, IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) * The arguments are: * MAXL = maximum Krylov subspace dimension; 0 indicates default. * IGSTYPE = specifies the type of Gram-Schmidt orthogonalization to be used: * 1 = MODIFIED_GS, 2 = CLASSICAL_GS * EPLIFAC = factor in the linear iteration convergence test constant * DQINCFAC = factor in the increments to y used in the difference quotient * approximations to the matrix-vector products Jv * IER = error return flag: 0 = success; negative value = an error occured * * Optional outputs specific to the SPGMR case are: * LENRWLS = IOUT(13) -> IDASpgmrGetWorkSpace * LENIWLS = IOUT(14) -> IDASpgmrGetWorkSpace * LSTF = IOUT(15) -> IDASpgmrGetLastFlag * NRELS = IOUT(16) -> IDASpgmrGetResEvals * NJE = IOUT(17) -> IDASpgmrGetJtimesEvals * NPE = IOUT(18) -> IDASpgmrGetPrecEvals * NPS = IOUT(19) -> IDASpgmrGetPrecSolves * NLI = IOUT(20) -> IDASpgmrGetLinIters * NLCF = IOUT(21) -> IDASpgmrGetConvFails * * If a sequence of problems of the same size is being solved using the * SPGMR linear solver, then following the call to FIDAREINIT, a call to the * FIDASPGMRREINIT routine is needed if any of IGSTYPE, MAXRS, EPLIFAC, or * DQINCFAC is being changed. In that case, call FIDASPGMRREINIT as follows: * CALL FIDASPGMRREINIT (IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) * The arguments have the same meanings as for FIDASPGMR. If MAXL is being * changed, then call FIDASPGMR instead. * * (7.4) SPBCG treatment of the linear systems. * For the Scaled Preconditioned Bi-CGSTAB solution of the linear systems, * the user must make the following call: * CALL FIDASPBCG(MAXL, EPLIFAC, DQINCFAC, IER) * The arguments are: * MAXL = maximum Krylov subspace dimension; 0 indicates default. * EPLIFAC = factor in the linear iteration convergence test constant * DQINCFAC = factor in the increments to y used in the difference quotient * approximations to matrix-vector products Jv * IER = error return flag: 0 = success; negative value = an error occured * * Optional outputs specific to the SPBCG case are: * LENRWLS = IOUT(13) -> IDASpbcgGetWorkSpace * LENIWLS = IOUT(14) -> IDASpbcgGetWorkSpace * LSTF = IOUT(15) -> IDASpbcgGetLastFlag * NRELS = IOUT(16) -> IDASpbcgGetResEvals * NJE = IOUT(17) -> IDASpbcgGetJtimesEvals * NPE = IOUT(18) -> IDASpbcgGetPrecEvals * NPS = IOUT(19) -> IDASpbcgGetPrecSolves * NLI = IOUT(20) -> IDASpbcgGetLinIters * NLCF = IOUT(21) -> IDASpbcgGetConvFails * * If a sequence of problems of the same size is being solved using the * SPBCG linear solver, then following the call to FIDAREINIT, a call to the * FIDASPBCGREINIT routine is needed if MAXL, EPLIFAC, or DQINCFAC is * being changed. In that case, call FIDASPBCGREINIT as follows: * CALL FIDASPBCGREINIT(MAXL, EPLIFAC, DQINCFAC, IER) * The arguments have the same meanings as for FIDASPBCG. * * (7.5) SPTFQMR treatment of the linear systems. * For the Scaled Preconditioned TFQMR solution of the linear systems, * the user must make the following call: * CALL FIDASPTFQMR(MAXL, EPLIFAC, DQINCFAC, IER) * The arguments are: * MAXL = maximum Krylov subspace dimension; 0 indicates default. * EPLIFAC = factor in the linear iteration convergence test constant * DQINCFAC = factor in the increments to y used in the difference quotient * approximations to matrix-vector products Jv * IER = error return flag: 0 = success; negative value = an error occured * * Optional outputs specific to the SPTFQMR case are: * LENRWLS = IOUT(13) -> IDASptfqmrGetWorkSpace * LENIWLS = IOUT(14) -> IDASptfqmrGetWorkSpace * LSTF = IOUT(15) -> IDASptfqmrGetLastFlag * NRELS = IOUT(16) -> IDASptfqmrGetResEvals * NJE = IOUT(17) -> IDASptfqmrGetJtimesEvals * NPE = IOUT(18) -> IDASptfqmrGetPrecEvals * NPS = IOUT(19) -> IDASptfqmrGetPrecSolves * NLI = IOUT(20) -> IDASptfqmrGetLinIters * NLCF = IOUT(21) -> IDASptfqmrGetConvFails * * If a sequence of problems of the same size is being solved using the * SPTFQMR linear solver, then following the call to FIDAREINIT, a call to the * FIDASPTFQMRREINIT routine is needed if MAXL, EPLIFAC, or DQINCFAC is * being changed. In that case, call FIDASPTFQMRREINIT as follows: * CALL FIDASPTFQMRREINIT (MAXL, EPLIFAC, DQINCFAC, IER) * The arguments have the same meanings as for FIDASPTFQMR. * * (7.6) Using user-provided functions for the iterative linear solvers * * If the user program includes the FIDAJTIMES routine for the evaluation of the * Jacobian vector product, the following call must be made * CALL FIDASPILSSETJAC (FLAG, IER) * with FLAG = 1 to specify that FIDAJTIMES is provided. (FLAG = 0 specifies * using and internal finite difference approximation to this product.) * The return flag IER is 0 if successful, and nonzero otherwise. * * Usage of the user-supplied routines FIDAPSOL and FIDAPSET for solution of the * preconditioner linear system requires the following call: * CALL FIDASPILSSETPREC(FLAG, IER) * with FLAG = 1. The return flag IER is 0 if successful, nonzero otherwise. * The user-supplied routine FIDAPSOL must have the form: * SUBROUTINE FIDAPSOL(T, Y, YP, R, RV, ZV, CJ, DELTA, EWT, * 1 IPAR, RPAR, WRK, IER) * DIMENSION Y(*), YP(*), R(*), RV(*), ZV(*), * 1 IPAR(*), RPAR(*), EWT(*), WRK(*) * This routine must solve the preconditioner linear system Pz = r, where r = RV * is input, and store the solution z in ZV. * * The user-supplied routine FIDAPSET must be of the form: * SUBROUTINE FIDAPSET(T, Y, YP, R, CJ, EWT, H, IPAR, RPAR, * 1 WK1, WK2, WK3, IER) * DIMENSION Y(*), YP(*), R(*), EWT(*), IPAR(*), RPAR(*), * 1 WK1(*), WK2(*), WK3(*) * This routine must perform any evaluation of Jacobian-related data and * preprocessing needed for the solution of the preconditioner linear systems * by FIDAPSOL. On return, set IER = 0 if FIDAPSET was successful, set IER * positive if a recoverable error occurred, and set IER negative if a * non-recoverable error occurred. * IPAR and RPAR are user (integer and real) arrays passed to FIDAMALLOC. * * ----------------------------------------------------------------------------- * * (8) The solver: FIDASOLVE * To solve the DAE system, make the following call: * CALL FIDASOLVE(TOUT, TRET, Y, YP, ITASK, IER) * The arguments are: * TOUT = next value of t at which a solution is desired (input) * TRET = value of t reached by the solver on output * Y = array containing the computed solution on output * YP = array containing current value of y' * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate) * 2 = one-step mode (return after each internal step taken) * 3 = normal tstop mode (like 1, but integration never proceeds past * TSTOP, which must be specified through a call to FIDASETRIN * using the key 'STOP_TIME' * 4 = one step tstop (like 2, but integration never goes past TSTOP) * IER = completion flag: 0 = success, 1 = tstop return, 2 = root return, * values -1 ... -10 are various failure modes (see IDA manual). * The current values of the optional outputs are available in IOUT and ROUT. * * ----------------------------------------------------------------------------- * * (9) Getting current solution derivative: FIDAGETDKY * To obtain interpolated values of y and y' for any value of t in the last * internal step taken by IDA, make the following call: * CALL FIDAGETDKY(T, K, DKY, IER) * The arguments are: * T = value of t at which solution is desired, in [TCUR - HU,TCUR]. * K = order of derivative requested. * DKY = array containing computed K-th derivative of the solution y. * IER = return flag: = 0 for success, < 0 for illegal argument. * * ----------------------------------------------------------------------------- * * (10) Memory freeing: FIDAFREE * To the free the internal memory created by the calls to FIDAMALLOC and * FNVINITS or FNVINITP, depending on the version (serial/parallel), make * the following call: * CALL FIDAFREE * * ============================================================================= */ #ifndef _FIDA_H #define _FIDA_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* definition of type IDAResFn */ #include /* definition of type DlsMat */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ #if defined(SUNDIALS_F77_FUNC) #define FIDA_MALLOC SUNDIALS_F77_FUNC(fidamalloc, FIDAMALLOC) #define FIDA_REINIT SUNDIALS_F77_FUNC(fidareinit, FIDAREINIT) #define FIDA_SETIIN SUNDIALS_F77_FUNC(fidasetiin, FIDASETIIN) #define FIDA_SETRIN SUNDIALS_F77_FUNC(fidasetrin, FIDASETRIN) #define FIDA_SETVIN SUNDIALS_F77_FUNC(fidasetvin, FIDASETVIN) #define FIDA_TOLREINIT SUNDIALS_F77_FUNC(fidatolreinit, FIDATOLREINIT) #define FIDA_SOLVE SUNDIALS_F77_FUNC(fidasolve, FIDASOLVE) #define FIDA_FREE SUNDIALS_F77_FUNC(fidafree, FIDAFREE) #define FIDA_CALCIC SUNDIALS_F77_FUNC(fidacalcic, FIDACALCIC) #define FIDA_BAND SUNDIALS_F77_FUNC(fidaband, FIDABAND) #define FIDA_BANDSETJAC SUNDIALS_F77_FUNC(fidabandsetjac, FIDABANDSETJAC) #define FIDA_DENSE SUNDIALS_F77_FUNC(fidadense, FIDADENSE) #define FIDA_DENSESETJAC SUNDIALS_F77_FUNC(fidadensesetjac, FIDADENSESETJAC) #define FIDA_LAPACKBAND SUNDIALS_F77_FUNC(fidalapackband, FIDALAPACKBAND) #define FIDA_LAPACKBANDSETJAC SUNDIALS_F77_FUNC(fidalapackbandsetjac, FIDALAPACKBANDSETJAC) #define FIDA_LAPACKDENSE SUNDIALS_F77_FUNC(fidalapackdense, FIDALAPACKDENSE) #define FIDA_LAPACKDENSESETJAC SUNDIALS_F77_FUNC(fidalapackdensesetjac, FIDALAPACKDENSESETJAC) #define FIDA_SPTFQMR SUNDIALS_F77_FUNC(fidasptfqmr, FIDASPTFQMR) #define FIDA_SPBCG SUNDIALS_F77_FUNC(fidaspbcg, FIDASPBCG) #define FIDA_SPGMR SUNDIALS_F77_FUNC(fidaspgmr, FIDASPGMR) #define FIDA_SPTFQMRREINIT SUNDIALS_F77_FUNC(fidasptfqmrreinit, FIDASPTFQMRREINIT) #define FIDA_SPBCGREINIT SUNDIALS_F77_FUNC(fidaspbcgreinit, FIDASPBCGREINIT) #define FIDA_SPGMRREINIT SUNDIALS_F77_FUNC(fidaspgmrreinit, FIDASPGMRREINIT) #define FIDA_SPILSSETJAC SUNDIALS_F77_FUNC(fidaspilssetjac, FIDASPILSSETJAC) #define FIDA_SPILSSETPREC SUNDIALS_F77_FUNC(fidaspilssetprec, FIDASPILSSETPREC) #define FIDA_RESFUN SUNDIALS_F77_FUNC(fidaresfun, FIDARESFUN) #define FIDA_DJAC SUNDIALS_F77_FUNC(fidadjac, FIDADJAC) #define FIDA_BJAC SUNDIALS_F77_FUNC(fidabjac, FIDABJAC) #define FIDA_PSET SUNDIALS_F77_FUNC(fidapset, FIDAPSET) #define FIDA_PSOL SUNDIALS_F77_FUNC(fidapsol, FIDAPSOL) #define FIDA_JTIMES SUNDIALS_F77_FUNC(fidajtimes, FIDAJTIMES) #define FIDA_EWT SUNDIALS_F77_FUNC(fidaewt, FIDAEWT) #define FIDA_GETDKY SUNDIALS_F77_FUNC(fidagetdky, FIDAGETDKY) #define FIDA_GETERRWEIGHTS SUNDIALS_F77_FUNC(fidageterrweights, FIDAGETERRWEIGHTS) #define FIDA_GETESTLOCALERR SUNDIALS_F77_FUNC(fidagetestlocalerr, FIDAGETESTLOCALERR) #else #define FIDA_MALLOC fidamalloc_ #define FIDA_REINIT fidareinit_ #define FIDA_SETIIN fidasetiin_ #define FIDA_SETRIN fidasetrin_ #define FIDA_SETVIN fidasetvin_ #define FIDA_TOLREINIT fidatolreinit_ #define FIDA_SOLVE fidasolve_ #define FIDA_FREE fidafree_ #define FIDA_CALCIC fidacalcic_ #define FIDA_BAND fidaband_ #define FIDA_BANDSETJAC fidabandsetjac_ #define FIDA_DENSE fidadense_ #define FIDA_DENSESETJAC fidadensesetjac_ #define FIDA_LAPACKBAND fidalapackband_ #define FIDA_LAPACKBANDSETJAC fidalapackbandsetjac_ #define FIDA_LAPACKDENSE fidalapackdense_ #define FIDA_LAPACKDENSESETJAC fidalapackdensesetjac_ #define FIDA_SPTFQMR fidasptfqmr_ #define FIDA_SPBCG fidaspbcg_ #define FIDA_SPGMR fidaspgmr_ #define FIDA_SPTFQMRREINIT fidasptfqmrreinit_ #define FIDA_SPBCGREINIT fidaspbcgreinit_ #define FIDA_SPGMRREINIT fidaspgmrreinit_ #define FIDA_SPILSSETJAC fidaspilssetjac_ #define FIDA_SPILSSETPREC fidaspilssetprec_ #define FIDA_RESFUN fidaresfun_ #define FIDA_DJAC fidadjac_ #define FIDA_BJAC fidabjac_ #define FIDA_PSET fidapset_ #define FIDA_PSOL fidapsol_ #define FIDA_JTIMES fidajtimes_ #define FIDA_EWT fidaewt_ #define FIDA_GETDKY fidagetdky_ #define FIDA_GETERRWEIGHTS fidageterrweights_ #define FIDA_GETESTLOCALERR fidagetestlocalerr_ #endif /* Type for user data */ typedef struct { realtype *rpar; long int *ipar; } *FIDAUserData; /* Prototypes of exported functions */ void FIDA_MALLOC(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, long int *iout, realtype *rout, long int *ipar, realtype *rpar, int *ier); void FIDA_REINIT(realtype *t0, realtype *yy0, realtype *yp0, int *iatol, realtype *rtol, realtype *atol, int *ier); void FIDA_SETIIN(char key_name[], long int *ival, int *ier, int key_len); void FIDA_SETRIN(char key_name[], realtype *rval, int *ier, int key_len); void FIDA_SETVIN(char key_name[], realtype *vval, int *ier, int key_len); void FIDA_TOLREINIT(int *iatol, realtype *rtol, realtype *atol, int *ier); void FIDA_CALCIC(int *icopt, realtype *tout1, int *ier); void FIDA_DENSE(long int *neq, int *ier); void FIDA_DENSESETJAC(int *flag, int *ier); void FIDA_BAND(long int *neq, long int *mupper, long int *mlower, int *ier); void FIDA_BANDSETJAC(int *flag, int *ier); void FIDA_LAPACKDENSE(int *neq, int *ier); void FIDA_LAPACKDENSESETJAC(int *flag, int *ier); void FIDA_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier); void FIDA_LAPACKBANDSETJAC(int *flag, int *ier); void FIDA_SPTFQMR(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPBCG(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPGMR(int *maxl, int *gstype, int *maxrs, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPTFQMRREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPBCGREINIT(int *maxl, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPGMRREINIT(int *gstype, int *maxrs, realtype *eplifac, realtype *dqincfac, int *ier); void FIDA_SPILSSETJAC(int *flag, int *ier); void FIDA_SPILSSETPREC(int *flag, int *ier); void FIDA_SOLVE(realtype *tout, realtype *tret, realtype *yret, realtype *ypret, int *itask, int *ier); void FIDA_FREE(void); void FIDA_EWTSET(int *flag, int *ier); void FIDA_GETDKY(realtype *t, int *k, realtype *dky, int *ier); void FIDA_GETERRWEIGHTS(realtype *eweight, int *ier); void FIDA_GETESTLOCALERR(realtype *ele, int *ier); /* Prototypes: Functions Called by the IDA Solver */ int FIDAresfn(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); int FIDADenseJac(long int N, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FIDABandJac(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FIDALapackDenseJac(long int N, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FIDALapackBandJac(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FIDAJtimes(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FIDAPSet(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector vtemp1); int FIDAEwtSet(N_Vector yy, N_Vector ewt, void *user_data); /* Declarations for global variables shared amongst various routines */ extern N_Vector F2C_IDA_vec; /* defined in FNVECTOR module */ extern N_Vector F2C_IDA_ypvec; /* defined in fida.c */ extern N_Vector F2C_IDA_ewtvec; /* defined in fida.c */ extern void *IDA_idamem; /* defined in fida.c */ extern long int *IDA_iout; /* defined in fida.c */ extern realtype *IDA_rout; /* defined in fida.c */ extern int IDA_ls; /* defined in fida.c */ extern int IDA_nrtfn; /* defined in fida.c */ /* Linear solver IDs */ enum { IDA_LS_DENSE = 1, IDA_LS_BAND = 2, IDA_LS_LAPACKDENSE = 3, IDA_LS_LAPACKBAND = 4, IDA_LS_SPGMR = 5, IDA_LS_SPBCG = 6, IDA_LS_SPTFQMR = 7 }; #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/fcmix/fidaband.c0000600000175000017500000000651611741421215020546 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA/IDABAND, for the case of * a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* function names, prototypes, global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_BJAC(long int*, long int*, long int*, long int*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_BANDSETJAC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDADlsSetBandJacFn(IDA_idamem, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDADlsSetBandJacFn(IDA_idamem, FIDABandJac); } return; } /*************************************************/ int FIDABandJac(long int N, long int mupper, long int mlower, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; realtype h; long int eband; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_BJAC(&N, &mupper, &mlower, &eband, &t, yy_data, yp_data, rr_data, &c_j, jacdata, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidabbd.h0000600000175000017500000004067111741421215020376 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the BBD * preconditioner (IDABBDPRE) * ----------------------------------------------------------------- */ /* * ============================================================================== * * FIDABBD Interface Package * * The FIDABBD Interface Package is a package of C functions which, * together with the FIDA Interface Package, support the use of the * IDA solver (parallel MPI version) with the IDABBDPRE preconditioner module, * for the solution of DAE systems in a mixed Fortran/C setting. The * combination of IDA and IDABBDPRE solves DAE systems with the SPGMR * (scaled preconditioned GMRES), SPBCG (scaled preconditioned Bi-CGSTAB), or * SPTFQMR (scaled preconditioned TFQMR) method for the linear systems that arise, * and with a preconditioner that is block-diagonal with banded blocks. While * IDA and IDABBDPRE are written in C, it is assumed here that the user's * calling program and user-supplied problem-defining routines are written in * Fortran. * * The user-callable functions in this package, with the corresponding * IDA and IDABBDPRE functions, are as follows: * FIDABBDININT interfaces to IDABBDPrecInit * FIDABBDSPGMR interfaces to IDABBDSpgmr and IDASpilsSet* * FIDABBDSPBCG interfaces to IDABBDSpbcg and IDASpilsSet* * FIDABBDSPTFQMR interfaces to IDABBDSptfqmr and IDASpilsSet* * FIDABBDREINIT interfaces to IDABBDPrecReInit * FIDABBDOPT accesses optional outputs * FIDABBDFREE interfaces to IDABBDPrecFree * * In addition to the Fortran residual function FIDARESFUN, the * user-supplied functions used by this package, are listed below, * each with the corresponding interface function which calls it (and its * type within IDABBDPRE or IDA): * FIDAGLOCFN is called by the interface function FIDAgloc of type IDABBDLocalFn * FIDACOMMFN is called by the interface function FIDAcfn of type IDABBDCommFn * FIDAJTIMES (optional) is called by the interface function FIDAJtimes of * type IDASpilsJacTimesVecFn * (The names of all user-supplied routines here are fixed, in order to * maximize portability for the resulting mixed-language program.) * * Important note on portability: * In this package, the names of the interface functions, and the names of * the Fortran user routines called by them, appear as dummy names * which are mapped to actual values by a series of definitions in the * header file fidabbd.h. * * ============================================================================== * * Usage of the FIDA/FIDABBD Interface Packages * * The usage of the combined interface packages FIDA and FIDABBD requires * calls to several interface functions, and a few different user-supplied * routines which define the problem to be solved and indirectly define * the preconditioner. These function calls and user routines are * summarized separately below. * * Some details are omitted, and the user is referred to the IDA user document * for more complete information. * * (1) User-supplied residual routine: FIDARESFUN * The user must in all cases supply the following Fortran routine * SUBROUTINE FIDARESFUN(T, Y, YP, R, IPAR, RPAR, IER) * DIMENSION Y(*), YP(*), R(*), IPAR(*), RPAR(*) * It must set the R array to F(t,y,y'), the residual of the DAE * system, as a function of T = t, the array Y = y, and the array YP = y'. * Here Y, YP and R are distributed vectors. * * (2) User-supplied routines to define preconditoner: FIDAGLOCFN and FIDACOMMFN * * The routines in the IDABBDPRE module provide a preconditioner matrix * for IDA that is block-diagonal with banded blocks. The blocking * corresponds to the distribution of the dependent variable vectors y and y' * among the processes. Each preconditioner block is generated from the * Jacobian of the local part (associated with the current process) of a given * function G(t,y,y') approximating F(t,y,y'). The blocks are generated by a * difference quotient scheme independently by each process, utilizing * an assumed banded structure with given half-bandwidths. A separate * pair of half-bandwidths defines the band matrix retained. * * (2.1) Local approximate function FIDAGLOCFN. * The user must supply a subroutine of the form * SUBROUTINE FIDAGLOCFN(NLOC, T, YLOC, YPLOC, GLOC, IPAR, RPAR, IER) * DIMENSION YLOC(*), YPLOC(*), GLOC(*), IPAR(*), RPAR(*) * to compute the function G(t,y,y') which approximates the residual * function F(t,y,y'). This function is to be computed locally, i.e., without * interprocess communication. (The case where G is mathematically * identical to F is allowed.) It takes as input the local vector length * NLOC, the independent variable value T = t, and the local realtype * dependent variable arrays YLOC and YPLOC. It is to compute the local part * of G(t,y,y') and store this in the realtype array GLOC. * * (2.2) Communication function FIDACOMMF. * The user must also supply a subroutine of the form * SUBROUTINE FIDACOMMFN(NLOC, T, YLOC, YPLOC, IPAR, RPAR, IER) * DIMENSION YLOC(*), YPLOC(*), IPAR(*), RPAR(*) * which is to perform all interprocess communication necessary to * evaluate the approximate residual function G described above. * This function takes as input the local vector length NLOC, the * independent variable value T = t, and the local real dependent * variable arrays YLOC and YPLOC. It is expected to save communicated * data in work space defined by the user, and made available to FIDAGLOCFN. * Each call to the FIDACOMMFN is preceded by a call to FIDARESFUN with * the same (t,y,y') arguments. Thus FIDACOMMFN can omit any * communications done by FIDARESFUN if relevant to the evaluation of G. * * (3) Optional user-supplied Jacobian-vector product routine: FIDAJTIMES * As an option when using the SPGMR/SPBCG/SPTFQMR linear solver, the user may * supply a routine that computes the product of the system Jacobian J = df/dy * and a given vector v. If supplied, it must have the following form: * SUBROUTINE FIDAJTIMES(T, Y, YP, R, V, FJV, CJ, EWT, H, * 1 IPAR, RPAR, WK1, WK2, IER) * DIMENSION V(*), FJV(*), Y(*), YP(*), R(*), EWT(*), * 1 , IPAR(*), RPAR(*), WK1(*), WK2(*) * This routine must compute the product vector Jv, where the vector v is stored * in V, and store the product in FJV. On return, set IER = 0 if FIDAJTIMES was * successful, and nonzero otherwise. * * (4) Initialization: FNVINITP, FIDAMALLOC, FIDABBDINIT. * * (4.1) To initialize the parallel machine environment, the user must make * one of the following calls: * CALL FNVINITP (KEY, NLOCAL, NGLOBAL, IER) * -or- * CALL FNVINITP (COMM, KEY, NLOCAL, NGLOBAL, IER) * The arguments are: * COMM = MPI communicator (e.g., MPI_COMM_WORLD) * KEY = 3 for IDA * NLOCAL = local size of vectors on this processor * NGLOBAL = the system size, and the global size of vectors (the sum * of all values of NLOCAL) * IER = return completion flag. Values are 0 = success, -1 = failure. * NOTE: The COMM argument passed to the FNVINITP routine is only supported if * the MPI implementation used to build SUNDIALS includes the MPI_Comm_f2c * function from the MPI-2 specification. To check if the function is supported * look for the line "#define SUNDIALS_MPI_COMM_F2C 1" in the sundials_config.h * header file. * * (4.2) To set various problem and solution parameters and allocate * internal memory, make the following call: * CALL FIDAMALLOC(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, * 1 IOUT, ROUT, IPAR, RPAR, IER) * The arguments are: * T0 = initial value of t * Y0 = array of initial conditions, y(t0) * YP0 = value of y'(t0) * IATOL = type for absolute tolerance ATOL: 1 = scalar, 2 = array. * If IATOL = 3, then the user must supply a routine FIDAEWT to compute * the error weight vector. * RTOL = relative tolerance (scalar) * ATOL = absolute tolerance (scalar or array) * IOUT = array of length at least 21 for integer optional inputs and outputs * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * ROUT = array of length 6 for real optional inputs and outputs * * The optional outputs are: * * LENRW = IOUT( 1) -> IDAGetWorkSpace * LENIW = IOUT( 2) -> IDAGetWorkSpace * NST = IOUT( 3) -> IDAGetNumSteps * NRE = IOUT( 4) -> IDAGetNumResEvals * NETF = IOUT( 5) -> IDAGetNumErrTestFails * NCFN = IOUT( 6) -> IDAGetNumNonlinSolvConvFails * NNI = IOUT( 7) -> IDAGetNumNonlinSolvIters * NSETUPS = IOUT( 8) -> IDAGetNumLinSolvSetups * KLAST = IOUT( 9) -> IDAGetLastOrder * KCUR = IOUT(10) -> IDAGetCurrentOrder * NBCKTRK = IOUT(11) -> IDAGetNumBacktrackOps * NGE = IOUT(12) -> IDAGetNumGEvals * * HINUSED = ROUT( 1) -> IDAGetActualInitStep * HLAST = ROUT( 2) -> IDAGetLastStep * HCUR = ROUT( 3) -> IDAGetCurrentStep * TCUR = ROUT( 4) -> IDAGetCurrentTime * TOLSFAC = ROUT( 5) -> IDAGetTolScaleFactor * UNITRND = ROUT( 6) -> UNIT_ROUNDOFF * * IPAR = array with user integer data * (declare as INTEGER*4 or INTEGER*8 according to C type long int) * RPAR = array with user real data * IER = return completion flag. Values are 0 = SUCCESS, and -1 = failure. * See printed message for details in case of failure. * * If the user program includes the FIDAEWT routine for the evaluation of the * error weights, the following call must be made * CALL FIDAEWTSET (FLAG, IER) * with FLAG = 1 to specify that FIDAEWT is provided. * The return flag IER is 0 if successful, and nonzero otherwise. * * (4.3) Attach one of the 3 SPILS linear solvers. Make one of the * following calls (see fida.h) for more details. * CALL FIDASPGMR(MAXL, IGSTYPE, MAXRS, EPLIFAC, DQINCFAC, IER) * CALL FIDASPBCG(MAXL, EPLIFAC, DQINCFAC, IER) * CALL FIDASPTFQMR(MAXL, EPLIFAC, DQINCFAC, IER) * * (4.4) To allocate memory and initialize data associated with the IDABBDPRE * preconditioner, make the following call: * CALL FIDABBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, DQRELY, IER) * The arguments are: * NLOCAL = local size of vectors * MUDQ,MLDQ = upper and lower half-bandwidths to be used in the computation * of the local Jacobian blocks by difference quotients. * These may be smaller than the true half-bandwidths of the * Jacobian of the local block of g, when smaller values may * provide greater efficiency. * MU, ML = upper and lower half-bandwidths of the band matrix that * is retained as an approximation of the local Jacobian block. * These may be smaller than MUDQ and MLDQ. * DQRELY = relative increment factor in y for difference quotients * (optional). 0.0 indicates the default, sqrt(UNIT_ROUNDOFF). * IER = return completion flag: IER=0: success, IER<0: an error occured * * (4.5) To specify whether the linear solver should use the supplied FIDAJTIMES or the * internal finite difference approximation, make the call * CALL FIDASPILSSETJAC(FLAG, IER) * where FLAG=0 for finite differences approxaimtion or * FLAG=1 to use the supplied routine FIDAJTIMES * * (5) Re-initialization: FIDAREINIT, FIDABBDREINIT * If a sequence of problems of the same size is being solved using the SPGMR or * SPBCG linear solver in combination with the IDABBDPRE preconditioner, then the * IDA package can be reinitialized for the second and subsequent problems * so as to avoid further memory allocation. First, in place of the call * to FIDAMALLOC, make the following call: * CALL FIDAREINIT(T0, Y0, YP0, IATOL, RTOL, ATOL, ID, CONSTR, IER) * The arguments have the same names and meanings as those of FIDAMALLOC. * FIDAREINIT performs the same initializations as FIDAMALLOC, but does no * memory allocation for IDA data structures, using instead the existing * internal memory created by the previous FIDAMALLOC call. Following the call * to FIDAREINIT, a call to FIDABBDINIT may or may not be needed. If the input * arguments are the same, no FIDABBDINIT call is needed. If there is a change * in input arguments other than MU, ML or MAXL, then the user program should call * FIDABBDREINIT. The arguments of the FIDABBDREINIT routine have the * same names and meanings as FIDABBDINIT. Finally, if the value of MU, ML, or * MAXL is being changed, then a call to FIDABBDINIT must be made. * * (6) The solver: FIDASOLVE * To solve the DAE system, make the following call: * CALL FIDASOLVE (TOUT, TRET, Y, YP, ITASK, IER) * The arguments are: * TOUT = next value of t at which a solution is desired (input) * TRET = value of t reached by the solver on output * Y = array containing the computed solution on output * YP = array containing current value of y' * ITASK = task indicator: 1 = normal mode (overshoot TOUT and interpolate) * 2 = one-step mode (return after each internal step taken) * 3 = normal tstop mode (like 1, but integration never proceeds past * TSTOP, which must be specified through a call to FIDASETRIN * using the key 'STOP_TIME' * 4 = one step tstop (like 2, but integration never goes past TSTOP) * IER = completion flag: 0 = success, 1 = tstop return, 2 = root return, * values -1 ... -10 are various failure modes (see IDA manual). * The current values of the optional outputs are available in IOUT and ROUT. * * (7) Optional outputs: FIDABBDOPT * Optional outputs specific to the SPGMR/SPBCG/SPTFQMR solver are available * in IOUT(13)...IOUT(21) * * To obtain the optional outputs associated with the IDABBDPRE module, make * the following call: * CALL FIDABBDOPT (LENRWBBD, LENIWBBD, NGEBBD) * The arguments returned are: * LENRWBBD = length of real preconditioner work space, in realtype words. * This size is local to the current process. * LENIWBBD = length of integer preconditioner work space, in integer words. * This size is local to the current process. * NGEBBD = number of G(t,y,y') evaluations (calls to FIDAGLOCFN) so far. * * (8) Memory freeing: FIDAFREE * To the free the internal memory created by the calls to FNVINITP and * FIDAMALLOC, make the following call: * CALL FIDAFREE * * ============================================================================== */ #ifndef _FIDABBD_H #define _FIDABBD_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #if defined(SUNDIALS_F77_FUNC) #define FIDA_BBDINIT SUNDIALS_F77_FUNC(fidabbdinit, FIDABBDINIT) #define FIDA_BBDREINIT SUNDIALS_F77_FUNC(fidabbdreinit, FIDABBDREINIT) #define FIDA_BBDOPT SUNDIALS_F77_FUNC(fidabbdopt, FIDABBDOPT) #define FIDA_GLOCFN SUNDIALS_F77_FUNC(fidaglocfn, FIDAGLOCFN) #define FIDA_COMMFN SUNDIALS_F77_FUNC(fidacommfn, FIDACOMMFN) #else #define FIDA_BBDINIT fidabbdinit_ #define FIDA_BBDREINIT fidabbdreinit_ #define FIDA_BBDOPT fidabbdopt_ #define FIDA_GLOCFN fidaglocfn_ #define FIDA_COMMFN fidacommfn_ #endif /* Prototypes of exported functions */ void FIDA_BBDINIT(long int *Nloc, long int *mudq, long int *mldq, long int *mu, long int *ml, realtype *dqrely, int *ier); void FIDA_BBDREINIT(long int *Nloc, long int *mudq, long int *mldq, realtype *dqrely, int *ier); void FIDA_BBDOPT(long int *lenrwbbd, long int *leniwbbd, long int *ngebbd); /* Prototypes: Functions Called by the IDABBD Module */ int FIDAgloc(long int Nloc, realtype t, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); int FIDAcfn(long int Nloc, realtype t, N_Vector yy, N_Vector yp, void *user_data); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/fcmix/fidapreco.c0000600000175000017500000001140411741421215020742 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/03/17 21:01:08 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The C function FIDAPSet is to interface between the IDASPILS * modules and the user-supplied preconditioner setup routine FIDAPSET. * Note the use of the generic name FIDA_PSET below. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual fn. names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_PSET(realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, realtype*, realtype*, int*); extern void FIDA_PSOL(realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_SPILSSETPREC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDASpilsSetPreconditioner(IDA_idamem, NULL, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDASpilsSetPreconditioner(IDA_idamem, (IDASpilsPrecSetupFn) FIDAPSet, (IDASpilsPrecSolveFn) FIDAPSol); } return; } /*************************************************/ int FIDAPSet(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *ewtdata, *v1data, *v2data, *v3data; realtype h; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_PSET(&t, yy_data, yp_data, rr_data, &c_j, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } /*************************************************/ int FIDAPSol(realtype t, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector vtemp1) { realtype *yy_data, *yp_data, *rr_data, *ewtdata, *rdata, *zdata, *v1data; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = ewtdata = zdata = v1data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); rdata = N_VGetArrayPointer(rvec); zdata = N_VGetArrayPointer(zvec); v1data = N_VGetArrayPointer(vtemp1); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine */ FIDA_PSOL(&t, yy_data, yp_data, rr_data, rdata, zdata, &c_j, &delta, ewtdata, IDA_userdata->ipar, IDA_userdata->rpar, v1data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidadense.c0000600000175000017500000000642411741421215020736 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:37:20 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for IDA/IDADENSE, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual function names, prototypes and global vars.*/ #include "ida_impl.h" /* definition of IDAMem type */ #include /*************************************************/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_DJAC(long int*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, long int*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*************************************************/ void FIDA_DENSESETJAC(int *flag, int *ier) { *ier = 0; if (*flag == 0) { *ier = IDADlsSetDenseJacFn(IDA_idamem, NULL); } else { if (F2C_IDA_ewtvec == NULL) { F2C_IDA_ewtvec = N_VClone(F2C_IDA_vec); if (F2C_IDA_ewtvec == NULL) { *ier = -1; return; } } *ier = IDADlsSetDenseJacFn(IDA_idamem, FIDADenseJac); } return; } /*************************************************/ int FIDADenseJac(long int N, realtype t, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype *yy_data, *yp_data, *rr_data, *jacdata, *ewtdata, *v1data, *v2data, *v3data; realtype h; int ier; FIDAUserData IDA_userdata; /* Initialize all pointers to NULL */ yy_data = yp_data = rr_data = jacdata = ewtdata = NULL; v1data = v2data = v3data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; IDAGetErrWeights(IDA_idamem, F2C_IDA_ewtvec); IDAGetLastStep(IDA_idamem, &h); /* Get pointers to vector data */ yy_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rr_data = N_VGetArrayPointer(rr); ewtdata = N_VGetArrayPointer(F2C_IDA_ewtvec); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); v3data = N_VGetArrayPointer(vtemp3); jacdata = DENSE_COL(Jac,0); IDA_userdata = (FIDAUserData) user_data; /* Call user-supplied routine*/ FIDA_DJAC(&N, &t, yy_data, yp_data, rr_data, jacdata, &c_j, ewtdata, &h, IDA_userdata->ipar, IDA_userdata->rpar, v1data, v2data, v3data, &ier); return(ier); } sundials-2.5.0/src/ida/fcmix/fidaroot.c0000600000175000017500000000523511741421215020622 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:29:00 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Alan C. Hindmarsh @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * The FIDAROOT module contains the routines necessary to use * the rootfinding feature of the IDA module and to interface * with the user-supplied Fortran subroutine. * ----------------------------------------------------------------- */ #include #include #include "fida.h" /* actual function names, prototypes and global vars.*/ #include "fidaroot.h" /* prototypes of interfaces to IDA */ #include "ida_impl.h" /* definition of IDAMeme type */ /***************************************************************************/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FIDA_ROOTFN(realtype*, /* T */ realtype*, /* Y */ realtype*, /* YP */ realtype*, /* G */ long int*, /* IPAR */ realtype*, /* RPAR */ int*); /* IER */ #ifdef __cplusplus } #endif /***************************************************************************/ void FIDA_ROOTINIT(int *nrtfn, int *ier) { *ier = IDARootInit(IDA_idamem, *nrtfn, (IDARootFn) FIDArootfunc); IDA_nrtfn = *nrtfn; return; } /***************************************************************************/ void FIDA_ROOTINFO(int *nrtfn, int *info, int *ier) { *ier = IDAGetRootInfo(IDA_idamem, info); return; } /***************************************************************************/ void FIDA_ROOTFREE(void) { IDARootInit(IDA_idamem, 0, NULL); return; } /***************************************************************************/ int FIDArootfunc(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data) { int ier; realtype *ydata, *ypdata; FIDAUserData IDA_userdata; ydata = N_VGetArrayPointer(y); ypdata = N_VGetArrayPointer(yp); IDA_userdata = (FIDAUserData) user_data; FIDA_ROOTFN(&t, ydata, ypdata, gout, IDA_userdata->ipar, IDA_userdata->rpar, &ier); return(ier); } sundials-2.5.0/src/ida/ida_direct_impl.h0000600000175000017500000000743311741421215021024 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:35:26 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the IDADLS linear solvers. * ----------------------------------------------------------------- */ #ifndef _IDADLS_IMPL_H #define _IDADLS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * I D A D I R E C T I N T E R N A L C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : IDADlsMemRec, IDADlsMem * ----------------------------------------------------------------- * IDADlsMem is pointer to a IDADlsMemRec structure. * ----------------------------------------------------------------- */ typedef struct IDADlsMemRec { int d_type; /* Type of Jacobians (DENSE or BAND) */ long int d_n; /* problem dimension */ long int d_ml; /* b_ml = lower bandwidth of savedJ */ long int d_mu; /* b_mu = upper bandwidth of savedJ */ long int d_smu; /* upper bandwith of M = MIN(N-1,b_mu+b_ml) */ booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ IDADlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ IDADlsBandJacFn d_bjac; /* band Jacobian routine to be called */ void *d_J_data; /* J_data is passed to djac or bjac */ DlsMat d_J; /* J = dF/dy + cj*dF/dy' */ int *d_pivots; /* pivots = int pivot array for PM = LU */ long int *d_lpivots; /* lpivots = long int pivot array for PM = LU */ long int d_nje; /* nje = no. of calls to jac */ long int d_nreDQ; /* no. of calls to res due to DQ Jacobian approx.*/ long int d_last_flag; /* last error return flag */ } *IDADlsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ int idaDlsDenseDQJac(long int N, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int idaDlsBandDQJac(long int N, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * E R R O R M E S S A G E S * ================================================================= */ #define MSGD_IDAMEM_NULL "Integrator memory is NULL." #define MSGD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSGD_MEM_FAIL "A memory request failed." #define MSGD_LMEM_NULL "Linear solver memory is NULL." #define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/ida/ida_spgmr.c0000600000175000017500000003436711741421215017662 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2011/05/25 20:20:25 $ * ----------------------------------------------------------------- * Programmers: Alan C. Hindmarsh, and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California * Produced at the Lawrence Livermore National Laboratory * All rights reserved * For details, see the LICENSE file * ----------------------------------------------------------------- * This is the implementation file for the IDA Scaled * Preconditioned GMRES linear solver module, IDASPGMR. * ----------------------------------------------------------------- */ #include #include #include #include "ida_spils_impl.h" #include "ida_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define PT9 RCONST(0.9) #define PT05 RCONST(0.05) /* IDASPGMR linit, lsetup, lsolve, lperf, and lfree routines */ static int IDASpgmrInit(IDAMem IDA_mem); static int IDASpgmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now); static int IDASpgmrPerf(IDAMem IDA_mem, int perftask); static int IDASpgmrFree(IDAMem IDA_mem); /* Readability Replacements */ #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define epsNewt (IDA_mem->ida_epsNewt) #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define ewt (IDA_mem->ida_ewt) #define errfp (IDA_mem->ida_errfp) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lperf (IDA_mem->ida_lperf) #define lfree (IDA_mem->ida_lfree) #define lmem (IDA_mem->ida_lmem) #define nni (IDA_mem->ida_nni) #define ncfn (IDA_mem->ida_ncfn) #define setupNonNull (IDA_mem->ida_setupNonNull) #define vec_tmpl (IDA_mem->ida_tempv1) #define sqrtN (idaspils_mem->s_sqrtN) #define epslin (idaspils_mem->s_epslin) #define ytemp (idaspils_mem->s_ytemp) #define yptemp (idaspils_mem->s_yptemp) #define xx (idaspils_mem->s_xx) #define ycur (idaspils_mem->s_ycur) #define ypcur (idaspils_mem->s_ypcur) #define rcur (idaspils_mem->s_rcur) #define npe (idaspils_mem->s_npe) #define nli (idaspils_mem->s_nli) #define nps (idaspils_mem->s_nps) #define ncfl (idaspils_mem->s_ncfl) #define nst0 (idaspils_mem->s_nst0) #define nni0 (idaspils_mem->s_nni0) #define nli0 (idaspils_mem->s_nli0) #define ncfn0 (idaspils_mem->s_ncfn0) #define ncfl0 (idaspils_mem->s_ncfl0) #define nwarn (idaspils_mem->s_nwarn) #define njtimes (idaspils_mem->s_njtimes) #define nres (idaspils_mem->s_nres) #define spils_mem (idaspils_mem->s_spils_mem) #define jtimesDQ (idaspils_mem->s_jtimesDQ) #define jtimes (idaspils_mem->s_jtimes) #define jdata (idaspils_mem->s_jdata) #define last_flag (idaspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * IDASpgmr * ----------------------------------------------------------------- * * This routine initializes the memory record and sets various function * fields specific to the IDASPGMR linear solver module. * * IDASpgmr first calls the existing lfree routine if this is not NULL. * It then sets the ida_linit, ida_lsetup, ida_lsolve, ida_lperf, and * ida_lfree fields in (*IDA_mem) to be IDASpgmrInit, IDASpgmrSetup, * IDASpgmrSolve, IDASpgmrPerf, and IDASpgmrFree, respectively. * It allocates memory for a structure of type IDASpilsMemRec and sets * the ida_lmem field in (*IDA_mem) to the address of this structure. * It sets setupNonNull in (*IDA_mem). It then various fields in the * IDASpilsMemRec structure. Finally, IDASpgmr allocates memory for * ytemp, yptemp, and xx, and calls SpgmrMalloc to allocate memory * for the Spgmr solver. * * The return value of IDASpgmr is: * IDASPILS_SUCCESS = 0 if successful * IDASPILS_MEM_FAIL = -1 if IDA_mem is NULL or a memory allocation failed * IDASPILS_ILL_INPUT = -2 if the gstype argument is illegal. * * ----------------------------------------------------------------- */ int IDASpgmr(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPGMR", "IDASpgmr", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if(vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPGMR", "IDASpgmr", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASpgmrInit; lsetup = IDASpgmrSetup; lsolve = IDASpgmrSolve; lperf = IDASpgmrPerf; lfree = IDASpgmrFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPGMR; /* Set SPGMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Spgmr parameters */ idaspils_mem->s_gstype = MODIFIED_GS; idaspils_mem->s_maxrs = IDA_SPILS_MAXRS; idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); /* Call SpgmrMalloc to allocate workspace for Spgmr */ spgmr_mem = NULL; spgmr_mem = SpgmrMalloc(maxl1, vec_tmpl); if (spgmr_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPGMR", "IDASpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPGMR memory to spils memory structure */ spils_mem = (void *)spgmr_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); } /* * ----------------------------------------------------------------- * IDASPGMR interface routines * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define gstype (idaspils_mem->s_gstype) #define maxl (idaspils_mem->s_maxl) #define maxrs (idaspils_mem->s_maxrs) #define eplifac (idaspils_mem->s_eplifac) #define psolve (idaspils_mem->s_psolve) #define pset (idaspils_mem->s_pset) #define pdata (idaspils_mem->s_pdata) static int IDASpgmrInit(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nres = 0; /* Set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = IDASpilsDQJtimes; jdata = IDA_mem; } else { jdata = user_data; } last_flag = IDASPILS_SUCCESS; return(0); } static int IDASpgmrSetup(IDAMem IDA_mem, N_Vector yy_p, N_Vector yp_p, N_Vector rr_p, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDASpilsMem idaspils_mem; idaspils_mem = (IDASpilsMem) lmem; /* Call user setup routine pset and update counter npe. */ retval = pset(tn, yy_p, yp_p, rr_p, cj, pdata, tmp1, tmp2, tmp3); npe++; /* Return flag showing success or failure of pset. */ if (retval < 0) { IDAProcessError(IDA_mem, SPGMR_PSET_FAIL_UNREC, "IDASPGMR", "IDASpgmrSetup", MSGS_PSET_FAILED); last_flag = SPGMR_PSET_FAIL_UNREC; return(-1); } if (retval > 0) { last_flag = SPGMR_PSET_FAIL_REC; return(+1); } last_flag = SPGMR_SUCCESS; return(0); } /* * The x-scaling and b-scaling arrays are both equal to weight. * * We set the initial guess, x = 0, then call SpgmrSolve. * We copy the solution x into b, and update the counters nli, nps, ncfl. * If SpgmrSolve returned nli_inc = 0 (hence x = 0), we take the SPGMR * vtemp vector (= P_inverse F) as the correction vector instead. * Finally, we set the return value according to the success of SpgmrSolve. */ static int IDASpgmrSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; /* Set SpgmrSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the GMRES convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SpgmrSolve inputs pretype and initial guess xx = 0. */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SpgmrSolve and copy xx to bb. */ retval = SpgmrSolve(spgmr_mem, IDA_mem, xx, bb, pretype, gstype, epslin, maxrs, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); if (nli_inc == 0) N_VScale(ONE, SPGMR_VTEMP(spgmr_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful. */ nli += nli_inc; nps += nps_inc; if (retval != SPGMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPGMR_SUCCESS: return(0); break; case SPGMR_RES_REDUCED: return(1); break; case SPGMR_CONV_FAIL: return(1); break; case SPGMR_QRFACT_FAIL: return(1); break; case SPGMR_PSOLVE_FAIL_REC: return(1); break; case SPGMR_ATIMES_FAIL_REC: return(1); break; case SPGMR_MEM_NULL: return(-1); break; case SPGMR_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPGMR_ATIMES_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPGMR_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPGMR_PSOLVE_FAIL_UNREC, "IDASPGMR", "IDASpgmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; case SPGMR_GS_FAIL: return(-1); break; case SPGMR_QRSOL_FAIL: return(-1); break; } return(0); } /* * This routine handles performance monitoring specific to the IDASPGMR * linear solver. When perftask = 0, it saves values of various counters. * When perftask = 1, it examines difference quotients in these counters, * and depending on their values, it prints up to three warning messages. * Messages are printed up to a maximum of 10 times. */ static int IDASpgmrPerf(IDAMem IDA_mem, int perftask) { IDASpilsMem idaspils_mem; realtype avdim, rcfn, rcfl; long int nstd, nnid; booleantype lavd, lcfn, lcfl; idaspils_mem = (IDASpilsMem) lmem; if (perftask == 0) { nst0 = nst; nni0 = nni; nli0 = nli; ncfn0 = ncfn; ncfl0 = ncfl; nwarn = 0; return(0); } nstd = nst - nst0; nnid = nni - nni0; if (nstd == 0 || nnid == 0) return(0); avdim = (realtype) ((nli - nli0)/((realtype) nnid)); rcfn = (realtype) ((ncfn - ncfn0)/((realtype) nstd)); rcfl = (realtype) ((ncfl - ncfl0)/((realtype) nnid)); lavd = (avdim > ((realtype) maxl )); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lavd || lcfn || lcfl)) return(0); nwarn++; if (nwarn > 10) return(1); if (lavd) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_AVD_WARN, tn, avdim); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFN_WARN, tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASPGMR", "IDASpgmrPerf", MSGS_CFL_WARN, tn, rcfl); return(0); } static int IDASpgmrFree(IDAMem IDA_mem) { IDASpilsMem idaspils_mem; SpgmrMem spgmr_mem; idaspils_mem = (IDASpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); spgmr_mem = (SpgmrMem) spils_mem; SpgmrFree(spgmr_mem); if (idaspils_mem->s_pfree != NULL) (idaspils_mem->s_pfree)(IDA_mem); free(idaspils_mem); idaspils_mem = NULL; return(0); } sundials-2.5.0/src/ida/ida_direct.c0000600000175000017500000003712611741421215020000 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:35:26 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for an IDADLS linear solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "ida_impl.h" #include "ida_direct_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define res (IDA_mem->ida_res) #define user_data (IDA_mem->ida_user_data) #define uround (IDA_mem->ida_uround) #define nst (IDA_mem->ida_nst) #define tn (IDA_mem->ida_tn) #define hh (IDA_mem->ida_hh) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define ewt (IDA_mem->ida_ewt) #define constraints (IDA_mem->ida_constraints) #define linit (IDA_mem->ida_linit) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define lfree (IDA_mem->ida_lfree) #define lperf (IDA_mem->ida_lperf) #define lmem (IDA_mem->ida_lmem) #define tempv (IDA_mem->ida_tempv1) #define setupNonNull (IDA_mem->ida_setupNonNull) #define mtype (idadls_mem->d_type) #define n (idadls_mem->d_n) #define ml (idadls_mem->d_ml) #define mu (idadls_mem->d_mu) #define smu (idadls_mem->d_smu) #define jacDQ (idadls_mem->d_jacDQ) #define djac (idadls_mem->d_djac) #define bjac (idadls_mem->d_bjac) #define M (idadls_mem->d_J) #define pivots (idadls_mem->d_pivots) #define nje (idadls_mem->d_nje) #define nreDQ (idadls_mem->d_nreDQ) #define last_flag (idadls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS FOR IMPLICIT INTEGRATION * ================================================================= */ /* * IDADlsSetDenseJacFn specifies the dense Jacobian function. */ int IDADlsSetDenseJacFn(void *ida_mem, IDADlsDenseJacFn jac) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsSetDenseJacFn", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsSetDenseJacFn", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; djac = jac; } else { jacDQ = TRUE; } return(IDADLS_SUCCESS); } /* * IDADlsSetBandJacFn specifies the band Jacobian function. */ int IDADlsSetBandJacFn(void *ida_mem, IDADlsBandJacFn jac) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsSetBandJacFn", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsSetBandJacFn", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; bjac = jac; } else { jacDQ = TRUE; } return(IDADLS_SUCCESS); } /* * IDADlsGetWorkSpace returns the length of workspace allocated for the * IDALAPACK linear solver. */ int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetWorkSpace", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetWorkSpace", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; if (mtype == SUNDIALS_DENSE) { *lenrwLS = n*n; *leniwLS = n; } else if (mtype == SUNDIALS_BAND) { *lenrwLS = n*(smu + ml + 1); *leniwLS = n; } return(IDADLS_SUCCESS); } /* * IDADlsGetNumJacEvals returns the number of Jacobian evaluations. */ int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetNumJacEvals", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetNumJacEvals", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *njevals = nje; return(IDADLS_SUCCESS); } /* * IDADlsGetNumResEvals returns the number of calls to the DAE function * needed for the DQ Jacobian approximation. */ int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetNumFctEvals", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetNumFctEvals", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *nrevalsLS = nreDQ; return(IDADLS_SUCCESS); } /* * IDADlsGetReturnFlagName returns the name associated with a IDALAPACK * return value. */ char *IDADlsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case IDADLS_SUCCESS: sprintf(name,"IDADLS_SUCCESS"); break; case IDADLS_MEM_NULL: sprintf(name,"IDADLS_MEM_NULL"); break; case IDADLS_LMEM_NULL: sprintf(name,"IDADLS_LMEM_NULL"); break; case IDADLS_ILL_INPUT: sprintf(name,"IDADLS_ILL_INPUT"); break; case IDADLS_MEM_FAIL: sprintf(name,"IDADLS_MEM_FAIL"); break; case IDADLS_JACFUNC_UNRECVR: sprintf(name,"IDADLS_JACFUNC_UNRECVR"); break; case IDADLS_JACFUNC_RECVR: sprintf(name,"IDADLS_JACFUNC_RECVR"); break; default: sprintf(name,"NONE"); } return(name); } /* * IDADlsGetLastFlag returns the last flag set in a IDALAPACK function. */ int IDADlsGetLastFlag(void *ida_mem, long int *flag) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADLS", "IDADlsGetLastFlag", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (lmem == NULL) { IDAProcessError(IDA_mem, IDADLS_LMEM_NULL, "IDADLS", "IDADlsGetLastFlag", MSGD_LMEM_NULL); return(IDADLS_LMEM_NULL); } idadls_mem = (IDADlsMem) lmem; *flag = last_flag; return(IDADLS_SUCCESS); } /* * ================================================================= * DQ JACOBIAN APPROXIMATIONS * ================================================================= */ /* * ----------------------------------------------------------------- * idaDlsDenseDQJac * ----------------------------------------------------------------- * This routine generates a dense difference quotient approximation to * the Jacobian F_y + c_j*F_y'. It assumes that a dense matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of J is obtained via * the macro LAPACK_DENSE_COL and this pointer is associated with an N_Vector * using the N_VGetArrayPointer/N_VSetArrayPointer functions. * Finally, the actual computation of the jth column of the Jacobian is * done with a call to N_VLinearSum. * ----------------------------------------------------------------- */ int idaDlsDenseDQJac(long int N, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj; realtype *tmp2_data, *y_data, *yp_data, *ewt_data, *cns_data = NULL; N_Vector rtemp, jthCol; long int j; int retval = 0; IDAMem IDA_mem; IDADlsMem idadls_mem; /* data points to IDA_mem */ IDA_mem = (IDAMem) data; idadls_mem = (IDADlsMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ rtemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for ewt, yy, yp. */ ewt_data = N_VGetArrayPointer(ewt); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); if(constraints!=NULL) cns_data = N_VGetArrayPointer(constraints); srur = RSqrt(uround); for (j=0; j < N; j++) { /* Generate the jth col of J(tt,yy,yp) as delta(F)/delta(y_j). */ /* Set data address of jthCol, and save y_j and yp_j values. */ N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); yj = y_data[j]; ypj = yp_data[j]; /* Set increment inc to y_j based on sqrt(uround)*abs(y_j), with adjustments using yp_j and ewt_j if this is small, and a further adjustment to give it the same sign as hh*yp_j. */ inc = MAX( srur * MAX( ABS(yj), ABS(hh*ypj) ) , ONE/ewt_data[j] ); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if y_j has an inequality constraint. */ if (constraints != NULL) { conj = cns_data[j]; if (ABS(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment y_j and yp_j, call res, and break on error return. */ y_data[j] += inc; yp_data[j] += c_j*inc; retval = res(tt, yy, yp, rtemp, user_data); nreDQ++; if (retval != 0) break; /* Construct difference quotient in jthCol */ inc_inv = ONE/inc; N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); /* reset y_j, yp_j */ y_data[j] = yj; yp_data[j] = ypj; } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /* * ----------------------------------------------------------------- * idaDlsBandDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation JJ * to the DAE system Jacobian J. It assumes that a band matrix of type * BandMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of JJ is obtained via * the macros BAND_COL and BAND_COL_ELEM. The columns of the Jacobian are * constructed using mupper + mlower + 1 calls to the res routine, and * appropriate differencing. * The return value is either IDABAND_SUCCESS = 0, or the nonzero value returned * by the res routine, if any. */ int idaDlsBandDQJac(long int N, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; N_Vector rtemp, ytemp, yptemp; long int i, j, i1, i2, width, ngroups, group; int retval = 0; IDAMem IDA_mem; IDADlsMem idadls_mem; /* data points to IDA_mem */ IDA_mem = (IDAMem) data; idadls_mem = (IDADlsMem) lmem; rtemp = tmp1; /* Rename work vector for use as the perturbed residual. */ ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ yptemp= tmp3; /* Rename work vector for use as a temporary for yp. */ /* Obtain pointers to the data for all eight vectors used. */ ewt_data = N_VGetArrayPointer(ewt); r_data = N_VGetArrayPointer(rr); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rtemp_data = N_VGetArrayPointer(rtemp); ytemp_data = N_VGetArrayPointer(ytemp); yptemp_data = N_VGetArrayPointer(yptemp); if (constraints != NULL) cns_data = N_VGetArrayPointer(constraints); /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Compute miscellaneous values for the Jacobian computation. */ srur = RSqrt(uround); width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all yy[j] and yp[j] for j in this group. */ for (j=group-1; j #include #include "ida_impl.h" #include /* Macro: loop */ #define loop for(;;) /* * ================================================================= * IDA Constants * ================================================================= */ /* Private Constants */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT001 RCONST(0.001) /* real 0.001 */ /* IDACalcIC control constants */ #define ICRATEMAX RCONST(0.9) /* max. Newton conv. rate */ #define ALPHALS RCONST(0.0001) /* alpha in linesearch conv. test */ /* Return values for lower level routines used by IDACalcIC */ #define IC_FAIL_RECOV 1 #define IC_CONSTR_FAILED 2 #define IC_LINESRCH_FAILED 3 #define IC_CONV_FAIL 4 #define IC_SLOW_CONVRG 5 /* * ================================================================= * Private Helper Functions Prototypes * ================================================================= */ extern int IDAInitialSetup(IDAMem IDA_mem); extern realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); static int IDAnlsIC(IDAMem IDA_mem); static int IDANewtonIC(IDAMem IDA_mem); static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm); static int IDANewyyp(IDAMem IDA_mem, realtype lambda); static int IDANewy(IDAMem IDA_mem); static int IDAICFailFlag(IDAMem IDA_mem, int retval); /* * ================================================================= * Readibility Constants * ================================================================= */ #define t0 (IDA_mem->ida_t0) #define yy0 (IDA_mem->ida_yy0) #define yp0 (IDA_mem->ida_yp0) #define user_data (IDA_mem->ida_user_data) #define res (IDA_mem->ida_res) #define efun (IDA_mem->ida_efun) #define edata (IDA_mem->ida_edata) #define uround (IDA_mem->ida_uround) #define phi (IDA_mem->ida_phi) #define ewt (IDA_mem->ida_ewt) #define delta (IDA_mem->ida_delta) #define ee (IDA_mem->ida_ee) #define savres (IDA_mem->ida_savres) #define tempv2 (IDA_mem->ida_tempv2) #define hh (IDA_mem->ida_hh) #define tn (IDA_mem->ida_tn) #define cj (IDA_mem->ida_cj) #define cjratio (IDA_mem->ida_cjratio) #define nbacktr (IDA_mem->ida_nbacktr) #define nre (IDA_mem->ida_nre) #define ncfn (IDA_mem->ida_ncfn) #define nni (IDA_mem->ida_nni) #define nsetups (IDA_mem->ida_nsetups) #define ns (IDA_mem->ida_ns) #define lsetup (IDA_mem->ida_lsetup) #define lsolve (IDA_mem->ida_lsolve) #define hused (IDA_mem->ida_hused) #define epsNewt (IDA_mem->ida_epsNewt) #define id (IDA_mem->ida_id) #define setupNonNull (IDA_mem->ida_setupNonNull) #define suppressalg (IDA_mem->ida_suppressalg) #define constraints (IDA_mem->ida_constraints) #define constraintsSet (IDA_mem->ida_constraintsSet) #define epiccon (IDA_mem->ida_epiccon) #define maxnh (IDA_mem->ida_maxnh) #define maxnj (IDA_mem->ida_maxnj) #define maxnit (IDA_mem->ida_maxnit) #define lsoff (IDA_mem->ida_lsoff) #define steptol (IDA_mem->ida_steptol) /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDACalcIC * ----------------------------------------------------------------- * IDACalcIC computes consistent initial conditions, given the * user's initial guess for unknown components of yy0 and/or yp0. * * The return value is IDA_SUCCESS = 0 if no error occurred. * * The error return values (fully described in ida.h) are: * IDA_MEM_NULL ida_mem is NULL * IDA_NO_MALLOC ida_mem was not allocated * IDA_ILL_INPUT bad value for icopt, tout1, or id * IDA_LINIT_FAIL the linear solver linit routine failed * IDA_BAD_EWT zero value of some component of ewt * IDA_RES_FAIL res had a non-recoverable error * IDA_FIRST_RES_FAIL res failed recoverably on the first call * IDA_LSETUP_FAIL lsetup had a non-recoverable error * IDA_LSOLVE_FAIL lsolve had a non-recoverable error * IDA_NO_RECOVERY res, lsetup, or lsolve had a recoverable * error, but IDACalcIC could not recover * IDA_CONSTR_FAIL the inequality constraints could not be met * IDA_LINESEARCH_FAIL the linesearch failed (on steptol test) * IDA_CONV_FAIL the Newton iterations failed to converge * ----------------------------------------------------------------- */ int IDACalcIC(void *ida_mem, int icopt, realtype tout1) { int ewtsetOK; int ier, nwt, nh, mxnh, icret, retval=0; realtype tdist, troundoff, minid, hic, ypnorm; IDAMem IDA_mem; /* Check if IDA memory exists */ if(ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDACalcIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if(IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDACalcIC", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs to IDA for correctness and consistency */ ier = IDAInitialSetup(IDA_mem); if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = TRUE; /* Check legality of input arguments, and set IDA memory copies. */ if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ICOPT); return(IDA_ILL_INPUT); } IDA_mem->ida_icopt = icopt; if(icopt == IDA_YA_YDP_INIT && (id == NULL)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_MISSING_ID); return(IDA_ILL_INPUT); } tdist = ABS(tout1 - tn); troundoff = TWO*uround*(ABS(tn) + ABS(tout1)); if(tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_TOO_CLOSE); return(IDA_ILL_INPUT); } /* Allocate space and initialize temporary vectors */ yy0 = N_VClone(ee); yp0 = N_VClone(ee); t0 = tn; N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ IDA_mem->ida_sysindex = 1; IDA_mem->ida_tscale = tdist; if(icopt == IDA_YA_YDP_INIT) { minid = N_VMin(id); if(minid < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ID); return(IDA_ILL_INPUT); } if(minid > HALF) IDA_mem->ida_sysindex = 0; } /* Set the test constant in the Newton convergence test */ IDA_mem->ida_epsNewt = epiccon; /* Initializations: cjratio = 1 (for use in direct linear solvers); set nbacktr = 0; */ cjratio = ONE; nbacktr = 0; /* Set hic, hh, cj, and mxnh. */ hic = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); if(ypnorm > HALF/hic) hic = HALF/ypnorm; if(tout1 < tn) hic = -hic; hh = hic; if(icopt == IDA_YA_YDP_INIT) { cj = ONE/hic; mxnh = maxnh; } else { cj = ZERO; mxnh = 1; } /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { /* Call the IC nonlinear solver function. */ retval = IDAnlsIC(IDA_mem); /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ if(retval == IDA_SUCCESS) break; ncfn++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yy0 and yp0 if not converging. */ if(retval != IC_SLOW_CONVRG) { N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); } hic *= PT1; cj = ONE/hic; hh = hic; } /* End of nh loop */ /* Break on failure; else reset ewt, save yy0, yp0 in phi, and loop. */ if(retval != IDA_SUCCESS) break; ewtsetOK = efun(yy0, ewt, edata); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } N_VScale(ONE, yy0, phi[0]); N_VScale(ONE, yp0, phi[1]); } /* End of nwt loop */ /* Free temporary space */ N_VDestroy(yy0); N_VDestroy(yp0); /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) hused = hic; /* On any failure, print message and return proper flag. */ if(retval != IDA_SUCCESS) { icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Otherwise return success flag. */ return(IDA_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS IMPLEMENTATION * ================================================================= */ #define icopt (IDA_mem->ida_icopt) #define sysindex (IDA_mem->ida_sysindex) #define tscale (IDA_mem->ida_tscale) #define ynew (IDA_mem->ida_ynew) #define ypnew (IDA_mem->ida_ypnew) #define delnew (IDA_mem->ida_delnew) #define dtemp (IDA_mem->ida_dtemp) /* * ----------------------------------------------------------------- * IDAnlsIC * ----------------------------------------------------------------- * IDAnlsIC solves a nonlinear system for consistent initial * conditions. It calls IDANewtonIC to do most of the work. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations are converging slowly * (failed the convergence test, but showed * norm reduction or convergence rate < 1) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_FIRST_RES_FAIL if res failed recoverably on the first call * IDA_LSETUP_FAIL if lsetup had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDAnlsIC (IDAMem IDA_mem) { int retval, nj; N_Vector tv1, tv2, tv3; tv1 = ee; tv2 = tempv2; tv3 = phi[2]; retval = res(t0, yy0, yp0, delta, user_data); nre++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); N_VScale(ONE, delta, savres); /* Loop over nj = number of linear solve Jacobian setups. */ for(nj = 1; nj <= maxnj; nj++) { /* If there is a setup routine, call it. */ if(setupNonNull) { nsetups++; retval = lsetup(IDA_mem, yy0, yp0, delta, tv1, tv2, tv3); if(retval < 0) return(IDA_LSETUP_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Call the Newton iteration routine, and return if successful. */ retval = IDANewtonIC(IDA_mem); if(retval == IDA_SUCCESS) return(IDA_SUCCESS); /* If converging slowly and lsetup is nontrivial, retry. */ if(retval == IC_SLOW_CONVRG && setupNonNull) { N_VScale(ONE, savres, delta); continue; } else { return(retval); } } /* End of nj loop */ /* No convergence after maxnj tries; return with retval=IC_SLOW_CONVRG */ return(retval); } /* * ----------------------------------------------------------------- * IDANewtonIC * ----------------------------------------------------------------- * IDANewtonIC performs the Newton iteration to solve for consistent * initial conditions. It calls IDALineSrch within each iteration. * On return, savres contains the current residual vector. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations appear to be converging slowly. * They failed the convergence test, but showed * an overall norm reduction (by a factor of < 0.1) * or a convergence rate <= ICRATEMAX). * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDANewtonIC(IDAMem IDA_mem) { int retval, mnewt; realtype delnorm, fnorm, fnorm0, oldfnrm, rate; /* Set pointer for vector delnew */ delnew = phi[2]; /* Call the linear solve function to get the Newton step, delta. */ retval = lsolve(IDA_mem, delta, ewt, yy0, yp0, savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Compute the norm of the step; return now if this is small. */ fnorm = IDAWrmsNorm(IDA_mem, delta, ewt, FALSE); if(sysindex == 0) fnorm *= tscale*ABS(cj); if(fnorm <= epsNewt) return(IDA_SUCCESS); fnorm0 = fnorm; /* Initialize rate to avoid compiler warning message */ rate = ZERO; /* Newton iteration loop */ for(mnewt = 0; mnewt < maxnit; mnewt++) { nni++; delnorm = fnorm; oldfnrm = fnorm; /* Call the Linesearch function and return if it failed. */ retval = IDALineSrch(IDA_mem, &delnorm, &fnorm); if(retval != IDA_SUCCESS) return(retval); /* Set the observed convergence rate and test for convergence. */ rate = fnorm/oldfnrm; if(fnorm <= epsNewt) return(IDA_SUCCESS); /* If not converged, copy new step vector, and loop. */ N_VScale(ONE, delnew, delta); } /* End of Newton iteration loop */ /* Return either IC_SLOW_CONVRG or recoverable fail flag. */ if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG); return(IC_CONV_FAIL); } /* * ----------------------------------------------------------------- * IDALineSrch * ----------------------------------------------------------------- * IDALineSrch performs the Linesearch algorithm with the * calculation of consistent initial conditions. * * On entry, yy0 and yp0 are the current values of y and y', the * Newton step is delta, the current residual vector F is savres, * delnorm is WRMS-norm(delta), and fnorm is the norm of the vector * J-inverse F. * * On a successful return, yy0, yp0, and savres have been updated, * delnew contains the current value of J-inverse F, and fnorm is * WRMS-norm(delnew). * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (on steptol test) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm) { booleantype conOK; int retval; realtype f1norm, fnormp, f1normp, ratio, lambda, minlam, slpi; N_Vector mc; /* Initialize work space pointers, f1norm, ratio. (Use of mc in constraint check does not conflict with ypnew.) */ mc = ee; dtemp = phi[3]; ynew = tempv2; ypnew = ee; f1norm = (*fnorm)*(*fnorm)*HALF; ratio = ONE; /* If there are constraints, check and reduce step if necessary. */ if(constraintsSet) { /* Update y and check constraints. */ IDANewy(IDA_mem); conOK = N_VConstrMask(constraints, ynew, mc); if(!conOK) { /* Not satisfied. Compute scaled step to satisfy constraints. */ N_VProd(mc, delta, dtemp); ratio = PT99*N_VMinQuotient(yy0, dtemp); (*delnorm) *= ratio; if((*delnorm) <= steptol) return(IC_CONSTR_FAILED); N_VScale(ratio, delta, delta); } } /* End of constraints check */ slpi = -TWO*f1norm*ratio; minlam = steptol/(*delnorm); lambda = ONE; /* In IDA_Y_INIT case, set ypnew = yp0 (fixed) for linesearch. */ if(icopt == IDA_Y_INIT) N_VScale(ONE, yp0, ypnew); /* Loop on linesearch variable lambda. */ loop { /* Get new (y,y') = (ynew,ypnew) and norm of new function value. */ IDANewyyp(IDA_mem, lambda); retval = IDAfnorm(IDA_mem, &fnormp); if(retval != IDA_SUCCESS) return(retval); /* If lsoff option is on, break out. */ if(lsoff) break; /* Do alpha-condition test. */ f1normp = fnormp*fnormp*HALF; if(f1normp <= f1norm + ALPHALS*slpi*lambda) break; if(lambda < minlam) return(IC_LINESRCH_FAILED); lambda /= TWO; nbacktr++; } /* End of breakout linesearch loop */ /* Update yy0, yp0, and fnorm, then return. */ N_VScale(ONE, ynew, yy0); if(icopt == IDA_YA_YDP_INIT) N_VScale(ONE, ypnew, yp0); *fnorm = fnormp; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDAfnorm * ----------------------------------------------------------------- * IDAfnorm computes the norm of the current function value, by * evaluating the DAE residual function, calling the linear * system solver, and computing a WRMS-norm. * * On return, savres contains the current residual vector F, and * delnew contains J-inverse F. * * The return value is IDA_SUCCESS = 0 if no error occurred, or * IC_FAIL_RECOV if res or lsolve failed recoverably, or * IDA_RES_FAIL if res had a non-recoverable error, or * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error. * ----------------------------------------------------------------- */ static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm) { int retval; /* Get residual vector F, return if failed, and save F in savres. */ retval = res(t0, ynew, ypnew, delnew, user_data); nre++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IC_FAIL_RECOV); N_VScale(ONE, delnew, savres); /* Call the linear solve function to get J-inverse F; return if failed. */ retval = lsolve(IDA_mem, delnew, ewt, ynew, ypnew, savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Compute the WRMS-norm; rescale if index = 0. */ *fnorm = IDAWrmsNorm(IDA_mem, delnew, ewt, FALSE); if(sysindex == 0) (*fnorm) *= tscale*ABS(cj); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDANewyyp * ----------------------------------------------------------------- * IDANewyyp updates the vectors ynew and ypnew from yy0 and yp0, * using the current step vector lambda*delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewyyp(IDAMem IDA_mem, realtype lambda) { /* IDA_YA_YDP_INIT case: ynew = yy0 - lambda*delta where id_i = 0 ypnew = yp0 - cj*lambda*delta where id_i = 1. */ if(icopt == IDA_YA_YDP_INIT) { N_VProd(id, delta, dtemp); N_VLinearSum(ONE, yp0, -cj*lambda, dtemp, ypnew); N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); N_VLinearSum(ONE, yy0, -lambda, dtemp, ynew); return(IDA_SUCCESS); } /* IDA_Y_INIT case: ynew = yy0 - lambda*delta. (ypnew = yp0 preset.) */ N_VLinearSum(ONE, yy0, -lambda, delta, ynew); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDANewy * ----------------------------------------------------------------- * IDANewy updates the vector ynew from yy0, * using the current step vector delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewy(IDAMem IDA_mem) { /* IDA_YA_YDP_INIT case: ynew = yy0 - delta where id_i = 0. */ if(icopt == IDA_YA_YDP_INIT) { N_VProd(id, delta, dtemp); N_VLinearSum(ONE, delta, -ONE, dtemp, dtemp); N_VLinearSum(ONE, yy0, -ONE, dtemp, ynew); return(IDA_SUCCESS); } /* IDA_Y_INIT case: ynew = yy0 - delta. */ N_VLinearSum(ONE, yy0, -ONE, delta, ynew); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDAICFailFlag * ----------------------------------------------------------------- * IDAICFailFlag prints a message and sets the IDACalcIC return * value appropriate to the flag retval returned by IDAnlsIC. * ----------------------------------------------------------------- */ static int IDAICFailFlag(IDAMem IDA_mem, int retval) { /* Depending on retval, print error message and return error flag. */ switch(retval) { case IDA_RES_FAIL: IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_NONREC); return(IDA_RES_FAIL); case IDA_FIRST_RES_FAIL: IDAProcessError(IDA_mem, IDA_FIRST_RES_FAIL, "IDA", "IDACalcIC", MSG_IC_RES_FAIL); return(IDA_FIRST_RES_FAIL); case IDA_LSETUP_FAIL: IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDA", "IDACalcIC", MSG_IC_SETUP_FAIL); return(IDA_LSETUP_FAIL); case IDA_LSOLVE_FAIL: IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDA", "IDACalcIC", MSG_IC_SOLVE_FAIL); return(IDA_LSOLVE_FAIL); case IC_FAIL_RECOV: IDAProcessError(IDA_mem, IDA_NO_RECOVERY, "IDA", "IDACalcIC", MSG_IC_NO_RECOVERY); return(IDA_NO_RECOVERY); case IC_CONSTR_FAILED: IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDA", "IDACalcIC", MSG_IC_FAIL_CONSTR); return(IDA_CONSTR_FAIL); case IC_LINESRCH_FAILED: IDAProcessError(IDA_mem, IDA_LINESEARCH_FAIL, "IDA", "IDACalcIC", MSG_IC_FAILED_LINS); return(IDA_LINESEARCH_FAIL); case IC_CONV_FAIL: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); return(IDA_CONV_FAIL); case IC_SLOW_CONVRG: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDA", "IDACalcIC", MSG_IC_CONV_FAILED); return(IDA_CONV_FAIL); case IDA_BAD_EWT: IDAProcessError(IDA_mem, IDA_BAD_EWT, "IDA", "IDACalcIC", MSG_IC_BAD_EWT); return(IDA_BAD_EWT); } return -99; } sundials-2.5.0/src/ida/README0000600000175000017500000004523111741421215016421 0ustar sylvestresylvestre IDA Release 2.7.0, March 2012 Alan C. Hindmarsh and Radu Serban Center for Applied Scientific Computing, LLNL IDA is a package for the solution of differential-algebraic equation (DAE) systems. It is written in C, but derived from the package DASPK [4,5], which is written in FORTRAN. IDA can be used both on serial and parallel (MPI) computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel version, communication between processors is done with the MPI (Message Passage Interface) system. When used with the serial NVECTOR module, IDA provides both direct (dense and band) linear solvers and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When IDA is used with the parallel NVECTOR module, only the Krylov linear solvers are available. For the latter case, in addition to the basic solver, the IDA package also contains a preconditioner module called IDABBDPRE, which provides a band-block-diagonal preconditioner. IDA is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers [3]. This suite consists of CVODE, CVODES, IDA, IDAS, and KINSOL. The directory structure of the package supplied reflects this family relationship. For use with Fortran applications, a set of Fortran/C interface routines, called FIDA, is also supplied. These are written in C, but assume that the user calling program and all user-supplied routines are in Fortran. Several examples problem programs are included, covering both serial and parallel cases, both small and large problem sizes, and both linear and nonlinear problems. The notes below provide the location of documentation, directions for the installation of the IDA package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/ida/ contains PDF files for the IDA User Guide [1] (ida_guide.pdf) and the IDA Examples [2] (ida_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_NOTES. For complete installation instructions see the "IDA Installation Procedure" chapter in the IDA User Guide. C. References ------------- [1] A. C. Hindmarsh, R. Serban, and A. Collier, "User Documentation for IDA v2.7.0," LLNL technical report UCRL-SM-208112, December 2011. [2] A. C. Hindmarsh, R. Serban, and A. Collier, "Example Programs for IDA v2.7.0," LLNL technical report UCRL-SM-208113, December 2011. [3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. [4] P. N. Brown, A. C. Hindmarsh, and L. R. Petzold, Using Krylov Methods in the Solution of Large-Scale Differential-Algebraic Systems, SIAM J. Sci. Comp., 15 (1994), pp. 1467-1488. [5] P. N. Brown, A. C. Hindmarsh, and L. R. Petzold, Consistent Initial Condition Calculation for Differential-Algebraic Systems, SIAM J. Sci. Comp., 19 (1998), pp. 1495-1512. D. Releases ----------- v. 2.6.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - Apr. 2005 v. 2.2.2 - Mar. 2005 v. 2.2.1 - Jan. 2005 v. 2.2.0 - Dec. 2004 v. 2.0 - Jul. 2002 (first SUNDIALS release) v. 1.0 - Feb. 1999 (date written) E. Revision History ------------------- v. 2.6.0 (May 2009) ---> v. 2.7.0 (Mar. 2012) --------------------------------------------- - Bug fixes - after the solver memory is created, it is set to zero before being filled. - to be consistent with IDAS, IDA uses the function IDAGetDky for optional output retrieval. - in each linear solver interface function, the linear solver memory is freed on an error return, and the **Free function now includes a line setting to NULL the main memory pointer to the linear solver memory. - a memory leak was fixed in two of the IDASp***Free functions. - in rootfinding functions IDARcheck1/IDARcheck2, when an exact zero is found, the array glo at the left endpoint is adjusted instead of shifting tlo. - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag, have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. - in the installation files, we modified the treatment of the macro SUNDIALS_USE_GENERIC_MATH, so that the parameter GENERIC_MATH_LIB is either defined (with no value) or not defined. v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (May 2009) --------------------------------------------- - New features - added a new linear solver module based on Blas + Lapack for both dense and banded matrices. - added optional input to specify which direction of zero-crossing is to be monitored while performing root-finding. The root information array iroots (returned by IDAGetRootInfo) also encodes the direction of zero-crossing. - Bug fixes - in the rootfinding algorithm, fixed a bug resulting in unnecessary evaluations of the root functions after reinitialization of the solver right after a return at a root. - Changes to user interface - renamed all **Malloc functions to **Init - tolerances are now specified through separate functions instead of the initialization functions IDAInit (former IDAMalloc) and IDAReInit. Depending on the tolerance type, one of 3 functions must be called before the first call to IDASolve. - removed function inputs from argument lists of all re-initialization functions. - all user-supplied functions now receive the same pointer to user data (instead of having different ones for the system evaluation, Jacobian information functions, etc.) - removed IDA_NORMAL_TSTOP and IDA_ONE_STEP_TSTOP named constants for the itask argument to IDASolve. A tstop value is now both set and activated through IDASetStopTime. Once tstop is reached it is also deactivated. A new value can be then specified by calling again IDASetStopTime. - common functionality for all direct linear solvers (dense, band, and the new Lapack solver) has been collected into the DLS (Direct Linear Solver) module, similar to the SPILS module for the iterative linear solvers. All optional input and output functions for these linear solver now have the prefix 'IDADls'. In addition, in order to include the new Lapack-based linear solver, all dimensions for these linear solvers (problem sizes, bandwidths, etc) are now of type 'int' (instead of 'long int'). - the initialization function for the preconditioner module IDABBDPRE was renamed IDABBDInit (from IDABBDAlloc) and it does not return a pointer to preconditioner memory anymore. Instead, all preconditioner module-related functions are now called with the main solver memory pointer as their first argument. When using the IDABBDPRE module, there is no need to use special functions to attach one of the SPILS linear solvers (instead use one of IDASpgmr, IDASpbcg, or IDASptfqmr). Moreover, there is no need to call a memory deallocation function for the preconditioner module. - minor changes to legality requirements for real optional inputs. - added the error return IDA_RTFUNC_FAIL. - changes corresponding to the above were made to the FCMIX interface. v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Oct. 2006) ---------------------------------------------- - Bug fixes - fixed wrong logic in final stopping tests: now we check if tout was reached before checking if tstop was reached. - added a roundoff factor when testing whether tn was just returned (in root finding) to prevent an unnecessary return. - fixed perturbation factor "underflow" issue in IDADenseDQJac and IDABandDQJac routines which are used to compute a difference quotient approximation to the system Jacobian (see IDA_P1). - Changes related to the build system - reorganized source tree: header files in ${srcdir}/include/ida, source files in ${srcdir}/src/ida, fcmix source files in ${srcdir}/src/ida/fcmix, examples in ${srcdir}/examples/ida - exported header files are installed unde ${includedir}/ida - Changes to user interface - all included header files use relative paths from ${includedir} - modified prototype and implementation of IDACalcIC (removed arguments t0, yy0, yp0). IDACalcIC will always correct the initial conditions passed through IDAMalloc (or IDAReInit) which were stored in the Nordsieck history array - added optional output IDAGetConsistentIC function (which can only be called before any IDASolve calls) to obtain the corrected initial conditions. v. 2.3.0 (Apr. 2005) ---> v. 2.4.0 (Mar. 2006) ---------------------------------------------- - New features - added IDASPBCG interface module to allow IDA to interface with the shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. - added IDASPTFQMR interface module to allow IDA to interface with the shared SPTFQMR (scaled preconditioned TFQMR) linear solver module. - added support for SPBCG and SPTFQMR to the IDABBDPRE preconditioner module. - added FIDA (Fortran interface to IDA). - added rootfinding feature in IDA; modified irobx example problem. - added support for interpreting failures in user-supplied functions. - Changes to user-callable functions - changed argument of IDAFree and IDABBDPrecFree to be the address of the respective memory block pointer, so that its NULL value is propagated back to the calling function. - added IDASPBCG module which defines appropriate IDSpbcg* functions to allow IDA to interface with the shared SPBCG linear solver module. - added IDABBDSpbcg function to IDABBDPRE module to support SPBCG linear solver module. - changed function type names (not the actual definition) to accomodate all the Scaled Preconditioned Iterative Linear Solvers now available: IDASpgmrJactimesVecFn -> IDASpilsJacTimesVecFn IDASpgmrPrecSetupFn -> IDASpilsPrecSetupFn IDASpgmrPrecSolveFn -> IDASpilsPrecSolveFn - changed some names for IDABBDPRE function outputs - added option for user-supplied error handler function. - added IDAGetEstLocalErrors() to return estimated local errors. - renamed all exported header files (except for ida.h, all header files have the prefix 'ida_') - changed naming scheme for IDA examples - Changes related to the build system - the main IDA header file (ida.h) is still exported to the install include directory. However, all other IDA header files are exported into an 'ida' subdirectory of the install include directory. - the IDA library now contains all shared object files (there is no separate libsundials_shared library anymore) v. 2.2.2 (Mar. 2005) ---> v. 2.3.0 (Apr. 2005) ---------------------------------------------- - New features - added option for user-provided error weight computation function (of type IDAEwtFn specified through IDASetEwtFn). - Changes to user interface - IDA now stores tolerances through values rather than references (to resolve potential scoping issues). - IDA now stores the constraints and id vectors (if defined) through values ratherthan references. - IDA now passes information back to the user through values rather than references (error weights) - IDAMalloc, IDAReInit, IDASetTolerances: added option itol=IDA_WF to indicate user-supplied function for computing the error weights; reltol is now declared as realtype. Note that it is now illegal to call IDASetTolerances before IDAMalloc. It is now legal to deallocate the absolute tolerance N_Vector right after its use. - IDAGetErrorWeights: the user is now responsible for allocating space for the N_Vector in which error weights will be copied. - IDACalcIC takes as additional arguments (t0,y0,yp0). As a consequence, it can be called at any time to correct a pair (y,y'). - Passing a value of 0 for the maximum step size or for maxsteps results in the solver using the corresponding default value (infinity, and 500, respectively) - Several optional input functions were combined into a single one (IDADenseSetJacFn and IDADenseSetJacData, IDABandSetJacFn and IDABandSetJacData, IDASpgmrSetPrecSolveFn and IDASpgmrSetPrecSetFn and IDASpgmrSetPrecData, IDASpgmrSetJacTimesVecFn and IDASpgmrSetJacData). v. 2.2.1 (Jan. 2005) ---> v. 2.2.2 (Mar. 2005) ---------------------------------------------- - Bug fixes - changed implicit type conversion to explicit in check_flag() routine in examples to avoid C++ compiler errors - Changes to documentation - added section with numerical values of all input and output solver constants - added more detailed notes on the type of absolute tolerances - fixed several typos and removed reference to inexistent function IDASetMinStep - added description of --with-mpi-flags option - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.2.0 (Dec. 2004) ---> v. 2.2.1 (Jan. 2005) ---------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. - Changes to documentation - fixed various mistakes and typos in the user guide and example program documents. v. 2.0 (Jul. 2002) ---> v. 2.2.0 (Dec. 2004) -------------------------------------------- - New features - added option to disable all error messages. - Bug fixes - in the solution of the nonlinear system, the correction for small constraint violation is to ee, not y. - besides delaying the order increase until the 2nd step, we now also delay doubling the step size, to avoid using information from times before t0. - Changes related to the NVECTOR module (see also the file sundials/shared/README) - removed machEnv, redefined table of vector operations (now contained in the N_Vector structure itself). - all IDA functions create new N_Vector variables through cloning, using an N_Vector passed by the user as a template. - Changes to type names and IDA constants - removed type 'integertype'; instead use int or long int, as appropriate. - restructured the list of return values from the various IDA functions. - changed all IDA constants (inputs and return values) to have the prefix 'IDA_' (e.g. IDA_SUCCESS). - renamed various function types to have the prefix 'IDA' (e.g. IDAResFn). - Changes to optional input/ouput - added IDASet* and IDAGet* functions for optional inputs/outputs, replacing the arrays iopt and ropt. - added new optional inputs (e.g. maximum number of Newton iterations, maximum number of convergence failures, etc). - added new function IDAGetSolution for dense output. - the value of the last return flag from any function within a linear solver module can be obtained as an optional output (e.g. IDADenseGetLastFlag). - Changes to user-callable functions - added new function IDACreate which initializes the IDA solver object and returns a pointer to the IDA memory block. - removed N (problem size) from all functions except the initialization functions for the direct linear solvers (IDADense and IDABand). - shortened argument lists of most IDA functions (the arguments that were dropped can now be specified through IDASet* functions). - removed reinitialization functions for band/dense/SPGMR linear solvers (same functionality can be obtained using IDA*Set* functions). - in IDABBDPRE, added a new function, IDABBDSpgmr to initialize the SPGMR linear solver with the BBD preconditioner. - function names changed in IDABBDPRE for uniformity. - Changes to user-supplied functions - removed N (probem dimension) from argument lists. - shortened argument lists for user dense/band/SPGMR Jacobian routines. - in IDASPGMR, shortened argument lists for user preconditioner functions. - in IDABBDPRE, added Nlocal, the local vector size, as an argument to IDABBDLocalFn and IDABBDCommFn. v. 1.0 (Feb. 1999) ---> v. 2.0 (Jul. 2002) ------------------------------------------ YYYYMMDD 19990212 DATE WRITTEN; initial internal release (incomplete). 19990514 IDABBDPRE preconditioner module added. 19990720 Initial condition calculation routines (IDACalcIC) added. 19991208 In IDABBDPRE, user routine argument lists changed. 19991217 Generic SPGMR module revised to correct scalings. 20000316 In parallel NVECTOR, comm arg. to PVecInitMPI is non-NULL. 20000808 Fixed bug in N_VMin. In IDACalcIC: added calculation of system index in CALC_YA_YDP_INIT case, added scaling of fnorm when index = 0. 20010110 Fixed two bugs in IDACalcIC and subordinate routines: (1) Set hh in IDACalcIC independent of icopt, for lsetup. (2) Set ypnew = yp0 in IDALineSrch in CALC_Y_INIT case. Corrected #define ncfl0 line in idaspgmr.c. 20011015 Fixed bug in IDAInterp (tn test). Fixed minor bugs in error messages (missing arguments etc.) 20011220 Default type 'integer' changed to 'long int' in llnltyps.h. 20020313 Modified to work with new NVECTOR abstraction. 20020626 Renamed types real, integer, boole as realtype, integertype, and booleantype, and renamed related constants. Renamed files llnlmath.*, llnltypes.h as sundialsmath.*, sundialstypes.h. 20020703 Added reinitialization routines for IDA, for each linear solver module, and for IDABBDPRE. sundials-2.5.0/src/nvec_par/0000755000175000017500000000000011767174700016620 5ustar sylvestresylvestresundials-2.5.0/src/nvec_par/CMakeLists.txt0000600000175000017500000000760011741421110021331 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:48 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the parallel NVECTOR library INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_PARALLEL\n\")") IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Add variable nvecparallel_SOURCES with the sources for the NVECPARALLEL lib SET(nvecparallel_SOURCES nvector_parallel.c) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the NVECPARALLEL library SET(shared_SOURCES sundials_math.c) ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable nvecparallel_HEADERS with the exported NVECPARALLEL header files SET(nvecparallel_HEADERS nvector_parallel.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecparallel_HEADERS) # Add source directory to include directories INCLUDE_DIRECTORIES(.) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Rules for building and installing the static library: # - Add the build target for the NVECPARALLEL library # - Set the library name and make sure it is not deleted # - Install the NVECSERIAL library IF(BUILD_STATIC_LIBS) ADD_LIBRARY(sundials_nvecparallel_static STATIC ${nvecparallel_SOURCES} ${shared_SOURCES}) SET_TARGET_PROPERTIES(sundials_nvecparallel_static PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) INSTALL(TARGETS sundials_nvecparallel_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Rules for building and installing the shared library: # - Add the build target for the NVECPARALLEL library # - Set the library name and make sure it is not deleted # - Set VERSION and SOVERSION for shared libraries # - Install the NVECSERIAL library IF(BUILD_SHARED_LIBS) ADD_LIBRARY(sundials_nvecparallel_shared SHARED ${nvecparallel_SOURCES} ${shared_SOURCES}) SET_TARGET_PROPERTIES(sundials_nvecparallel_shared PROPERTIES OUTPUT_NAME sundials_nvecparallel CLEAN_DIRECT_OUTPUT 1) SET_TARGET_PROPERTIES(sundials_nvecparallel_shared PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) INSTALL(TARGETS sundials_nvecparallel_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the NVECPARALLEL header files INSTALL(FILES ${nvecparallel_HEADERS} DESTINATION include/nvector) # If FCMIX is enabled and MPI-F77 works, build and install the FNVECPARALLEL library IF(FCMIX_ENABLE AND MPIF_FOUND) SET(fnvecparallel_SOURCES fnvector_parallel.c) IF(BUILD_STATIC_LIBS) ADD_LIBRARY(sundials_fnvecparallel_static STATIC ${fnvecparallel_SOURCES}) SET_TARGET_PROPERTIES(sundials_fnvecparallel_static PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) INSTALL(TARGETS sundials_fnvecparallel_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) IF(BUILD_SHARED_LIBS) ADD_LIBRARY(sundials_fnvecparallel_shared SHARED ${fnvecparallel_SOURCES}) SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared PROPERTIES OUTPUT_NAME sundials_fnvecparallel CLEAN_DIRECT_OUTPUT 1) SET_TARGET_PROPERTIES(sundials_fnvecparallel_shared PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) INSTALL(TARGETS sundials_fnvecparallel_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) ENDIF(FCMIX_ENABLE AND MPIF_FOUND) # MESSAGE(STATUS "Added NVECTOR_PARALLEL module") sundials-2.5.0/src/nvec_par/Makefile.in0000600000175000017500000001212311741421110020632 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.8 $ # $Date: 2007/01/29 17:36:28 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for parallel NVECTOR module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ CPPFLAGS = @CPPFLAGS@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ FCMIX_ENABLED = @FCMIX_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include -I$(MPI_INC_DIR) LIB_REVISION = 0:2:0 NVECPAR_LIB = libsundials_nvecparallel.la NVECPAR_LIB_FILES = nvector_parallel.lo FNVECPAR_LIB = libsundials_fnvecparallel.la FNVECPAR_LIB_FILES = fnvector_parallel.lo SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs all: $(NVECPAR_LIB) $(FNVECPAR_LIB) $(NVECPAR_LIB): shared $(NVECPAR_LIB_FILES) $(LIBTOOL) --mode=link $(MPICC) $(CFLAGS) $(MPI_FLAGS) -o $(NVECPAR_LIB) $(NVECPAR_LIB_FILES) $(SHARED_LIB_FILES) $(LDFLAGS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) -rpath $(libdir) -version-info $(LIB_REVISION) $(FNVECPAR_LIB): $(FNVECPAR_LIB_FILES) @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION}" ; \ ${LIBTOOL} --mode=link ${MPICC} ${CFLAGS} ${MPI_FLAGS} -o ${FNVECPAR_LIB} ${FNVECPAR_LIB_FILES} ${SHARED_LIB_FILES} ${LDFLAGS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBS} -rpath ${libdir} -version-info ${LIB_REVISION} ; \ fi install: $(NVECPAR_LIB) $(FNVECPAR_LIB) $(mkinstalldirs) $(includedir)/nvector $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECPAR_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_parallel.h $(includedir)/nvector/ @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir}" ; \ ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECPAR_LIB} ${libdir} ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECPAR_LIB) @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB}" ; \ ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECPAR_LIB} ; \ fi rm -f $(includedir)/nvector/nvector_parallel.h $(rminstalldirs) ${includedir}/nvector shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(NVECPAR_LIB) rm -f $(NVECPAR_LIB_FILES) rm -f nvector_parallel.o @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB}" ; \ ${LIBTOOL} --mode=clean rm -f ${FNVECPAR_LIB} ; \ echo "rm -f ${FNVECPAR_LIB_FILES}" ; \ rm -f ${FNVECPAR_LIB_FILES} ; \ echo "rm -f fnvector_parallel.o" ; \ rm -f fnvector_parallel.o ; \ fi distclean: clean rm -f Makefile nvector_parallel.lo: $(srcdir)/nvector_parallel.c $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_parallel.c fnvector_parallel.lo: $(srcdir)/fnvector_parallel.c @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c" ; \ ${LIBTOOL} --mode=compile ${MPICC} ${CPPFLAGS} ${MPI_FLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_parallel.c ; \ fi libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/nvec_par/fnvector_parallel.h0000600000175000017500000000550511741421110022446 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file (companion of nvector_parallel.c) contains the * definitions needed for the initialization of parallel * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_PARALLEL_H #define _FNVECTOR_PARALLEL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #if defined(SUNDIALS_F77_FUNC) #define FNV_INITP SUNDIALS_F77_FUNC(fnvinitp, FNVINITP) #else #define FNV_INITP fnvinitp_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITP_Q SUNDIALS_F77_FUNC_(fnvinitp_q, FNVINITP_Q) #define FNV_INITP_S SUNDIALS_F77_FUNC_(fnvinitp_s, FNVINITP_S) #define FNV_INITP_B SUNDIALS_F77_FUNC_(fnvinitp_b, FNVINITP_B) #define FNV_INITP_QB SUNDIALS_F77_FUNC_(fnvinitp_qb, FNVINITP_QB) #else #define FNV_INITP_Q fnvinitp_q_ #define FNV_INITP_S fnvinitp_s_ #define FNV_INITP_B fnvinitp_b_ #define FNV_INITP_QB fnvinitp_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; /* * Prototypes of exported functions * * FNV_INITP - initializes parallel vector operations for main problem * FNV_INITP_Q - initializes parallel vector operations for quadratures * FNV_INITP_S - initializes parallel vector operations for sensitivities * FNV_INITP_B - initializes parallel vector operations for adjoint problem * FNV_INITP_QB - initializes parallel vector operations for adjoint quadratures * */ #ifndef SUNDIALS_MPI_COMM_F2C #define MPI_Fint int #endif void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier); void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier); void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier); void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier); void FNV_INITP_S(int *code, int *Ns, int *ier); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/nvec_par/fnvector_parallel.c0000600000175000017500000001027711741421110022443 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:37 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file (companion of nvector_parallel.h) contains the * implementation needed for the Fortran initialization of parallel * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_parallel.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; #ifndef SUNDIALS_MPI_COMM_F2C #define MPI_Fint int #endif /* Fortran callable interfaces */ void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_KINSOL_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } sundials-2.5.0/src/nvec_par/README0000600000175000017500000001124011741421110017444 0ustar sylvestresylvestre NVECTOR_PARALLEL Release 2.5.0, March 2012 MPI parallel implementation of the NVECTOR module for SUNDIALS. NVECTOR_PARALLEL defines the content field of N_Vector to be a structure containing the global and local lengths of the vector, a pointer to the beginning of a contiguous local data array, an MPI communicator, and a boolean flag indicating ownership of the data array. NVECTOR_PARALLEL defines seven macros to provide access to the content of a parallel N_Vector, several constructors for variables of type N_Vector, a constructor for an array of variables of type N_Vector, and destructors for N_Vector and N_Vector array. NVECTOR_PARALLEL provides implementations for all vector operations defined by the generic NVECTOR module in the table of operations. A. Documentation ---------------- The MPI parallel NVECTOR implementation is fully described in the user documentation for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular solver is available in the solver's subdirectory under doc/. B. Installation --------------- For basic installation instructions see /sundials/INSTALL_NOTES. For complete installation instructions see any of the user guides. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.7.0," LLNL technical report UCRL-MA-208108, December 2011. [2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.7.0," LLNL technical report UCRL-MA-208111, December 2011. [3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.7.0," LLNL technical report UCRL-MA-208112, December 2011. [4] R. Serban and C. Petra, "User Documentation for IDAS v1.1.0," LLNL technical report UCRL-SM-234051, December 2011. [5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User Documentation for KINSOL v2.7.0," LLNL technical report UCRL-MA-208116, December 2011. D. Releases ----------- v. 2.5.0 - Mar. 2012 v. 2.4.0 - May 2009 v. 2.3.0 - Nov. 2006 v. 2.2.0 - Mar. 2006 v. 2.1.1 - May 2005 v. 2.1.0 - Apr. 2005 v. 2.0.2 - Mar. 2005 v. 2.0.1 - Jan. 2005 v. 2.0 - Dec. 2004 v. 1.0 - Jul. 2002 (first SUNDIALS release) E. Revision History ------------------- v. 2.4.0 (May 2009) ---> v. 2.5.0 (Mar. 2012) --------------------------------------------- - Bug fix: - consistently updated to using SUNDIALS_F77_FUNC in fcmix header files. v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (May 2009) --------------------------------------------- - none v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) ---------------------------------------------- - Changes related to the build system - reorganized source tree. Header files in ${srcdir}/include/nvector; sources in ${srcdir}/src/nvec_par - exported header files in ${includedir}/sundials v. 2.1.1 (May 2005) ---> v. 2.2.0 (Mar. 2006) --------------------------------------------- - none v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May 2005) --------------------------------------------- - Changes to user interface - added argument to initialization routines to allow user to specify a different MPI communicator - Changes to data structures - added N_VCloneEmpty to global vector operations table v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) ---------------------------------------------- - none v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) ---------------------------------------------- - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) -------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) ------------------------------------------ - Revised to correspond to new generic NVECTOR module (see sundials/shared/README). - Extended the list of user-callable functions provided by NVECTOR_PARALLEL outside the table of vector operations. - Revised parallel N_VMin and N_VMinQuotient to use BIG_REAL if local N is 0 or no quotients found. - Revised the F/C interface to use underscore flags for name mapping and to use precision flag from configure. - Revised F/C routine NVECTOR names for uniformity. sundials-2.5.0/src/nvec_par/nvector_parallel.c0000600000175000017500000005726011741421110022300 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:37 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a parallel MPI implementation * of the NVECTOR package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Error Message */ #define BAD_N1 "N_VNew_Parallel -- Sum of local vector lengths differs from " #define BAD_N2 "input global length. \n\n" #define BAD_N BAD_N1 BAD_N2 /* Private function prototypes */ /* Reduction operations add/max/min over the processor group */ static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm); /* z=x */ static void VCopy_Parallel(N_Vector x, N_Vector z); /* z=x+y */ static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z); /* z=-x */ static void VNeg_Parallel(N_Vector x, N_Vector z); /* z=c(x+y) */ static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); /* y <- ax+y */ static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y); /* x <- ax */ static void VScaleBy_Parallel(realtype a, N_Vector x); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Function to create a new parallel vector with empty data array */ N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, long int local_length, long int global_length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Parallel content; long int n, Nsum; /* Compute global length as sum of local lengths */ n = local_length; MPI_Allreduce(&n, &Nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm); if (Nsum != global_length) { printf(BAD_N); return(NULL); } /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvclone = N_VClone_Parallel; ops->nvcloneempty = N_VCloneEmpty_Parallel; ops->nvdestroy = N_VDestroy_Parallel; ops->nvspace = N_VSpace_Parallel; ops->nvgetarraypointer = N_VGetArrayPointer_Parallel; ops->nvsetarraypointer = N_VSetArrayPointer_Parallel; ops->nvlinearsum = N_VLinearSum_Parallel; ops->nvconst = N_VConst_Parallel; ops->nvprod = N_VProd_Parallel; ops->nvdiv = N_VDiv_Parallel; ops->nvscale = N_VScale_Parallel; ops->nvabs = N_VAbs_Parallel; ops->nvinv = N_VInv_Parallel; ops->nvaddconst = N_VAddConst_Parallel; ops->nvdotprod = N_VDotProd_Parallel; ops->nvmaxnorm = N_VMaxNorm_Parallel; ops->nvwrmsnormmask = N_VWrmsNormMask_Parallel; ops->nvwrmsnorm = N_VWrmsNorm_Parallel; ops->nvmin = N_VMin_Parallel; ops->nvwl2norm = N_VWL2Norm_Parallel; ops->nvl1norm = N_VL1Norm_Parallel; ops->nvcompare = N_VCompare_Parallel; ops->nvinvtest = N_VInvTest_Parallel; ops->nvconstrmask = N_VConstrMask_Parallel; ops->nvminquotient = N_VMinQuotient_Parallel; /* Create content */ content = NULL; content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = local_length; content->global_length = global_length; content->comm = comm; content->own_data = FALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------- * Function to create a new parallel vector */ N_Vector N_VNew_Parallel(MPI_Comm comm, long int local_length, long int global_length) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); /* Create data */ if(local_length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ NV_OWN_DATA_P(v) = TRUE; NV_DATA_P(v) = data; } return(v); } /* ---------------------------------------------------------------- * Function to create a parallel N_Vector with user data component */ N_Vector N_VMake_Parallel(MPI_Comm comm, long int local_length, long int global_length, realtype *v_data) { N_Vector v; v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); if (local_length > 0) { /* Attach data */ NV_OWN_DATA_P(v) = FALSE; NV_DATA_P(v) = v_data; } return(v); } /* ---------------------------------------------------------------- * Function to create an array of new parallel vectors. */ N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Parallel(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Parallel(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to create an array of new parallel vectors with empty * (NULL) data array. */ N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Parallel(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Parallel(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Parallel */ void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Parallel(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------- * Function to print a parallel vector */ void N_VPrint_Parallel(N_Vector x) { long int i, N; realtype *xd; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%lg\n", xd[i]); #else printf("%g\n", xd[i]); #endif } printf("\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Parallel(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Parallel content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* Create content */ content = NULL; content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = NV_LOCLENGTH_P(w); content->global_length = NV_GLOBLENGTH_P(w); content->comm = NV_COMM_P(w); content->own_data = FALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VClone_Parallel(N_Vector w) { N_Vector v; realtype *data; long int local_length; v = NULL; v = N_VCloneEmpty_Parallel(w); if (v == NULL) return(NULL); local_length = NV_LOCLENGTH_P(w); /* Create data */ if(local_length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ NV_OWN_DATA_P(v) = TRUE; NV_DATA_P(v) = data; } return(v); } void N_VDestroy_Parallel(N_Vector v) { if ((NV_OWN_DATA_P(v) == TRUE) && (NV_DATA_P(v) != NULL)) { free(NV_DATA_P(v)); NV_DATA_P(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Parallel(N_Vector v, long int *lrw, long int *liw) { MPI_Comm comm; int npes; comm = NV_COMM_P(v); MPI_Comm_size(comm, &npes); *lrw = NV_GLOBLENGTH_P(v); *liw = 2*npes; return; } realtype *N_VGetArrayPointer_Parallel(N_Vector v) { return((realtype *) NV_DATA_P(v)); } void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v) { if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data; return; } void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { long int i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_Parallel(a, x, y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_Parallel(b, y, x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_Parallel(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_Parallel(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_Parallel(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_Parallel(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_Parallel(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_Parallel(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } void N_VConst_Parallel(realtype c, N_Vector z) { long int i, N; realtype *zd; zd = NULL; N = NV_LOCLENGTH_P(z); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c; return; } void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Parallel(c, x); return; } if (c == ONE) { VCopy_Parallel(x, z); } else if (c == -ONE) { VNeg_Parallel(x, z); } else { N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c*xd[i]; } return; } void N_VAbs_Parallel(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = ABS(xd[i]); return; } void N_VInv_Parallel(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]+b; return; } realtype N_VDotProd_Parallel(N_Vector x, N_Vector y) { long int i, N; realtype sum, *xd, *yd, gsum; MPI_Comm comm; sum = ZERO; xd = yd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); comm = NV_COMM_P(x); for (i = 0; i < N; i++) sum += xd[i]*yd[i]; gsum = VAllReduce_Parallel(sum, 1, comm); return(gsum); } realtype N_VMaxNorm_Parallel(N_Vector x) { long int i, N; realtype max, *xd, gmax; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); comm = NV_COMM_P(x); max = ZERO; for (i = 0; i < N; i++) { if (ABS(xd[i]) > max) max = ABS(xd[i]); } gmax = VAllReduce_Parallel(max, 2, comm); return(gmax); } realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w) { long int i, N, N_global; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } gsum = VAllReduce_Parallel(sum, 1, comm); return(RSqrt(gsum/N_global)); } realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id) { long int i, N, N_global; realtype sum, prodi, *xd, *wd, *idd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = idd = NULL; N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); idd = NV_DATA_P(id); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { if (idd[i] > ZERO) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } } gsum = VAllReduce_Parallel(sum, 1, comm); return(RSqrt(gsum/N_global)); } realtype N_VMin_Parallel(N_Vector x) { long int i, N; realtype min, *xd, gmin; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_P(x); comm = NV_COMM_P(x); min = BIG_REAL; if (N > 0) { xd = NV_DATA_P(x); min = xd[0]; for (i = 1; i < N; i++) { if (xd[i] < min) min = xd[i]; } } gmin = VAllReduce_Parallel(min, 3, comm); return(gmin); } realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w) { long int i, N; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } gsum = VAllReduce_Parallel(sum, 1, comm); return(RSqrt(gsum)); } realtype N_VL1Norm_Parallel(N_Vector x) { long int i, N; realtype sum, gsum, *xd; MPI_Comm comm; sum = ZERO; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); comm = NV_COMM_P(x); for (i = 0; i= c) ? ONE : ZERO; } return; } booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd, val, gval; MPI_Comm comm; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); comm = NV_COMM_P(x); val = ONE; for (i = 0; i < N; i++) { if (xd[i] == ZERO) val = ZERO; else zd[i] = ONE/xd[i]; } gval = VAllReduce_Parallel(val, 3, comm); if (gval == ZERO) return(FALSE); else return(TRUE); } booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m) { long int i, N; realtype temp; realtype *cd, *xd, *md; MPI_Comm comm; cd = xd = md = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); cd = NV_DATA_P(c); md = NV_DATA_P(m); comm = NV_COMM_P(x); temp = ONE; for (i = 0; i < N; i++) { md[i] = ZERO; if (cd[i] == ZERO) continue; if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { if (xd[i]*cd[i] <= ZERO) { temp = ZERO; md[i] = ONE; } continue; } if (cd[i] > HALF || cd[i] < -HALF) { if (xd[i]*cd[i] < ZERO ) { temp = ZERO; md[i] = ONE; } } } temp = VAllReduce_Parallel(temp, 3, comm); if (temp == ONE) return(TRUE); else return(FALSE); } realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) { booleantype notEvenOnce; long int i, N; realtype *nd, *dd, min; MPI_Comm comm; nd = dd = NULL; N = NV_LOCLENGTH_P(num); nd = NV_DATA_P(num); dd = NV_DATA_P(denom); comm = NV_COMM_P(num); notEvenOnce = TRUE; min = BIG_REAL; for (i = 0; i < N; i++) { if (dd[i] == ZERO) continue; else { if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); else { min = nd[i]/dd[i]; notEvenOnce = FALSE; } } } return(VAllReduce_Parallel(min, 3, comm)); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ static realtype VAllReduce_Parallel(realtype d, int op, MPI_Comm comm) { /* * This function does a global reduction. The operation is * sum if op = 1, * max if op = 2, * min if op = 3. * The operation is over all processors in the communicator */ realtype out; switch (op) { case 1: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); break; case 2: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MAX, comm); break; case 3: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MIN, comm); break; default: break; } return(out); } static void VCopy_Parallel(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]; return; } static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]+yd[i]; return; } static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]-yd[i]; return; } static void VNeg_Parallel(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = -xd[i]; return; } static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c*(xd[i]+yd[i]); return; } static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c*(xd[i]-yd[i]); return; } static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+yd[i]; return; } static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])-yd[i]; return; } static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y) { long int i, N; realtype *xd, *yd; xd = yd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); if (a == ONE) { for (i = 0; i < N; i++) yd[i] += xd[i]; return; } if (a == -ONE) { for (i = 0; i < N; i++) yd[i] -= xd[i]; return; } for (i = 0; i < N; i++) yd[i] += a*xd[i]; return; } static void VScaleBy_Parallel(realtype a, N_Vector x) { long int i, N; realtype *xd; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); for (i = 0; i < N; i++) xd[i] *= a; return; } sundials-2.5.0/src/cvodes/0000755000175000017500000000000011767174700016306 5ustar sylvestresylvestresundials-2.5.0/src/cvodes/cvodes_band.c0000600000175000017500000003175511741421150020706 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.16 $ * $Date: 2011/03/23 22:58:46 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSBAND linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvodes_direct_impl.h" #include "cvodes_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* CVSBAND linit, lsetup, lsolve, and lfree routines */ static int cvBandInit(CVodeMem cv_mem); static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void cvBandFree(CVodeMem cv_mem); /* CVSBAND lfreeB function */ static void cvBandFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define nfe (cv_mem->cv_nfe) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define jacDQ (cvdls_mem->d_jacDQ) #define jac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define mu (cvdls_mem->d_mu) #define ml (cvdls_mem->d_ml) #define smu (cvdls_mem->d_smu) #define lpivots (cvdls_mem->d_lpivots) #define savedJ (cvdls_mem->d_savedJ) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ----------------------------------------------------------------- * CVBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. CVBand first calls * the existing lfree routine if this is not NULL. It then sets the * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) * to be cvBandInit, cvBandSetup, cvBandSolve, and cvBandFree, * respectively. It allocates memory for a structure of type * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to be * TRUE, b_mu to be mupper, b_ml to be mlower, and the b_jac field to be * CVBandDQJac. * Finally, it allocates memory for M, savedJ, and lpivots. The CVBand * return value is SUCCESS = 0, LMEM_FAIL = -1, or LIN_ILL_INPUT = -2. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVBand(void *cvode_mem, long int N, long int mupper, long int mlower) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSBAND", "CVBand", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvBandInit; lsetup = cvBandSetup; lsolve = cvBandSolve; lfree = cvBandFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Initialize Jacobian-related data */ jacDQ = TRUE; jac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = N; /* Load half-bandwiths in cvdls_mem */ ml = mlower; mu = mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBand", MSGD_BAD_SIZES); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(N-1, mu + ml); /* Allocate memory for M, savedJ, and pivot arrays */ M = NULL; M = NewBandMat(N, mu, ml, smu); if (M == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NULL; savedJ = NewBandMat(N, mu, ml, mu); if (savedJ == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBand", MSGD_MEM_FAIL); DestroyMat(M); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * cvBandInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the band * linear solver. * ----------------------------------------------------------------- */ static int cvBandInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { jac = cvDlsBandDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandSetup * ----------------------------------------------------------------- * This routine does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the band LU * factorization routine. * ----------------------------------------------------------------- */ static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { CVDlsMem cvdls_mem; booleantype jbad, jok; realtype dgamma; int retval; long int ier; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, M, mu, ml); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, mu, ml, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSBAND", "cvBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } BandCopy(M, savedJ, mu, ml); } /* Scale and add I to get M = I - gamma*J */ BandScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = BandGBTRF(M, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) { last_flag = ier; return(1); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the band linear solver * by calling the band backsolve routine. The return value is 0. * ----------------------------------------------------------------- */ static int cvBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { CVDlsMem cvdls_mem; realtype *bd; cvdls_mem = (CVDlsMem) lmem; bd = N_VGetArrayPointer(b); BandGBTRS(M, lpivots, bd); /* If CV_BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { N_VScale(TWO/(ONE + gamrat), b, b); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvBandFree * ----------------------------------------------------------------- * This routine frees memory specific to the band linear solver. * ----------------------------------------------------------------- */ static void cvBandFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyMat(savedJ); DestroyArray(lpivots); free(cvdls_mem); cv_mem->cv_lmem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVBandB is a wrapper around CVBand. It attaches the CVSBAND linear solver * to the backward problem memory block. */ int CVBandB(void *cvode_mem, int which, long int nB, long int mupperB, long int mlowerB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVDlsMemB cvdlsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSBAND", "CVBandB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSBAND", "CVBandB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSBAND", "CVBandB", MSGCV_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVDlsMemRecB */ cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); if (cvdlsB_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSBAND", "CVBandB", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* set matrix type */ cvdlsB_mem->d_typeB = SUNDIALS_BAND; /* initialize Jacobian function */ cvdlsB_mem->d_bjacB = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvdlsB_mem; cvB_mem->cv_lfree = cvBandFreeB; flag = CVBand(cvodeB_mem, nB, mupperB, mlowerB); if (flag != CVDLS_SUCCESS) { free(cvdlsB_mem); cvdlsB_mem = NULL; } return(flag); } /* * cvBandFreeB frees the memory associated with the CVSBAND linear * solver for backward integration. */ static void cvBandFreeB(CVodeBMem cvB_mem) { CVDlsMemB cvdlsB_mem; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); free(cvdlsB_mem); } sundials-2.5.0/src/cvodes/cvodea_io.c0000600000175000017500000004423111741421150020360 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2010/12/01 22:33:22 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the adjoint module in the CVODES solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "cvodes_impl.h" #include /* * ================================================================= * CVODEA PRIVATE CONSTANTS * ================================================================= */ #define ONE RCONST(1.0) /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Readibility Constants * ----------------------------------------------------------------- */ #define IMtype (ca_mem->ca_IMtype) #define ckpntData (ca_mem->ca_ckpntData) #define nbckpbs (ca_mem->ca_nbckpbs) #define t0_ (ck_mem->ck_t0) #define t1_ (ck_mem->ck_t1) #define nst_ (ck_mem->ck_nst) #define q_ (ck_mem->ck_q) #define h_ (ck_mem->ck_h) #define next_ (ck_mem->ck_next) /* * ----------------------------------------------------------------- * Optional input functions for ASA * ----------------------------------------------------------------- */ int CVodeSetAdjNoSensi(void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; ca_mem->ca_IMstoreSensi = FALSE; return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Optional input functions for backward integration * ----------------------------------------------------------------- */ int CVodeSetIterTypeB(void *cvode_mem, int which, int iterB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetIterTypeB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetIterTypeB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetIterTypeB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetIterType(cvodeB_mem, iterB); return(flag); } int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetUserDataB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvB_mem->cv_user_data = user_dataB; return(CV_SUCCESS); } int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxOrdB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxOrd(cvodeB_mem, maxordB); return(flag); } int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxNumSteps(cvodeB_mem, mxstepsB); return(flag); } int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetStabLimDetB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetStabLimDet(cvodeB_mem, stldetB); return(flag); } int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetInitStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetInitStep(cvodeB_mem, hinB); return(flag); } int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMinStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMinStep(cvodeB_mem, hminB); return(flag); } int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxStep(cvodeB_mem, hmaxB); return(flag); } /* * CVodeSetQuad*B * * Wrappers for the backward phase around the corresponding * CVODES quadrature optional input functions */ int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetQuadErrConB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetQuadErrCon(cvodeB_mem, errconQB); return(flag); } /* * ----------------------------------------------------------------- * Optional output functions for backward integration * ----------------------------------------------------------------- */ /* * CVodeGetAdjCVodeBmem * * This function returns a (void *) pointer to the CVODES * memory allocated for the backward problem. This pointer can * then be used to call any of the CVodeGet* CVODES routines to * extract optional output for the backward integration phase. */ void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_MEM); return(NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_ADJ); return(NULL); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_BAD_WHICH); return(NULL); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); return(cvodeB_mem); } /* * CVodeGetAdjCheckPointsInfo * * This routine loads an array of nckpnts structures of type CVadjCheckPointRec. * The user must allocate space for ckpnt. */ int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt) { CVodeMem cv_mem; CVadjMem ca_mem; CkpntMem ck_mem; int i; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; ck_mem = ca_mem->ck_mem; i = 0; while (ck_mem != NULL) { ckpnt[i].my_addr = (void *) ck_mem; ckpnt[i].next_addr = (void *) next_; ckpnt[i].t0 = t0_; ckpnt[i].t1 = t1_; ckpnt[i].nstep = nst_; ckpnt[i].order = q_; ckpnt[i].step = h_; ck_mem = next_; i++; } return(CV_SUCCESS); } /* * CVodeGetAdjDataPointHermite * * This routine returns the solution stored in the data structure * at the 'which' data point. Cubic Hermite interpolation. */ int CVodeGetAdjDataPointHermite(void *cvode_mem, int which, realtype *t, N_Vector y, N_Vector yd) { CVodeMem cv_mem; CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; if (IMtype != CV_HERMITE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointHermite", MSGCV_WRONG_INTERP); return(CV_ILL_INPUT); } *t = dt_mem[which]->t; content = (HermiteDataMem) (dt_mem[which]->content); if (y != NULL) N_VScale(ONE, content->y, y); if (yd != NULL) N_VScale(ONE, content->yd, yd); return(CV_SUCCESS); } /* * CVodeGetAdjDataPointPolynomial * * This routine returns the solution stored in the data structure * at the 'which' data point. Polynomial interpolation. */ int CVodeGetAdjDataPointPolynomial(void *cvode_mem, int which, realtype *t, int *order, N_Vector y) { CVodeMem cv_mem; CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; if (IMtype != CV_POLYNOMIAL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointPolynomial", MSGCV_WRONG_INTERP); return(CV_ILL_INPUT); } *t = dt_mem[which]->t; content = (PolynomialDataMem) (dt_mem[which]->content); if (y != NULL) N_VScale(ONE, content->y, y); *order = content->order; return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * UNDOCUMENTED development user-callable functions * ----------------------------------------------------------------- */ /* * CVodeGetAdjCurrentCheckPoint * * Returns the address of the 'active' check point. */ int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr) { CVodeMem cv_mem; CVadjMem ca_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; *addr = (void *) ckpntData; return(CV_SUCCESS); } sundials-2.5.0/src/cvodes/cvodes_spils.c0000600000175000017500000010005111741421150021116 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.12 $ * $Date: 2011/06/23 00:31:01 $ * ----------------------------------------------------------------- * Programmer(s):Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPILS linear solvers. * * Part II contains wrappers for using the CVODES iterative linear * solvers on adjoint (backward) problems. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include "cvodes_spils_impl.h" /* Private constants */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define ONE RCONST(1.0) /* Algorithmic constants */ #define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ /* * cvSpilsPrecSetupBWrapper has type CVSpilsPrecSetupFn * It wraps around the user-provided function of type CVSpilsPrecSetupFnB */ static int cvSpilsPrecSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * cvSpilsPrecSolveBWrapper has type CVSpilsPrecSolveFn * It wraps around the user-provided function of type CVSpilsPrecSolveFnB */ static int cvSpilsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem, N_Vector tmpB); /* * cvSpilsJacTimesVecBWrapper has type CVSpilsJacTimesVecFn * It wraps around the user-provided function of type CVSpilsJacTimesVecFnB */ static int cvSpilsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) #define tq (cv_mem->cv_tq) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define nfe (cv_mem->cv_nfe) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define lmem (cv_mem->cv_lmem) #define ils_type (cvspils_mem->s_type) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT FUNCTIONS * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * CVSpilsSetPrecType * ----------------------------------------------------------------- */ int CVSpilsSetPrecType(void *cvode_mem, int pretype) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPrecType", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPrecType", MSGS_BAD_PRETYPE); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_pretype = pretype; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetGSType * ----------------------------------------------------------------- */ int CVSpilsSetGSType(void *cvode_mem, int gstype) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetGSType", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (ils_type != SPILS_SPGMR) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_LSTYPE); return(CVSPILS_ILL_INPUT); } /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSType", MSGS_BAD_GSTYPE); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_gstype = gstype; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : CVSpilsSetMaxl * ----------------------------------------------------------------- */ int CVSpilsSetMaxl(void *cvode_mem, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(NULL, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetMaxl", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (ils_type == SPILS_SPGMR) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetMaxl", MSGS_BAD_LSTYPE); return(CVSPILS_ILL_INPUT); } mxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; cvspils_mem->s_maxl = mxl; /* spbcg_mem->l_max = mxl; */ return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetEpsLin * ----------------------------------------------------------------- */ int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetEpsLin", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; /* Check for legal eplifac */ if(eplifac < ZERO) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetEpsLin", MSGS_BAD_EPLIN); return(CVSPILS_ILL_INPUT); } cvspils_mem->s_eplifac = (eplifac == ZERO) ? CVSPILS_EPLIN : eplifac; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetPrecSetupFn * ----------------------------------------------------------------- */ int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetPreconditioner", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; cvspils_mem->s_pset = pset; cvspils_mem->s_psolve = psolve; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsSetJacTimesVecFn * ----------------------------------------------------------------- */ int CVSpilsSetJacTimesVecFn(void *cvode_mem, CVSpilsJacTimesVecFn jtv) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFn", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; if (jtv != NULL) { jtimesDQ = FALSE; jtimes = jtv; } else { jtimesDQ = TRUE; } return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetWorkSpace * ----------------------------------------------------------------- */ int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int maxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetWorkSpace", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; switch(ils_type) { case SPILS_SPGMR: maxl = cvspils_mem->s_maxl; *lenrwLS = lrw1*(maxl + 5) + maxl*(maxl + 4) + 1; *leniwLS = liw1*(maxl + 5); break; case SPILS_SPBCG: *lenrwLS = lrw1 * 9; *leniwLS = liw1 * 9; break; case SPILS_SPTFQMR: *lenrwLS = lrw1*11; *leniwLS = liw1*11; break; } return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumPrecEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *npevals = npe; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumPrecSolves * ----------------------------------------------------------------- */ int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumPrecSolves", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *npsolves = nps; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumLinIters * ----------------------------------------------------------------- */ int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumLinIters", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nliters = nli; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumConvFails * ----------------------------------------------------------------- */ int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumConvFails", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nlcfails = ncfl; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumJtimesEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumJtimesEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *njvevals = njtimes; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetNumRhsEvals * ----------------------------------------------------------------- */ int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetNumRhsEvals", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *nfevalsLS = nfes; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetLastFlag * ----------------------------------------------------------------- */ int CVSpilsGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVSPILS", "CVSpilsGetLastFlag", MSGS_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) lmem; *flag = last_flag; return(CVSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * CVSpilsGetReturnFlagName * ----------------------------------------------------------------- */ char *CVSpilsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVSPILS_SUCCESS: sprintf(name,"CVSPILS_SUCCESS"); break; case CVSPILS_MEM_NULL: sprintf(name,"CVSPILS_MEM_NULL"); break; case CVSPILS_LMEM_NULL: sprintf(name,"CVSPILS_LMEM_NULL"); break; case CVSPILS_ILL_INPUT: sprintf(name,"CVSPILS_ILL_INPUT"); break; case CVSPILS_MEM_FAIL: sprintf(name,"CVSPILS_MEM_FAIL"); break; case CVSPILS_PMEM_NULL: sprintf(name,"CVSPILS_PMEM_NULL"); break; case CVSPILS_NO_ADJ: sprintf(name,"CVSPILS_NO_ADJ"); break; case CVSPILS_LMEMB_NULL: sprintf(name,"CVSPILS_LMEMB_NULL"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * CVSPILS private functions * ----------------------------------------------------------------- */ /* Additional readability Replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * CVSpilsAtimes * ----------------------------------------------------------------- * This routine generates the matrix-vector product z = Mv, where * M = I - gamma*J. The product J*v is obtained by calling the jtimes * routine. It is then scaled by -gamma and added to v to obtain M*v. * The return value is the same as the value returned by jtimes -- * 0 if successful, nonzero otherwise. * ----------------------------------------------------------------- */ int CVSpilsAtimes(void *cvode_mem, N_Vector v, N_Vector z) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int retval; cv_mem = (CVodeMem) cvode_mem; cvspils_mem = (CVSpilsMem) lmem; retval = jtimes(v, z, tn, ycur, fcur, j_data, ytemp); njtimes++; if (retval != 0) return(retval); N_VLinearSum(ONE, v, -gamma, z, z); return(0); } /* * ----------------------------------------------------------------- * CVSpilsPSolve * ----------------------------------------------------------------- * This routine interfaces between the generic Sp***Solve routine * (within the SPGMR, SPBCG, or SPTFQMR solver) and the * user's psolve routine. It passes to psolve all required state * information from cvode_mem. Its return value is the same as that * returned by psolve. Note that the generic SP*** solver guarantees * that CVSpilsPSolve will not be called in the case in which * preconditioning is not done. This is the only case in which the * user's psolve routine is allowed to be NULL. * ----------------------------------------------------------------- */ int CVSpilsPSolve(void *cvode_mem, N_Vector r, N_Vector z, int lr) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; int retval; cv_mem = (CVodeMem) cvode_mem; cvspils_mem = (CVSpilsMem)lmem; /* This call is counted in nps within the CVSp***Solve routine */ retval = psolve(tn, ycur, fcur, r, z, gamma, delta, lr, P_data, ytemp); return(retval); } /* * ----------------------------------------------------------------- * CVSpilsDQJtimes * ----------------------------------------------------------------- * This routine generates a difference quotient approximation to * the Jacobian times vector f_y(t,y) * v. The approximation is * Jv = vnrm[f(y + v/vnrm) - f(y)], where vnrm = (WRMS norm of v) is * input, i.e. the WRMS norm of v/vnrm is 1. * ----------------------------------------------------------------- */ int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *data, N_Vector work) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; realtype sig, siginv; int iter, retval; /* data is cvode_mem */ cv_mem = (CVodeMem) data; cvspils_mem = (CVSpilsMem) lmem; /* Initialize perturbation to 1/||v|| */ sig = ONE/N_VWrmsNorm(v, ewt); for (iter=0; iter 0) return(+1); /* Replace Jv by (Jv - fy)/sig */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, fy, Jv); return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Readability replacements */ #define ytmp (ca_mem->ca_ytmp) #define yStmp (ca_mem->ca_yStmp) #define IMget (ca_mem->ca_IMget) #define pset_B (cvspilsB_mem->s_psetB) #define psolve_B (cvspilsB_mem->s_psolveB) #define jtimes_B (cvspilsB_mem->s_jtimesB) /* * ----------------------------------------------------------------- * OPTIONAL INPUT and OUTPUT FUNCTIONS * ----------------------------------------------------------------- */ int CVSpilsSetPrecTypeB(void *cvode_mem, int which, int pretypeB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPrecTypeB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVSpilsSetPrecType(cvodeB_mem, pretypeB); return(flag); } int CVSpilsSetGSTypeB(void *cvode_mem, int which, int gstypeB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetGSTypeB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVSpilsSetGSType(cvodeB_mem,gstypeB); return(flag); } int CVSpilsSetEpsLinB(void *cvode_mem, int which, realtype eplifacB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetEpsLinB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVSpilsSetEpsLin(cvodeB_mem,eplifacB); return(flag); } int CVSpilsSetMaxlB(void *cvode_mem, int which, int maxlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetMaxlB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetMaxlB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetMaxlB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVSpilsSetMaxl(cvodeB_mem,maxlB); return(flag); } int CVSpilsSetPreconditionerB(void *cvode_mem, int which, CVSpilsPrecSetupFnB psetB, CVSpilsPrecSolveFnB psolveB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVSpilsMemB cvspilsB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetPreconsitionerB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); if (cvB_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEMB_NULL, "CVSPILS", "CVSpilsSetPreconditonerB", MSGS_LMEMB_NULL); return(CVSPILS_LMEMB_NULL); } cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); pset_B = psetB; psolve_B = psolveB; flag = CVSpilsSetPreconditioner(cvodeB_mem, cvSpilsPrecSetupBWrapper, cvSpilsPrecSolveBWrapper); return(flag); } int CVSpilsSetJacTimesVecFnB(void *cvode_mem, int which, CVSpilsJacTimesVecFnB jtvB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVSpilsMemB cvspilsB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); if (cvB_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEMB_NULL, "CVSPILS", "CVSpilsSetJacTimesVecFnB", MSGS_LMEMB_NULL); return(CVSPILS_LMEMB_NULL); } cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); jtimes_B = jtvB; if (jtvB != NULL) { flag = CVSpilsSetJacTimesVecFn(cvodeB_mem, cvSpilsJacTimesVecBWrapper); } else { flag = CVSpilsSetJacTimesVecFn(cvodeB_mem, NULL); } return(flag); } /* * ----------------------------------------------------------------- * CVSPILS private functions * ----------------------------------------------------------------- */ /* * cvSpilsPrecSetupBWrapper * * This routine interfaces to the CVSpilsPrecSetupFnB routine * provided by the user. */ static int cvSpilsPrecSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVSpilsMemB cvspilsB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsPrecSetupBWrapper", MSGS_BAD_TINTERP); return(-1); } /* Call user's adjoint precondB routine */ retval = pset_B(t, ytmp, yB, fyB, jokB, jcurPtrB, gammaB, cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B); return(retval); } /* * cvSpilsPrecSolveBWrapper * * This routine interfaces to the CVSpilsPrecSolveFnB routine * provided by the user. */ static int cvSpilsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem, N_Vector tmpB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVSpilsMemB cvspilsB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsPrecSolveBWrapper", MSGS_BAD_TINTERP); return(-1); } /* Call user's adjoint psolveB routine */ retval = psolve_B(t, ytmp, yB, fyB, rB, zB, gammaB, deltaB, lrB, cvB_mem->cv_user_data, tmpB); return(retval); } /* * cvSpilsJacTimesVecBWrapper * * This routine interfaces to the CVSpilsJacTimesVecFnB routine * provided by the user. */ static int cvSpilsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVSpilsMemB cvspilsB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSPILS", "cvSpilsJacTimesVecBWrapper", MSGS_BAD_TINTERP); return(-1); } /* Call user's adjoint jtimesB routine */ retval = jtimes_B(vB, JvB, t, ytmp, yB, fyB, cvB_mem->cv_user_data, tmpB); return(retval); } sundials-2.5.0/src/cvodes/cvodes_spbcgs.c0000600000175000017500000004102011741421150021245 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 22:58:46 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPBCG linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvodes_spils_impl.h" #include "cvodes_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPBCG linit, lsetup, lsolve, and lfree routines */ static int CVSpbcgInit(CVodeMem cv_mem); static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSpbcgFree(CVodeMem cv_mem); /* CVSPBCG lfreeB function */ static void CVSpbcgFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define errfp (cv_mem->cv_errfp) #define mnewt (cv_mem->cv_mnewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : CVSpbcg * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Spbcg linear solver module. CVSpbcg first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSpbcgInit, CVSpbcgSetup, CVSpbcgSolve, and CVSpbcgFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSpbcg allocates memory for ytemp and x, and calls * SpbcgMalloc to allocate memory for the Spbcg solver. * ----------------------------------------------------------------- */ int CVSpbcg(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcg", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSpbcgInit; lsetup = CVSpbcgSetup; lsolve = CVSpbcgSolve; lfree = CVSpbcgFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPBCG; /* Set Spbcg parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Spbcg parameters */ cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SpbcgMalloc to allocate workspace for Spbcg */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(mxl, vec_tmpl); if (spbcg_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *) spbcg_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : CVSpbcgInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Spbcg * linear solver. * ----------------------------------------------------------------- */ static int CVSpbcgInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; cvspils_mem = (CVSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { cvProcessError(cv_mem, -1, "CVSPBCG", "CVSpbcgInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } /* Set maxl in the SPBCG memory in case it was changed by the user */ spbcg_mem->l_max = maxl; last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : CVSpbcgSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Spbcg linear solver. * It makes a decision as to whether or not to signal for reevaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for reevaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSpbcgSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, SPBCG_PSET_FAIL_UNREC, "CVSPBCG", "CVSpbcgSetup", MSGS_PSET_FAILED); last_flag = SPBCG_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPBCG_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPBCG_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * Function : CVSpbcgSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SpbcgSolve * for the solution of the linear system Ax = b with the SPBCG method. * The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SpbcgSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SpbcgSolve. The success flag is * returned if SpbcgSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac * tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SpbcgSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SpbcgSolve and copy x to b */ retval = SpbcgSolve(spbcg_mem, cv_mem, x, b, pretype, delta, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPBCG_SUCCESS) ncfl++; /* Interpret return value from SpbcgSolve */ last_flag = retval; switch(retval) { case SPBCG_SUCCESS: return(0); break; case SPBCG_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPBCG_CONV_FAIL: return(1); break; case SPBCG_PSOLVE_FAIL_REC: return(1); break; case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_MEM_NULL: return(-1); break; case SPBCG_ATIMES_FAIL_UNREC: cvProcessError(cv_mem, SPBCG_ATIMES_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPBCG_PSOLVE_FAIL_UNREC: cvProcessError(cv_mem, SPBCG_PSOLVE_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : CVSpbcgFree * ----------------------------------------------------------------- * This routine frees memory specific to the Spbcg linear solver. * ----------------------------------------------------------------- */ static void CVSpbcgFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpbcgMem spbcg_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); spbcg_mem = (SpbcgMem) spils_mem; SpbcgFree(spbcg_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Additional readability replacements */ #define pset_B (cvspilsB_mem->s_psetB) #define psolve_B (cvspilsB_mem->s_psolveB) #define jtimes_B (cvspilsB_mem->s_jtimesB) #define P_data_B (cvspilsB_mem->s_P_dataB) /* * CVSpbcgB * * Wrapper for the backward phase */ int CVSpbcgB(void *cvode_mem, int which, int pretypeB, int maxlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVSpilsMemB cvspilsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcgB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPBCG", "CVSpbcgB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcgB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVSpilsMemRecB */ cvspilsB_mem = NULL; cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); if (cvspilsB_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcgB", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } pset_B = NULL; psolve_B = NULL; P_data_B = NULL; /* initialize Jacobian function */ jtimes_B = NULL; /* attach lmemB and lfree */ cvB_mem->cv_lmem = cvspilsB_mem; cvB_mem->cv_lfree = CVSpbcgFreeB; flag = CVSpbcg(cvodeB_mem, pretypeB, maxlB); if (flag != CVSPILS_SUCCESS) { free(cvspilsB_mem); cvspilsB_mem = NULL; } return(flag); } /* * CVSpbcgFreeB */ static void CVSpbcgFreeB(CVodeBMem cvB_mem) { CVSpilsMemB cvspilsB_mem; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); free(cvspilsB_mem); } sundials-2.5.0/src/cvodes/cvodes.c0000600000175000017500000073761711741421150017734 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.34 $ * $Date: 2012/03/06 21:58:49 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the main CVODES integrator * with sensitivity analysis capabilities. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * * Creation, allocation and re-initialization functions * * CVodeCreate * * CVodeInit * CVodeReInit * CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * * CVodeQuadInit * CVodeQuadReInit * CVodeQuadSStolerances * CVodeQuadSVtolerances * * CVodeSensInit * CVodeSensInit1 * CVodeSensReInit * CVodeSensSStolerances * CVodeSensSVtolerances * CVodeSensEEtolerances * * CVodeQuadSensInit * CVodeQuadSensReInit * * CVodeSensToggleOff * * CVodeRootInit * * Main solver function * CVode * * Interpolated output and extraction functions * CVodeGetDky * CVodeGetQuad * CVodeGetQuadDky * CVodeGetSens * CVodeGetSens1 * CVodeGetSensDky * CVodeGetSensDky1 * CVodeGetQuadSens * CVodeGetQuadSens1 * CVodeGetQuadSensDky * CVodeGetQuadSensDky1 * * Deallocation functions * CVodeFree * CVodeQuadFree * CVodeSensFree * CVodeQuadSensFree * * PRIVATE FUNCTIONS * ----------------- * * cvCheckNvector * * Memory allocation/deallocation * cvAllocVectors * cvFreeVectors * cvQuadAllocVectors * cvQuadFreeVectors * cvSensAllocVectors * cvSensFreeVectors * cvQuadSensAllocVectors * cvQuadSensFreeVectors * * Initial stepsize calculation * cvHin * cvUpperBoundH0 * cvYddNorm * * Initial setup * cvInitialSetup * cvEwtSet * cvEwtSetSS * cvEwtSetSV * cvQuadEwtSet * cvQuadEwtSetSS * cvQuadEwtSetSV * cvSensEwtSet * cvSensEwtSetEE * cvSensEwtSetSS * cvSensEwtSetSV * cvQuadSensEwtSet * cvQuadSensEwtSetEE * cvQuadSensEwtSetSS * cvQuadSensEwtSetSV * * Main cvStep function * cvStep * * Functions called at beginning of step * cvAdjustParams * cvAdjustOrder * cvAdjustAdams * cvAdjustBDF * cvIncreaseBDF * cvDecreaseBDF * cvRescale * cvPredict * cvSet * cvSetAdams * cvAdamsStart * cvAdamsFinish * cvAltSum * cvSetBDF * cvSetTqBDF * * Nonlinear solver functions * cvNls * cvNlsFunctional * cvNlsNewton * cvNewtonIteration * cvQuadNls * cvStgrNls * cvStgrNlsFunctional * cvStgrNlsNewton * cvStgrNewtonIteration * cvStgr1Nls * cvStgr1NlsFunctional * cvStgr1NlsNewton * cvStgr1NewtonIteration * cvQuadSensNls * cvHandleNFlag * cvRestore * * Error Test * cvDoErrorTest * * Functions called after a successful step * cvCompleteStep * cvPrepareNextStep * cvSetEta * cvComputeEtaqm1 * cvComputeEtaqp1 * cvChooseEta * * Function to handle failures * cvHandleFailure * * Functions for BDF Stability Limit Detection * cvBDFStab * cvSLdet * * Functions for rootfinding * cvRcheck1 * cvRcheck2 * cvRcheck3 * cvRootFind * * Functions for combined norms * cvQuadUpdateNorm * cvSensNorm * cvSensUpdateNorm * cvQuadSensNorm * cvQuadSensUpdateNorm * * Wrappers for sensitivity RHS * cvSensRhsWrapper * cvSensRhs1Wrapper * * Internal DQ approximations for sensitivity RHS * cvSensRhsInternalDQ * cvSensRhs1InternalDQ * cvQuadSensRhsDQ * * Error message handling functions * cvProcessError * cvErrHandler * * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include "cvodes_impl.h" #include #include /* * ================================================================= * MACRO DEFINITIONS * ================================================================= */ /* Macro: loop */ #define loop for(;;) /* * ================================================================= * CVODES PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define TINY RCONST(1.0e-10) #define TENTH RCONST(0.1) #define POINT2 RCONST(0.2) #define FOURTH RCONST(0.25) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define THREE RCONST(3.0) #define FOUR RCONST(4.0) #define FIVE RCONST(5.0) #define TWELVE RCONST(12.0) #define HUN RCONST(100.0) /* * ================================================================= * CVODES ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by cvStep * ---------------------------------------------------------- * * cvHin return values: * CV_SUCCESS, * CV_RHSFUNC_FAIL, CV_RPTD_RHSFUNC_ERR, * CV_QRHSFUNC_FAIL, CV_RPTD_QRHSFUNC_ERR, * CV_SRHSFUNC_FAIL, CV_RPTD_SRHSFUNC_ERR, * CV_TOO_CLOSE * * cvStep control constants: * DO_ERROR_TEST * PREDICT_AGAIN * * cvStep return values: * CV_SUCCESS, * CV_CONV_FAILURE, CV_ERR_FAILURE, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, * CV_RTFUNC_FAIL, * CV_RHSFUNC_FAIL, CV_QRHSFUNC_FAIL, CV_SRHSFUNC_FAIL, CV_QSRHSFUNC_FAIL, * CV_FIRST_RHSFUNC_ERR, CV_FIRST_QRHSFUNC_ERR, CV_FIRST_SRHSFUNC_ERR, CV_FIRST_QSRHSFUNC_ERR, * CV_UNREC_RHSFUNC_ERR, CV_UNREC_QRHSFUNC_ERR, CV_UNREC_SRHSFUNC_ERR, CV_UNREC_QSRHSFUNC_ERR, * CV_REPTD_RHSFUNC_ERR, CV_REPTD_QRHSFUNC_ERR, CV_REPTD_SRHSFUNC_ERR, CV_REPTD_QSRHSFUNC_ERR, * * cvNls input nflag values: * FIRST_CALL * PREV_CONV_FAIL * PREV_ERR_FAIL * * cvNls return values: * CV_SUCCESS, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, * CV_RHSFUNC_FAIL, CV_SRHSFUNC_FAIL, * CONV_FAIL, * RHSFUNC_RECVR, SRHSFUNC_RECVR * * cvNewtonIteration return values: * CV_SUCCESS, * CV_LSOLVE_FAIL, * CV_RHSFUNC_FAIL, CV_SRHSFUNC_FAIL, * CONV_FAIL, TRY_AGAIN * RHSFUNC_RECVR, SRHSFUNC_RECVR * */ #define DO_ERROR_TEST +2 #define PREDICT_AGAIN +3 #define CONV_FAIL +4 #define TRY_AGAIN +5 #define FIRST_CALL +6 #define PREV_CONV_FAIL +7 #define PREV_ERR_FAIL +8 #define RHSFUNC_RECVR +9 #define QRHSFUNC_RECVR +11 #define SRHSFUNC_RECVR +12 #define QSRHSFUNC_RECVR +13 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- * * cvRcheck1 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * cvRcheck2 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * CLOSERT, * RTFOUND * cvRcheck3 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * RTFOUND * cvRootFind return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * RTFOUND */ #define RTFOUND +1 #define CLOSERT +3 /* * Control constants for sensitivity DQ * ------------------------------------ */ #define CENTERED1 +1 #define CENTERED2 +2 #define FORWARD1 +3 #define FORWARD2 +4 /* * Control constants for type of sensitivity RHS * --------------------------------------------- */ #define CV_ONESENS 1 #define CV_ALLSENS 2 /* * Control constants for tolerances * -------------------------------- */ #define CV_NN 0 #define CV_SS 1 #define CV_SV 2 #define CV_WF 3 #define CV_EE 4 /* * Algorithmic constants * --------------------- * * CVodeGetDky and cvStep * * FUZZ_FACTOR fuzz factor used to estimate infinitesimal time intervals * * cvHin * * HLB_FACTOR factor for upper bound on initial step size * HUB_FACTOR factor for lower bound on initial step size * H_BIAS bias factor in selection of intial step size * MAX_ITERS maximum attempts to compute the initial step size * * CVodeCreate * * CORTES constant in nonlinear iteration convergence test * * cvStep * * THRESH if eta < THRESH reject a change in step size or order * ETAMX1 -+ * ETAMX2 | * ETAMX3 |-> bounds for eta (step size change) * ETAMXF | * ETAMIN | * ETACF -+ * ADDON safety factor in computing eta * BIAS1 -+ * BIAS2 |-> bias factors in eta selection * BIAS3 -+ * ONEPSM (1+epsilon) used in testing if the step size is below its bound * * SMALL_NST nst > SMALL_NST => use ETAMX3 * MXNCF max no. of convergence failures during one step try * MXNEF max no. of error test failures during one step try * MXNEF1 max no. of error test failures before forcing a reduction of order * SMALL_NEF if an error failure occurs and SMALL_NEF <= nef <= MXNEF1, then * reset eta = MIN(eta, ETAMXF) * LONG_WAIT number of steps to wait before considering an order change when * q==1 and MXNEF1 error test failures have occurred * * cvNls * * NLS_MAXCOR maximum no. of corrector iterations for the nonlinear solver * CRDOWN constant used in the estimation of the convergence rate (crate) * of the iterates for the nonlinear equation * DGMAX iter == CV_NEWTON, |gamma/gammap-1| > DGMAX => call lsetup * RDIV declare divergence if ratio del/delp > RDIV * MSBP max no. of steps between lsetup calls * */ #define FUZZ_FACTOR RCONST(100.0) #define HLB_FACTOR RCONST(100.0) #define HUB_FACTOR RCONST(0.1) #define H_BIAS HALF #define MAX_ITERS 4 #define CORTES RCONST(0.1) #define THRESH RCONST(1.5) #define ETAMX1 RCONST(10000.0) #define ETAMX2 RCONST(10.0) #define ETAMX3 RCONST(10.0) #define ETAMXF RCONST(0.2) #define ETAMIN RCONST(0.1) #define ETACF RCONST(0.25) #define ADDON RCONST(0.000001) #define BIAS1 RCONST(6.0) #define BIAS2 RCONST(6.0) #define BIAS3 RCONST(10.0) #define ONEPSM RCONST(1.000001) #define SMALL_NST 10 #define MXNCF 10 #define MXNEF 7 #define MXNEF1 3 #define SMALL_NEF 2 #define LONG_WAIT 10 #define NLS_MAXCOR 3 #define CRDOWN RCONST(0.3) #define DGMAX RCONST(0.3) #define RDIV TWO #define MSBP 20 /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype cvCheckNvector(N_Vector tmpl); /* Memory allocation/deallocation */ static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvFreeVectors(CVodeMem cv_mem); static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvQuadFreeVectors(CVodeMem cv_mem); static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvSensFreeVectors(CVodeMem cv_mem); static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvQuadSensFreeVectors(CVodeMem cv_mem); /* Initial stepsize calculation */ static int cvHin(CVodeMem cv_mem, realtype tout); static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist); static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm); /* Initial setup */ static int cvInitialSetup(CVodeMem cv_mem); static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetSS(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetSV(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvQuadSensEwtSet(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetEE(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetSS(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetSV(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); /* Main cvStep function */ static int cvStep(CVodeMem cv_mem); /* Function called at beginning of step */ static void cvAdjustParams(CVodeMem cv_mem); static void cvAdjustOrder(CVodeMem cv_mem, int deltaq); static void cvAdjustAdams(CVodeMem cv_mem, int deltaq); static void cvAdjustBDF(CVodeMem cv_mem, int deltaq); static void cvIncreaseBDF(CVodeMem cv_mem); static void cvDecreaseBDF(CVodeMem cv_mem); static void cvRescale(CVodeMem cv_mem); static void cvPredict(CVodeMem cv_mem); static void cvSet(CVodeMem cv_mem); static void cvSetAdams(CVodeMem cv_mem); static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]); static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum); static realtype cvAltSum(int iend, realtype a[], int k); static void cvSetBDF(CVodeMem cv_mem); static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv); /* Nonlinear solver functions */ static int cvNls(CVodeMem cv_mem, int nflag); static int cvNlsFunctional(CVodeMem cv_mem); static int cvNlsNewton(CVodeMem cv_mem, int nflag); static int cvNewtonIteration(CVodeMem cv_mem); static int cvQuadNls(CVodeMem cv_mem); static int cvStgrNls(CVodeMem cv_mem); static int cvStgrNlsFunctional(CVodeMem cv_mem); static int cvStgrNlsNewton(CVodeMem cv_mem); static int cvStgrNewtonIteration(CVodeMem cv_mem); static int cvStgr1Nls(CVodeMem cv_mem, int is); static int cvStgr1NlsFunctional(CVodeMem cv_mem, int is); static int cvStgr1NlsNewton(CVodeMem cv_mem, int is); static int cvStgr1NewtonIteration(CVodeMem cv_mem, int is); static int cvQuadSensNls(CVodeMem cv_mem); static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr, long int *ncfnPtr); static void cvRestore(CVodeMem cv_mem, realtype saved_t); /* Error Test */ static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, realtype acor_nrm, int *nefPtr, long int *netfPtr, realtype *dsmPtr); /* Function called after a successful step */ static void cvCompleteStep(CVodeMem cv_mem); static void cvPrepareNextStep(CVodeMem cv_mem, realtype dsm); static void cvSetEta(CVodeMem cv_mem); static realtype cvComputeEtaqm1(CVodeMem cv_mem); static realtype cvComputeEtaqp1(CVodeMem cv_mem); static void cvChooseEta(CVodeMem cv_mem); /* Function to handle failures */ static int cvHandleFailure(CVodeMem cv_mem,int flag); /* Functions for BDF Stability Limit Detection */ static void cvBDFStab(CVodeMem cv_mem); static int cvSLdet(CVodeMem cv_mem); /* Functions for rootfinding */ static int cvRcheck1(CVodeMem cv_mem); static int cvRcheck2(CVodeMem cv_mem); static int cvRcheck3(CVodeMem cv_mem); static int cvRootFind(CVodeMem cv_mem); /* Function for combined norms */ static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ); static realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS); static realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS); static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS); static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS); /* Internal sensitivity RHS DQ functions */ static int cvQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *cvode_mem, N_Vector tmp, N_Vector tmpQ); static int cvQuadSensRhs1InternalDQ(CVodeMem cv_mem, int is, realtype t, N_Vector y, N_Vector yS, N_Vector yQdot, N_Vector yQSdot, N_Vector tmp, N_Vector tmpQ); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation, allocation and re-initialization functions * ----------------------------------------------------------------- */ /* * CVodeCreate * * CVodeCreate creates an internal memory block for a problem to * be solved by CVODES. * If successful, CVodeCreate returns a pointer to the problem memory. * This pointer should be passed to CVodeInit. * If an initialization error occurs, CVodeCreate prints an error * message to standard err and returns NULL. */ void *CVodeCreate(int lmm, int iter) { int maxord; CVodeMem cv_mem; /* Test inputs */ if ((lmm != CV_ADAMS) && (lmm != CV_BDF)) { cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_BAD_LMM); return(NULL); } if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_BAD_ITER); return(NULL); } cv_mem = NULL; cv_mem = (CVodeMem) malloc(sizeof(struct CVodeMemRec)); if (cv_mem == NULL) { cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_CVMEM_FAIL); return(NULL); } /* Zero out cv_mem */ memset(cv_mem, 0, sizeof(struct CVodeMemRec)); maxord = (lmm == CV_ADAMS) ? ADAMS_Q_MAX : BDF_Q_MAX; /* copy input parameters into cv_mem */ cv_mem->cv_lmm = lmm; cv_mem->cv_iter = iter; /* Set uround */ cv_mem->cv_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ cv_mem->cv_f = NULL; cv_mem->cv_user_data = NULL; cv_mem->cv_itol = CV_NN; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = NULL; cv_mem->cv_e_data = NULL; cv_mem->cv_ehfun = cvErrHandler; cv_mem->cv_eh_data = cv_mem; cv_mem->cv_errfp = stderr; cv_mem->cv_qmax = maxord; cv_mem->cv_mxstep = MXSTEP_DEFAULT; cv_mem->cv_mxhnil = MXHNIL_DEFAULT; cv_mem->cv_sldeton = FALSE; cv_mem->cv_hin = ZERO; cv_mem->cv_hmin = HMIN_DEFAULT; cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; cv_mem->cv_tstopset = FALSE; cv_mem->cv_maxcor = NLS_MAXCOR; cv_mem->cv_maxnef = MXNEF; cv_mem->cv_maxncf = MXNCF; cv_mem->cv_nlscoef = CORTES; /* Initialize root finding variables */ cv_mem->cv_glo = NULL; cv_mem->cv_ghi = NULL; cv_mem->cv_grout = NULL; cv_mem->cv_iroots = NULL; cv_mem->cv_rootdir = NULL; cv_mem->cv_gfun = NULL; cv_mem->cv_nrtfn = 0; cv_mem->cv_gactive = NULL; cv_mem->cv_mxgnull = 1; /* Set default values for quad. optional inputs */ cv_mem->cv_quadr = FALSE; cv_mem->cv_fQ = NULL; cv_mem->cv_errconQ = FALSE; cv_mem->cv_itolQ = CV_NN; /* Set default values for sensi. optional inputs */ cv_mem->cv_sensi = FALSE; cv_mem->cv_fS_data = NULL; cv_mem->cv_fS = cvSensRhsInternalDQ; cv_mem->cv_fS1 = cvSensRhs1InternalDQ; cv_mem->cv_fSDQ = TRUE; cv_mem->cv_ifS = CV_ONESENS; cv_mem->cv_DQtype = CV_CENTERED; cv_mem->cv_DQrhomax = ZERO; cv_mem->cv_p = NULL; cv_mem->cv_pbar = NULL; cv_mem->cv_plist = NULL; cv_mem->cv_errconS = FALSE; cv_mem->cv_maxcorS = NLS_MAXCOR; cv_mem->cv_ncfS1 = NULL; cv_mem->cv_ncfnS1 = NULL; cv_mem->cv_nniS1 = NULL; cv_mem->cv_itolS = CV_NN; /* Set default values for quad. sensi. optional inputs */ cv_mem->cv_quadr_sensi = FALSE; cv_mem->cv_fQS = NULL; cv_mem->cv_fQS_data = NULL; cv_mem->cv_fQSDQ = TRUE; cv_mem->cv_errconQS = FALSE; cv_mem->cv_itolQS = CV_NN; /* Set default for ASA */ cv_mem->cv_adj = FALSE; cv_mem->cv_adj_mem = NULL; /* Set the saved values for qmax_alloc */ cv_mem->cv_qmax_alloc = maxord; cv_mem->cv_qmax_allocQ = maxord; cv_mem->cv_qmax_allocS = maxord; /* Initialize lrw and liw */ cv_mem->cv_lrw = 65 + 2*L_MAX + NUM_TESTS; cv_mem->cv_liw = 52; /* No mallocs have been done yet */ cv_mem->cv_VabstolMallocDone = FALSE; cv_mem->cv_MallocDone = FALSE; cv_mem->cv_VabstolQMallocDone = FALSE; cv_mem->cv_QuadMallocDone = FALSE; cv_mem->cv_VabstolSMallocDone = FALSE; cv_mem->cv_SabstolSMallocDone = FALSE; cv_mem->cv_SensMallocDone = FALSE; cv_mem->cv_VabstolQSMallocDone = FALSE; cv_mem->cv_SabstolQSMallocDone = FALSE; cv_mem->cv_QuadSensMallocDone = FALSE; cv_mem->cv_adjMallocDone = FALSE; /* Return pointer to CVODES memory block */ return((void *)cv_mem); } /*-----------------------------------------------------------------*/ #define iter (cv_mem->cv_iter) #define lmm (cv_mem->cv_lmm) #define lrw (cv_mem->cv_lrw) #define liw (cv_mem->cv_liw) /*-----------------------------------------------------------------*/ /* * CVodeInit * * CVodeInit allocates and initializes memory for a problem. All * problem inputs are checked for errors. If any error occurs during * initialization, it is reported to the file whose file pointer is * errfp and an error flag is returned. Otherwise, it returns CV_SUCCESS */ int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0) { CVodeMem cv_mem; booleantype nvectorOK, allocOK; long int lrw1, liw1; int i,k; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check for legal input parameters */ if (y0==NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } if (f == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_F); return(CV_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = cvCheckNvector(y0); if(!nvectorOK) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_BAD_NVECTOR); return(CV_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (y0->ops->nvspace != NULL) { N_VSpace(y0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } cv_mem->cv_lrw1 = lrw1; cv_mem->cv_liw1 = liw1; /* Allocate the vectors (using y0 as a template) */ allocOK = cvAllocVectors(cv_mem, y0); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* All error checking is complete at this point */ /* Copy the input parameters into CVODES state */ cv_mem->cv_f = f; cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Set the linear solver addresses to NULL. (We check != NULL later, in CVode, if using CV_NEWTON.) */ cv_mem->cv_linit = NULL; cv_mem->cv_lsetup = NULL; cv_mem->cv_lsolve = NULL; cv_mem->cv_lfree = NULL; cv_mem->cv_lmem = NULL; /* Set forceSetup to FALSE */ cv_mem->cv_forceSetup = FALSE; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ /* NOTE: We do this even if stab lim det was not turned on yet. This way, the user can turn it on at any time */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully initialized */ cv_mem->cv_MallocDone = TRUE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) /*-----------------------------------------------------------------*/ /* * CVodeReInit * * CVodeReInit re-initializes CVODES's memory for a problem, assuming * it has already been allocated in a prior CVodeInit call. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0) { CVodeMem cv_mem; int i,k; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeReInit", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for legal input parameters */ if (y0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeReInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } /* Copy the input parameters into CVODES state */ cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Set forceSetup to FALSE */ cv_mem->cv_forceSetup = FALSE; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully re-initialized */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to CVode. * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) * which will be called to set the error weight vector. */ int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSStolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (abstol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_reltol = reltol; cv_mem->cv_Sabstol = abstol; cv_mem->cv_itol = CV_SS; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = cvEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSVtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(cv_mem->cv_VabstolMallocDone) ) { cv_mem->cv_Vabstol = N_VClone(cv_mem->cv_ewt); lrw += lrw1; liw += liw1; cv_mem->cv_VabstolMallocDone = TRUE; } cv_mem->cv_reltol = reltol; N_VScale(ONE, abstol, cv_mem->cv_Vabstol); cv_mem->cv_itol = CV_SV; cv_mem->cv_user_efun = FALSE; cv_mem->cv_efun = cvEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeWFtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeWFtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } cv_mem->cv_itol = CV_WF; cv_mem->cv_user_efun = TRUE; cv_mem->cv_efun = efun; cv_mem->cv_e_data = NULL; /* will be set to user_data in InitialSetup */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadInit * * CVodeQuadInit allocates and initializes quadrature related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0) { CVodeMem cv_mem; booleantype allocOK; long int lrw1Q, liw1Q; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Set space requirements for one N_Vector */ N_VSpace(yQ0, &lrw1Q, &liw1Q); cv_mem->cv_lrw1Q = lrw1Q; cv_mem->cv_liw1Q = liw1Q; /* Allocate the vectors (using yQ0 as a template) */ allocOK = cvQuadAllocVectors(cv_mem, yQ0); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Initialize znQ[0] in the history array */ N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); /* Copy the input parameters into CVODES state */ cv_mem->cv_fQ = fQ; /* Initialize counters */ cv_mem->cv_nfQe = 0; cv_mem->cv_netfQ = 0; /* Quadrature integration turned ON */ cv_mem->cv_quadr = TRUE; cv_mem->cv_QuadMallocDone = TRUE; /* Quadrature initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define lrw1Q (cv_mem->cv_lrw1Q) #define liw1Q (cv_mem->cv_liw1Q) /*-----------------------------------------------------------------*/ /* * CVodeQuadReInit * * CVodeQuadReInit re-initializes CVODES's quadrature related memory * for a problem, assuming it has already been allocated in prior * calls to CVodeInit and CVodeQuadInit. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0) { CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadReInit", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Initialize znQ[0] in the history array */ N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); /* Initialize counters */ cv_mem->cv_nfQe = 0; cv_mem->cv_netfQ = 0; /* Quadrature integration turned ON */ cv_mem->cv_quadr = TRUE; /* Quadrature re-initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadSStolerances * CVodeQuadSVtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to * CVode IF error control on the quadrature variables is enabled * (see CVodeSetQuadErrCon). * * CVodeQuadSStolerances specifies scalar relative and absolute tolerances. * CVodeQuadSVtolerances specifies scalar relative tolerance and a vector * absolute toleranc (a potentially different absolute tolerance for each * vector component). */ int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_RELTOLQ); return(CV_ILL_INPUT); } if (abstolQ < 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_ABSTOLQ); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQ = CV_SS; cv_mem->cv_reltolQ = reltolQ; cv_mem->cv_SabstolQ = abstolQ; return(CV_SUCCESS); } int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_RELTOLQ); return(CV_ILL_INPUT); } if (abstolQ == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_NULL_ABSTOLQ); return(CV_ILL_INPUT); } if (N_VMin(abstolQ) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_ABSTOLQ); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQ = CV_SV; cv_mem->cv_reltolQ = reltolQ; if ( !(cv_mem->cv_VabstolQMallocDone) ) { cv_mem->cv_VabstolQ = N_VClone(cv_mem->cv_tempvQ); lrw += lrw1Q; liw += liw1Q; cv_mem->cv_VabstolQMallocDone = TRUE; } N_VScale(ONE, abstolQ, cv_mem->cv_VabstolQ); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define stgr1alloc (cv_mem->cv_stgr1alloc) #define nniS1 (cv_mem->cv_nniS1) #define ncfnS1 (cv_mem->cv_ncfnS1) #define ncfS1 (cv_mem->cv_ncfS1) /*-----------------------------------------------------------------*/ /* * CVodeSensInit * * CVodeSensInit allocates and initializes sensitivity related * memory for a problem (using a sensitivity RHS function of type * CVSensRhsFn). All problem specification inputs are checked for * errors. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensInit(void *cvode_mem, int Ns, int ism, CVSensRhsFn fS, N_Vector *yS0) { CVodeMem cv_mem; booleantype allocOK; int is; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if CVodeSensInit or CVodeSensInit1 was already called */ if (cv_mem->cv_SensMallocDone) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_SENSINIT_2); return(CV_ILL_INPUT); } /* Check if Ns is legal */ if (Ns<=0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_NS); return(CV_ILL_INPUT); } cv_mem->cv_Ns = Ns; /* Check if ism is compatible */ if (ism==CV_STAGGERED1) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM_IFS); return(CV_ILL_INPUT); } /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Store sensitivity RHS-related data */ cv_mem->cv_ifS = CV_ALLSENS; cv_mem->cv_fS1 = NULL; if (fS == NULL) { cv_mem->cv_fSDQ = TRUE; cv_mem->cv_fS = cvSensRhsInternalDQ; cv_mem->cv_fS_data = cvode_mem; } else { cv_mem->cv_fSDQ = FALSE; cv_mem->cv_fS = fS; cv_mem->cv_fS_data = cv_mem->cv_user_data; } /* No memory allocation for STAGGERED1 */ stgr1alloc = FALSE; /* Allocate the vectors (using yS0[0] as a template) */ allocOK = cvSensAllocVectors(cv_mem, yS0[0]); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_znS[0][is]); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; iscv_plist[is] = is; cv_mem->cv_pbar[is] = ONE; } /* Sensitivities will be computed */ cv_mem->cv_sensi = TRUE; cv_mem->cv_SensMallocDone = TRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /* * CVodeSensInit1 * * CVodeSensInit1 allocates and initializes sensitivity related * memory for a problem (using a sensitivity RHS function of type * CVSensRhs1Fn). All problem specification inputs are checked for * errors. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensInit1(void *cvode_mem, int Ns, int ism, CVSensRhs1Fn fS1, N_Vector *yS0) { CVodeMem cv_mem; booleantype allocOK; int is; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if CVodeSensInit or CVodeSensInit1 was already called */ if (cv_mem->cv_SensMallocDone) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_SENSINIT_2); return(CV_ILL_INPUT); } /* Check if Ns is legal */ if (Ns<=0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_NS); return(CV_ILL_INPUT); } cv_mem->cv_Ns = Ns; /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Store sensitivity RHS-related data */ cv_mem->cv_ifS = CV_ONESENS; cv_mem->cv_fS = NULL; if (fS1 == NULL) { cv_mem->cv_fSDQ = TRUE; cv_mem->cv_fS1 = cvSensRhs1InternalDQ; cv_mem->cv_fS_data = cvode_mem; } else { cv_mem->cv_fSDQ = FALSE; cv_mem->cv_fS1 = fS1; cv_mem->cv_fS_data = cv_mem->cv_user_data; } /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ if (ism == CV_STAGGERED1) { stgr1alloc = TRUE; ncfS1 = NULL; ncfS1 = (int*)malloc(Ns*sizeof(int)); ncfnS1 = NULL; ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); nniS1 = NULL; nniS1 = (long int*)malloc(Ns*sizeof(long int)); if ( (ncfS1 == NULL) || (ncfnS1 == NULL) || (nniS1 == NULL) ) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } else { stgr1alloc = FALSE; } /* Allocate the vectors (using yS0[0] as a template) */ allocOK = cvSensAllocVectors(cv_mem, yS0[0]); if (!allocOK) { if (stgr1alloc) { free(ncfS1); ncfS1 = NULL; free(ncfnS1); ncfnS1 = NULL; free(nniS1); nniS1 = NULL; } cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_znS[0][is]); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; if (ism==CV_STAGGERED1) for (is=0; iscv_plist[is] = is; cv_mem->cv_pbar[is] = ONE; } /* Sensitivities will be computed */ cv_mem->cv_sensi = TRUE; cv_mem->cv_SensMallocDone = TRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define Ns (cv_mem->cv_Ns) #define ifS (cv_mem->cv_ifS) /*-----------------------------------------------------------------*/ /* * CVodeSensReInit * * CVodeSensReInit re-initializes CVODES's sensitivity related memory * for a problem, assuming it has already been allocated in prior * calls to CVodeInit and CVodeSensInit/CVodeSensInit1. * All problem specification inputs are checked for errors. * The number of sensitivities Ns is assumed to be unchanged since * the previous call to CVodeSensInit. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0) { CVodeMem cv_mem; int is; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensReInit", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Check if ism is compatible */ if ((ifS==CV_ALLSENS) && (ism==CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM_IFS); return(CV_ILL_INPUT); } /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ if ( (ism==CV_STAGGERED1) && (stgr1alloc==FALSE) ) { stgr1alloc = TRUE; ncfS1 = NULL; ncfS1 = (int*)malloc(Ns*sizeof(int)); ncfnS1 = NULL; ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); nniS1 = NULL; nniS1 = (long int*)malloc(Ns*sizeof(long int)); if ( (ncfS1==NULL) || (ncfnS1==NULL) || (nniS1==NULL) ) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensReInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_znS[0][is]); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; if (ism==CV_STAGGERED1) for (is=0; iscv_sensi = TRUE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensSStolerances * CVodeSensSVtolerances * CVodeSensEEtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to CVode. * * CVodeSensSStolerances specifies scalar relative and absolute tolerances. * CVodeSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * CVodeEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. */ int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSStolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_BAD_RELTOLS); return(CV_ILL_INPUT); } if (abstolS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_NULL_ABSTOLS); return(CV_ILL_INPUT); } for (is=0; iscv_itolS = CV_SS; cv_mem->cv_reltolS = reltolS; if ( !(cv_mem->cv_SabstolSMallocDone) ) { cv_mem->cv_SabstolS = NULL; cv_mem->cv_SabstolS = (realtype *)malloc(Ns*sizeof(realtype)); lrw += Ns; cv_mem->cv_SabstolSMallocDone = TRUE; } for (is=0; iscv_SabstolS[is] = abstolS[is]; return(CV_SUCCESS); } int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } Ns = cv_mem->cv_Ns; /* Test user-supplied tolerances */ if (reltolS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_BAD_RELTOLS); return(CV_ILL_INPUT); } if (abstolS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLS); return(CV_ILL_INPUT); } for (is=0; iscv_itolS = CV_SV; cv_mem->cv_reltolS = reltolS; if ( !(cv_mem->cv_VabstolSMallocDone) ) { cv_mem->cv_VabstolS = N_VCloneVectorArray(Ns, cv_mem->cv_tempv); lrw += Ns*lrw1; liw += Ns*liw1; cv_mem->cv_VabstolSMallocDone = TRUE; } for (is=0; iscv_VabstolS[is]); return(CV_SUCCESS); } int CVodeSensEEtolerances(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } cv_mem->cv_itolS = CV_EE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadSensInit * */ int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0) { CVodeMem cv_mem; booleantype allocOK; int is; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity analysis is active */ if (!cv_mem->cv_sensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NO_SENSI); return(CV_ILL_INPUT); } /* Check if yQS0 is non-null */ if (yQS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NULL_YQS0); return(CV_ILL_INPUT); } /* Allocate the vectors (using yQS0[0] as a template) */ allocOK = cvQuadSensAllocVectors(cv_mem, yQS0[0]); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadSensInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Set fQS */ if (fQS == NULL) { cv_mem->cv_fQSDQ = TRUE; cv_mem->cv_fQS = cvQuadSensRhsInternalDQ; cv_mem->cv_fQS_data = cvode_mem; } else { cv_mem->cv_fQSDQ = FALSE; cv_mem->cv_fQS = fQS; cv_mem->cv_fS_data = cv_mem->cv_user_data; } /* Initialize znQS[0] in the history array */ for (is=0; iscv_znQS[0][is]); /* Initialize all sensitivity related counters */ cv_mem->cv_nfQSe = 0; cv_mem->cv_nfQeS = 0; cv_mem->cv_netfQS = 0; /* Quadrature sensitivities will be computed */ cv_mem->cv_quadr_sensi = TRUE; cv_mem->cv_QuadSensMallocDone = TRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /* * CVodeQuadSensReInit * */ int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0) { CVodeMem cv_mem; int is; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity analysis is active */ if (!cv_mem->cv_sensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Was quadrature sensitivity initialized? */ if (cv_mem->cv_QuadSensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } /* Check if yQS0 is non-null */ if (yQS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NULL_YQS0); return(CV_ILL_INPUT); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znQS[0] in the history array */ for (is=0; iscv_znQS[0][is]); /* Initialize all sensitivity related counters */ cv_mem->cv_nfQSe = 0; cv_mem->cv_nfQeS = 0; cv_mem->cv_netfQS = 0; /* Quadrature sensitivities will be computed */ cv_mem->cv_quadr_sensi = TRUE; /* Problem has been successfully re-initialized */ return(CV_SUCCESS); } /* * CVodeQuadSensSStolerances * CVodeQuadSensSVtolerances * CVodeQuadSensEEtolerances * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to CVode IF these variables are included in the error test. * * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of CVodeQuad**tolerances. */ int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSSensSStolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_BAD_RELTOLQS); return(CV_ILL_INPUT); } if (abstolQS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NULL_ABSTOLQS); return(CV_ILL_INPUT); } for (is=0; iscv_itolQS = CV_SS; cv_mem->cv_reltolQS = reltolQS; if ( !(cv_mem->cv_SabstolQSMallocDone) ) { cv_mem->cv_SabstolQS = NULL; cv_mem->cv_SabstolQS = (realtype *)malloc(Ns*sizeof(realtype)); lrw += Ns; cv_mem->cv_SabstolQSMallocDone = TRUE; } for (is=0; iscv_SabstolQS[is] = abstolQS[is]; return(CV_SUCCESS); } int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } Ns = cv_mem->cv_Ns; /* Test user-supplied tolerances */ if (reltolQS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_BAD_RELTOLQS); return(CV_ILL_INPUT); } if (abstolQS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLQS); return(CV_ILL_INPUT); } for (is=0; iscv_itolQS = CV_SV; cv_mem->cv_reltolQS = reltolQS; if ( !(cv_mem->cv_VabstolQSMallocDone) ) { cv_mem->cv_VabstolQS = N_VCloneVectorArray(Ns, cv_mem->cv_tempvQ); lrw += Ns*lrw1Q; liw += Ns*liw1Q; cv_mem->cv_VabstolQSMallocDone = TRUE; } for (is=0; iscv_VabstolQS[is]); return(CV_SUCCESS); } int CVodeQuadSensEEtolerances(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } cv_mem->cv_itolQS = CV_EE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensToggleOff * * CVodeSensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory. */ int CVodeSensToggleOff(void *cvode_mem) { CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensToggleOff", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Disable sensitivities */ cv_mem->cv_sensi = FALSE; cv_mem->cv_quadr_sensi = FALSE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ #define gfun (cv_mem->cv_gfun) #define glo (cv_mem->cv_glo) #define ghi (cv_mem->cv_ghi) #define grout (cv_mem->cv_grout) #define iroots (cv_mem->cv_iroots) #define rootdir (cv_mem->cv_rootdir) #define gactive (cv_mem->cv_gactive) /*-----------------------------------------------------------------*/ /* * CVodeRootInit * * CVodeRootInit initializes a rootfinding problem to be solved * during the integration of the ODE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is CV_SUCCESS = 0 if no errors * occurred, or a negative value otherwise. */ int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g) { CVodeMem cv_mem; int i, nrt; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeRootInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning CVodeRootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != cv_mem->cv_nrtfn) && (cv_mem->cv_nrtfn > 0)) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; lrw -= 3 * (cv_mem->cv_nrtfn); liw -= 3 * (cv_mem->cv_nrtfn); } /* If CVodeRootInit() was called with nrtfn == 0, then set cv_nrtfn to zero and cv_gfun to NULL before returning */ if (nrt == 0) { cv_mem->cv_nrtfn = nrt; gfun = NULL; return(CV_SUCCESS); } /* If rerunning CVodeRootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == cv_mem->cv_nrtfn) { if (g != gfun) { if (g == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; lrw -= 3*nrt; liw -= 3*nrt; cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else { gfun = g; return(CV_SUCCESS); } } else return(CV_SUCCESS); } /* Set variable values in CVode memory block */ cv_mem->cv_nrtfn = nrt; if (g == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else gfun = g; /* Allocate necessary memory and return */ glo = NULL; glo = (realtype *) malloc(nrt*sizeof(realtype)); if (glo == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } ghi = NULL; ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (ghi == NULL) { free(glo); glo = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } grout = NULL; grout = (realtype *) malloc(nrt*sizeof(realtype)); if (grout == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } iroots = NULL; iroots = (int *) malloc(nrt*sizeof(int)); if (iroots == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } rootdir = NULL; rootdir = (int *) malloc(nrt*sizeof(int)); if (rootdir == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } gactive = NULL; gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (gactive == NULL) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; icv_f) #define user_data (cv_mem->cv_user_data) #define efun (cv_mem->cv_efun) #define e_data (cv_mem->cv_e_data) #define qmax (cv_mem->cv_qmax) #define mxstep (cv_mem->cv_mxstep) #define mxhnil (cv_mem->cv_mxhnil) #define sldeton (cv_mem->cv_sldeton) #define hin (cv_mem->cv_hin) #define hmin (cv_mem->cv_hmin) #define hmax_inv (cv_mem->cv_hmax_inv) #define tstop (cv_mem->cv_tstop) #define tstopset (cv_mem->cv_tstopset) #define maxnef (cv_mem->cv_maxnef) #define maxncf (cv_mem->cv_maxncf) #define maxcor (cv_mem->cv_maxcor) #define nlscoef (cv_mem->cv_nlscoef) #define itol (cv_mem->cv_itol) #define reltol (cv_mem->cv_reltol) #define Sabstol (cv_mem->cv_Sabstol) #define Vabstol (cv_mem->cv_Vabstol) #define fQ (cv_mem->cv_fQ) #define errconQ (cv_mem->cv_errconQ) #define itolQ (cv_mem->cv_itolQ) #define reltolQ (cv_mem->cv_reltolQ) #define SabstolQ (cv_mem->cv_SabstolQ) #define VabstolQ (cv_mem->cv_VabstolQ) #define ism (cv_mem->cv_ism) #define fS (cv_mem->cv_fS) #define fS1 (cv_mem->cv_fS1) #define fS_data (cv_mem->cv_fS_data) #define fSDQ (cv_mem->cv_fSDQ) #define DQtype (cv_mem->cv_DQtype) #define DQrhomax (cv_mem->cv_DQrhomax) #define pbar (cv_mem->cv_pbar) #define errconS (cv_mem->cv_errconS) #define maxcorS (cv_mem->cv_maxcorS) #define itolS (cv_mem->cv_itolS) #define reltolS (cv_mem->cv_reltolS) #define SabstolS (cv_mem->cv_SabstolS) #define VabstolS (cv_mem->cv_VabstolS) #define p (cv_mem->cv_p) #define plist (cv_mem->cv_plist) #define fQS (cv_mem->cv_fQS) #define fQS_data (cv_mem->cv_fQS_data) #define fQSDQ (cv_mem->cv_fQSDQ) #define errconQS (cv_mem->cv_errconQS) #define itolQS (cv_mem->cv_itolQS) #define reltolQS (cv_mem->cv_reltolQS) #define SabstolQS (cv_mem->cv_SabstolQS) #define VabstolQS (cv_mem->cv_VabstolQS) #define uround (cv_mem->cv_uround) #define zn (cv_mem->cv_zn) #define ewt (cv_mem->cv_ewt) #define y (cv_mem->cv_y) #define acor (cv_mem->cv_acor) #define tempv (cv_mem->cv_tempv) #define ftemp (cv_mem->cv_ftemp) #define q (cv_mem->cv_q) #define qprime (cv_mem->cv_qprime) #define next_q (cv_mem->cv_next_q) #define qwait (cv_mem->cv_qwait) #define L (cv_mem->cv_L) #define h (cv_mem->cv_h) #define hprime (cv_mem->cv_hprime) #define next_h (cv_mem->cv_next_h) #define eta (cv_mem->cv_eta) #define etaqm1 (cv_mem->cv_etaqm1) #define etaq (cv_mem->cv_etaq) #define etaqp1 (cv_mem->cv_etaqp1) #define nscon (cv_mem->cv_nscon) #define hscale (cv_mem->cv_hscale) #define tn (cv_mem->cv_tn) #define tau (cv_mem->cv_tau) #define tq (cv_mem->cv_tq) #define l (cv_mem->cv_l) #define rl1 (cv_mem->cv_rl1) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define crate (cv_mem->cv_crate) #define acnrm (cv_mem->cv_acnrm) #define mnewt (cv_mem->cv_mnewt) #define etamax (cv_mem->cv_etamax) #define nst (cv_mem->cv_nst) #define nfe (cv_mem->cv_nfe) #define ncfn (cv_mem->cv_ncfn) #define netf (cv_mem->cv_netf) #define nni (cv_mem->cv_nni) #define nsetups (cv_mem->cv_nsetups) #define nhnil (cv_mem->cv_nhnil) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define qu (cv_mem->cv_qu) #define nstlp (cv_mem->cv_nstlp) #define h0u (cv_mem->cv_h0u) #define hu (cv_mem->cv_hu) #define saved_tq5 (cv_mem->cv_saved_tq5) #define indx_acor (cv_mem->cv_indx_acor) #define jcur (cv_mem->cv_jcur) #define tolsf (cv_mem->cv_tolsf) #define setupNonNull (cv_mem->cv_setupNonNull) #define forceSetup (cv_mem->cv_forceSetup) #define nor (cv_mem->cv_nor) #define ssdat (cv_mem->cv_ssdat) #define nrtfn (cv_mem->cv_nrtfn) #define tlo (cv_mem->cv_tlo) #define thi (cv_mem->cv_thi) #define tretlast (cv_mem->cv_tretlast) #define toutc (cv_mem->cv_toutc) #define trout (cv_mem->cv_trout) #define ttol (cv_mem->cv_ttol) #define taskc (cv_mem->cv_taskc) #define irfnd (cv_mem->cv_irfnd) #define nge (cv_mem->cv_nge) #define quadr (cv_mem->cv_quadr) #define znQ (cv_mem->cv_znQ) #define ewtQ (cv_mem->cv_ewtQ) #define acorQ (cv_mem->cv_acorQ) #define yQ (cv_mem->cv_yQ) #define tempvQ (cv_mem->cv_tempvQ) #define acnrmQ (cv_mem->cv_acnrmQ) #define nfQe (cv_mem->cv_nfQe) #define netfQ (cv_mem->cv_netfQ) #define QuadMallocDone (cv_mem->cv_QuadMallocDone) #define sensi (cv_mem->cv_sensi) #define znS (cv_mem->cv_znS) #define ewtS (cv_mem->cv_ewtS) #define acorS (cv_mem->cv_acorS) #define yS (cv_mem->cv_yS) #define tempvS (cv_mem->cv_tempvS) #define ftempS (cv_mem->cv_ftempS) #define crateS (cv_mem->cv_crateS) #define acnrmS (cv_mem->cv_acnrmS) #define nfSe (cv_mem->cv_nfSe) #define nfeS (cv_mem->cv_nfeS) #define nniS (cv_mem->cv_nniS) #define ncfnS (cv_mem->cv_ncfnS) #define netfS (cv_mem->cv_netfS) #define nsetupsS (cv_mem->cv_nsetupsS) #define stgr1alloc (cv_mem->cv_stgr1alloc) #define SensMallocDone (cv_mem->cv_SensMallocDone) #define quadr_sensi (cv_mem->cv_quadr_sensi) #define znQS (cv_mem->cv_znQS) #define ewtQS (cv_mem->cv_ewtQS) #define acorQS (cv_mem->cv_acorQS) #define yQS (cv_mem->cv_yQS) #define tempvQS (cv_mem->cv_tempvQS) #define ftempQ (cv_mem->cv_ftempQ) #define acnrmQS (cv_mem->cv_acnrmQS) #define nfQSe (cv_mem->cv_nfQSe) #define nfQeS (cv_mem->cv_nfQeS) #define netfQS (cv_mem->cv_netfQS) #define QuadSensMallocDone (cv_mem->cv_QuadSensMallocDone) /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * CVode * * This routine is the main driver of the CVODES package. * * It integrates over a time interval defined by the user, by calling * cvStep to do internal time steps. * * The first time that CVode is called for a successfully initialized * problem, it computes a tentative initial step size h. * * CVode supports two modes, specified by itask: CV_NORMAL, CV_ONE_STEP. * In the CV_NORMAL mode, the solver steps until it reaches or passes tout * and then interpolates to obtain y(tout). * In the CV_ONE_STEP mode, it takes one internal step and returns. */ int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask) { CVodeMem cv_mem; long int nstloc; int retval, hflag, kflag, istate, is, ir, ier, irfndp; realtype troundoff, tout_hin, rh, nrm; booleantype inactive_roots; /* * ------------------------------------- * 1. Check and process inputs * ------------------------------------- */ /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVode", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVode", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for yout != NULL */ if ((y = yout) == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_YOUT_NULL); return(CV_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_TRET_NULL); return(CV_ILL_INPUT); } /* Check for valid itask */ if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_ITASK); return(CV_ILL_INPUT); } if (itask == CV_NORMAL) toutc = tout; taskc = itask; /* * ---------------------------------------- * 2. Initializations performed only at * the first step (nst=0): * - initial setup * - initialize Nordsieck history array * - compute initial step size * - check for approach to tstop * - check for approach to a root * ---------------------------------------- */ if (nst == 0) { /* Check inputs for corectness */ ier = cvInitialSetup(cv_mem); if (ier!= CV_SUCCESS) return(ier); /* * Call f at (t0,y0), set zn[1] = y'(t0). * If computing any quadratures, call fQ at (t0,y0), set znQ[1] = yQ'(t0) * If computing sensitivities, call fS at (t0,y0,yS0), set znS[1][is] = yS'(t0), is=1,...,Ns. * If computing quadr. sensi., call fQS at (t0,y0,yS0), set znQS[1][is] = yQS'(t0), is=1,...,Ns. */ retval = f(tn, zn[0], zn[1], user_data); nfe++; if (retval < 0) { cvProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODES", "CVode", MSGCV_RHSFUNC_FAILED, tn); return(CV_RHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_RHSFUNC_ERR, "CVODES", "CVode", MSGCV_RHSFUNC_FIRST); return(CV_FIRST_RHSFUNC_ERR); } if (quadr) { retval = fQ(tn, zn[0], znQ[1], user_data); nfQe++; if (retval < 0) { cvProcessError(cv_mem, CV_QRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QRHSFUNC_FAILED, tn); return(CV_QRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_QRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QRHSFUNC_FIRST); return(CV_FIRST_QRHSFUNC_ERR); } } if (sensi) { retval = cvSensRhsWrapper(cv_mem, tn, zn[0], zn[1], znS[0], znS[1], tempv, ftemp); if (retval < 0) { cvProcessError(cv_mem, CV_SRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_SRHSFUNC_FAILED, tn); return(CV_SRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_SRHSFUNC_ERR, "CVODES", "CVode", MSGCV_SRHSFUNC_FIRST); return(CV_FIRST_SRHSFUNC_ERR); } } if (quadr_sensi) { retval = fQS(Ns, tn, zn[0], znS[0], znQ[1], znQS[1], fQS_data, tempv, tempvQ); nfQSe++; if (retval < 0) { cvProcessError(cv_mem, CV_QSRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QSRHSFUNC_FAILED, tn); return(CV_QSRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_QSRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QSRHSFUNC_FIRST); return(CV_FIRST_QSRHSFUNC_ERR); } } /* Set initial h (from H0 or cvHin). */ h = hin; if ( (h != ZERO) && ((tout-tn)*h < ZERO) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_H0); return(CV_ILL_INPUT); } if (h == ZERO) { tout_hin = tout; if ( tstopset && (tout-tn)*(tout-tstop) > 0 ) tout_hin = tstop; hflag = cvHin(cv_mem, tout_hin); if (hflag != CV_SUCCESS) { istate = cvHandleFailure(cv_mem, hflag); return(istate); } } rh = ABS(h)*hmax_inv; if (rh > ONE) h /= rh; if (ABS(h) < hmin) h *= hmin/ABS(h); /* Check for approach to tstop */ if (tstopset) { if ( (tstop - tn)*h < ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, tstop, tn); return(CV_ILL_INPUT); } if ( (tn + h - tstop)*h > ZERO ) h = (tstop - tn)*(ONE-FOUR*uround); } /* * Scale zn[1] by h. * If computing any quadratures, scale znQ[1] by h. * If computing sensitivities, scale znS[1][is] by h. * If computing quadrature sensitivities, scale znQS[1][is] by h. */ hscale = h; h0u = h; hprime = h; N_VScale(h, zn[1], zn[1]); if (quadr) N_VScale(h, znQ[1], znQ[1]); if (sensi) for (is=0; is 0) { retval = cvRcheck1(cv_mem); if (retval == CV_RTFUNC_FAIL) { cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck1", MSGCV_RTFUNC_FAILED, tn); return(CV_RTFUNC_FAIL); } } } /* end first call block */ /* * ------------------------------------------------------ * 3. At following steps, perform stop tests: * - check for root in last step * - check if we passed tstop * - check if we passed tout (NORMAL mode) * - check if current tn was returned (ONE_STEP mode) * - check if we are close to tstop * (adjust step size if needed) * ------------------------------------------------------- */ if (nst > 0) { /* Estimate an infinitesimal time interval to be used as a roundoff for time quantities (based on current time and step size) */ troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); /* First check for a root in the last step taken, other than the last root found, if any. If itask = CV_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (nrtfn > 0) { irfndp = irfnd; retval = cvRcheck2(cv_mem); if (retval == CLOSERT) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvRcheck2", MSGCV_CLOSE_ROOTS, tlo); return(CV_ILL_INPUT); } else if (retval == CV_RTFUNC_FAIL) { cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck2", MSGCV_RTFUNC_FAILED, tlo); return(CV_RTFUNC_FAIL); } else if (retval == RTFOUND) { tretlast = *tret = tlo; return(CV_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ if ( ABS(tn - tretlast) > troundoff ) { retval = cvRcheck3(cv_mem); if (retval == CV_SUCCESS) { /* no root found */ irfnd = 0; if ((irfndp == 1) && (itask == CV_ONE_STEP)) { tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); return(CV_SUCCESS); } } else if (retval == RTFOUND) { /* a new root was found */ irfnd = 1; tretlast = *tret = tlo; return(CV_ROOT_RETURN); } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, tlo); return(CV_RTFUNC_FAIL); } } } /* end of root stop check */ /* In CV_NORMAL mode, test if tout was reached */ if ( (itask == CV_NORMAL) && ((tn-tout)*h >= ZERO) ) { tretlast = *tret = tout; ier = CVodeGetDky(cv_mem, tout, 0, yout); if (ier != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TOUT, tout); return(CV_ILL_INPUT); } return(CV_SUCCESS); } /* In CV_ONE_STEP mode, test if tn was returned */ if ( itask == CV_ONE_STEP && ABS(tn - tretlast) > troundoff ) { tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); return(CV_SUCCESS); } /* Test for tn at tstop or near tstop */ if ( tstopset ) { if ( ABS(tn - tstop) <= troundoff ) { ier = CVodeGetDky(cv_mem, tstop, 0, yout); if (ier != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, tstop, tn); return(CV_ILL_INPUT); } tretlast = *tret = tstop; tstopset = FALSE; return(CV_TSTOP_RETURN); } /* If next step would overtake tstop, adjust stepsize */ if ( (tn + hprime - tstop)*h > ZERO ) { hprime = (tstop - tn)*(ONE-FOUR*uround); eta = hprime/h; } } } /* end stopping tests block at nst>0 */ /* * -------------------------------------------------- * 4. Looping point for internal steps * * 4.1. check for errors (too many steps, too much * accuracy requested, step size too small) * 4.2. take a new step (call cvStep) * 4.3. stop on error * 4.4. perform stop tests: * - check for root in last step * - check if tout was passed * - check if close to tstop * - check if in ONE_STEP mode (must return) * -------------------------------------------------- */ nstloc = 0; loop { next_h = h; next_q = q; /* Reset and check ewt, ewtQ, ewtS */ if (nst > 0) { ier = efun(zn[0], ewt, e_data); if(ier != 0) { if (itol == CV_WF) cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_FAIL, tn); else cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_BAD, tn); istate = CV_ILL_INPUT; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } if (quadr && errconQ) { ier = cvQuadEwtSet(cv_mem, znQ[0], ewtQ); if(ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQ_NOW_BAD, tn); istate = CV_ILL_INPUT; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } } if (sensi) { ier = cvSensEwtSet(cv_mem, znS[0], ewtS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTS_NOW_BAD, tn); istate = CV_ILL_INPUT; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } } if (quadr_sensi && errconQS) { ier = cvQuadSensEwtSet(cv_mem, znQS[0], ewtQS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQS_NOW_BAD, tn); istate = CV_ILL_INPUT; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } } } /* Check for too many steps */ if ( (mxstep>0) && (nstloc >= mxstep) ) { cvProcessError(cv_mem, CV_TOO_MUCH_WORK, "CVODES", "CVode", MSGCV_MAX_STEPS, tn); istate = CV_TOO_MUCH_WORK; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } /* Check for too much accuracy requested */ nrm = N_VWrmsNorm(zn[0], ewt); if (quadr && errconQ) { nrm = cvQuadUpdateNorm(cv_mem, nrm, znQ[0], ewtQ); } if (sensi && errconS) { nrm = cvSensUpdateNorm(cv_mem, nrm, znS[0], ewtS); } if (quadr_sensi && errconQS) { nrm = cvQuadSensUpdateNorm(cv_mem, nrm, znQS[0], ewtQS); } tolsf = uround * nrm; if (tolsf > ONE) { cvProcessError(cv_mem, CV_TOO_MUCH_ACC, "CVODES", "CVode", MSGCV_TOO_MUCH_ACC, tn); istate = CV_TOO_MUCH_ACC; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); tolsf *= TWO; break; } else { tolsf = ONE; } /* Check for h below roundoff level in tn */ if (tn + h == tn) { nhnil++; if (nhnil <= mxhnil) cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL, tn, h); if (nhnil == mxhnil) cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL_DONE); } /* Call cvStep to take a step */ kflag = cvStep(cv_mem); /* Process failed step cases, and exit loop */ if (kflag != CV_SUCCESS) { istate = cvHandleFailure(cv_mem, kflag); tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); break; } nstloc++; /* If tstop is set and was reached, reset tn = tstop */ if ( tstopset ) { troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); if ( ABS(tn - tstop) <= troundoff) tn = tstop; } /* Check for root in last step taken. */ if (nrtfn > 0) { retval = cvRcheck3(cv_mem); if (retval == RTFOUND) { /* A new root was found */ irfnd = 1; istate = CV_ROOT_RETURN; tretlast = *tret = tlo; break; } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, tlo); istate = CV_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (nst==1) { inactive_roots = FALSE; for (ir=0; ircv_mxgnull > 0) && inactive_roots) { cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_INACTIVE_ROOTS); } } } /* In NORMAL mode, check if tout reached */ if ( (itask == CV_NORMAL) && (tn-tout)*h >= ZERO ) { istate = CV_SUCCESS; tretlast = *tret = tout; (void) CVodeGetDky(cv_mem, tout, 0, yout); next_q = qprime; next_h = hprime; break; } /* Check if tn is at tstop, or about to pass tstop */ if ( tstopset ) { troundoff = FUZZ_FACTOR*uround*(ABS(tn) + ABS(h)); if ( ABS(tn - tstop) <= troundoff) { (void) CVodeGetDky(cv_mem, tstop, 0, yout); tretlast = *tret = tstop; tstopset = FALSE; istate = CV_TSTOP_RETURN; break; } if ( (tn + hprime - tstop)*h > ZERO ) { hprime = (tstop - tn)*(ONE-FOUR*uround); eta = hprime/h; } } /* In ONE_STEP mode, copy y and exit loop */ if (itask == CV_ONE_STEP) { istate = CV_SUCCESS; tretlast = *tret = tn; N_VScale(ONE, zn[0], yout); next_q = qprime; next_h = hprime; break; } } /* end looping for internal steps */ /* Load optional output */ if (sensi && (ism==CV_STAGGERED1)) { nniS = 0; ncfnS = 0; for (is=0; is q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetDky", MSGCV_BAD_K); return(CV_BAD_K); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); if (hu < ZERO) tfuzz = -tfuzz; tp = tn - hu - tfuzz; tn1 = tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetDky", MSGCV_BAD_T, t, tn-hu, tn); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ s = (t - tn) / h; for (j=q; j >= k; j--) { c = ONE; for (i=j; i >= j-k+1; i--) c *= i; if (j == q) { N_VScale(c, zn[q], dky); } else { N_VLinearSum(c, zn[j], s, dky, dky); } } if (k == 0) return(CV_SUCCESS); r = RPowerI(h,-k); N_VScale(r, dky, dky); return(CV_SUCCESS); } /* * CVodeGetQuad * * This routine extracts quadrature solution into yQout at the * time which CVode returned the solution. * This is just a wrapper that calls CVodeGetQuadDky with k=0. */ int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuad", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = tretlast; flag = CVodeGetQuadDky(cvode_mem,tretlast,0,yQout); return(flag); } /* * CVodeGetQuadDky * * CVodeQuadDky computes the kth derivative of the yQ function at * time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * k=0, 1, ..., qu, where qu is the current order. * The derivative vector is returned in dky. This vector * must be allocated by the caller. It is only legal to call this * function after a successful return from CVode with quadrature * computation enabled. */ int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dkyQ) { realtype s, c, r; realtype tfuzz, tp, tn1; int i, j; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if(quadr != TRUE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadDky", MSGCV_NO_QUAD); return(CV_NO_QUAD); } if (dkyQ == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetQuadDky", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_K); return(CV_BAD_K); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); if (hu < ZERO) tfuzz = -tfuzz; tp = tn - hu - tfuzz; tn1 = tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ s = (t - tn) / h; for (j=q; j >= k; j--) { c = ONE; for (i=j; i >= j-k+1; i--) c *= i; if (j == q) { N_VScale(c, znQ[q], dkyQ); } else { N_VLinearSum(c, znQ[j], s, dkyQ, dkyQ); } } if (k == 0) return(CV_SUCCESS); r = RPowerI(h,-k); N_VScale(r, dkyQ, dkyQ); return(CV_SUCCESS); } /* * CVodeGetSens * * This routine extracts sensitivity solution into ySout at the * time at which CVode returned the solution. * This is just a wrapper that calls CVodeSensDky with k=0. */ int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = tretlast; flag = CVodeGetSensDky(cvode_mem,tretlast,0,ySout); return(flag); } /* * CVodeGetSens1 * * This routine extracts the is-th sensitivity solution into ySout * at the time at which CVode returned the solution. * This is just a wrapper that calls CVodeSensDky1 with k=0. */ int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = tretlast; flag = CVodeGetSensDky1(cvode_mem,tretlast,0,is,ySout); return(flag); } /* * CVodeGetSensDky * * If the user calls directly CVodeSensDky then s must be allocated * prior to this call. When CVodeSensDky is called by * CVodeGetSens, only ier=CV_SUCCESS, ier=CV_NO_SENS, or * ier=CV_BAD_T are possible. */ int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyS) { int ier=CV_SUCCESS; int is; CVodeMem cv_mem; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dkyS == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); return(CV_BAD_DKY); } for (is=0; is q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_K); return(CV_BAD_K); } if ((is < 0) || (is > Ns-1)) { cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_IS); return(CV_BAD_IS); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); if (hu < ZERO) tfuzz = -tfuzz; tp = tn - hu - tfuzz; tn1 = tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ s = (t - tn) / h; for (j=q; j >= k; j--) { c = ONE; for (i=j; i >= j-k+1; i--) c *= i; if (j == q) { N_VScale(c, znS[q][is], dkyS); } else { N_VLinearSum(c, znS[j][is], s, dkyS, dkyS); } } if (k == 0) return(CV_SUCCESS); r = RPowerI(h,-k); N_VScale(r, dkyS, dkyS); return(CV_SUCCESS); } /* * CVodeGetQuadSens and CVodeGetQuadSens1 * * Extraction functions for all or only one of the quadrature sensitivity * vectors at the time at which CVode returned the ODE solution. */ int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = tretlast; flag = CVodeGetQuadSensDky(cvode_mem,tretlast,0,yQSout); return(flag); } int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = tretlast; flag = CVodeGetQuadSensDky1(cvode_mem,tretlast,0,is,yQSout); return(flag); } /* * CVodeGetQuadSensDky and CVodeGetQuadSensDky1 * * Dense output functions for all or only one of the quadrature sensitivity * vectors (or derivative thereof). */ int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all) { int ier=CV_SUCCESS; int is; CVodeMem cv_mem; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dkyQS_all == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); return(CV_BAD_DKY); } for (is=0; is q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_K); return(CV_BAD_K); } if ((is < 0) || (is > Ns-1)) { cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_IS); return(CV_BAD_IS); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * uround * (ABS(tn) + ABS(hu)); if (hu < ZERO) tfuzz = -tfuzz; tp = tn - hu - tfuzz; tn1 = tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ s = (t - tn) / h; for (j=q; j >= k; j--) { c = ONE; for (i=j; i >= j-k+1; i--) c *= i; if (j == q) { N_VScale(c, znQS[q][is], dkyQS); } else { N_VLinearSum(c, znQS[j][is], s, dkyQS, dkyQS); } } if (k == 0) return(CV_SUCCESS); r = RPowerI(h,-k); N_VScale(r, dkyQS, dkyQS); return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Deallocation functions * ----------------------------------------------------------------- */ /* * CVodeFree * * This routine frees the problem memory allocated by CVodeInit. * Such memory includes all the vectors allocated by cvAllocVectors, * and the memory lmem for the linear solver (deallocated by a call * to lfree), as well as (if Ns!=0) all memory allocated for * sensitivity computations by CVodeSensInit. */ void CVodeFree(void **cvode_mem) { CVodeMem cv_mem; if (*cvode_mem == NULL) return; cv_mem = (CVodeMem) (*cvode_mem); cvFreeVectors(cv_mem); CVodeQuadFree(cv_mem); CVodeSensFree(cv_mem); CVodeQuadSensFree(cv_mem); CVodeAdjFree(cv_mem); if (iter == CV_NEWTON && lfree != NULL) lfree(cv_mem); if (nrtfn > 0) { free(glo); glo = NULL; free(ghi); ghi = NULL; free(grout); grout = NULL; free(iroots); iroots = NULL; free(rootdir); rootdir = NULL; free(gactive); gactive = NULL; } free(*cvode_mem); *cvode_mem = NULL; } /* * CVodeQuadFree * * CVodeQuadFree frees the problem memory in cvode_mem allocated * for quadrature integration. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeQuadFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(QuadMallocDone) { cvQuadFreeVectors(cv_mem); QuadMallocDone = FALSE; quadr = FALSE; } } /* * CVodeSensFree * * CVodeSensFree frees the problem memory in cvode_mem allocated * for sensitivity analysis. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeSensFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(SensMallocDone) { if (stgr1alloc) { free(ncfS1); ncfS1 = NULL; free(ncfnS1); ncfnS1 = NULL; free(nniS1); nniS1 = NULL; stgr1alloc = FALSE; } cvSensFreeVectors(cv_mem); SensMallocDone = FALSE; sensi = FALSE; } } /* * CVodeQuadSensFree * * CVodeQuadSensFree frees the problem memory in cvode_mem allocated * for quadrature sensitivity analysis. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeQuadSensFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(QuadSensMallocDone) { cvQuadSensFreeVectors(cv_mem); QuadSensMallocDone = FALSE; quadr_sensi = FALSE; } } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * cvCheckNvector * This routine checks if all required vector operations are present. * If any of them is missing it returns FALSE. */ static booleantype cvCheckNvector(N_Vector tmpl) { if((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvdiv == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvmaxnorm == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(FALSE); else return(TRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * cvAllocVectors * * This routine allocates the CVODES vectors ewt, acor, tempv, ftemp, and * zn[0], ..., zn[maxord]. * If all memory allocations are successful, cvAllocVectors returns TRUE. * Otherwise all allocated memory is freed and cvAllocVectors returns FALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ewt, acor, tempv, ftemp */ ewt = N_VClone(tmpl); if (ewt == NULL) return(FALSE); acor = N_VClone(tmpl); if (acor == NULL) { N_VDestroy(ewt); return(FALSE); } tempv = N_VClone(tmpl); if (tempv == NULL) { N_VDestroy(ewt); N_VDestroy(acor); return(FALSE); } ftemp = N_VClone(tmpl); if (ftemp == NULL) { N_VDestroy(tempv); N_VDestroy(ewt); N_VDestroy(acor); return(FALSE); } /* Allocate zn[0] ... zn[qmax] */ for (j=0; j <= qmax; j++) { zn[j] = N_VClone(tmpl); if (zn[j] == NULL) { N_VDestroy(ewt); N_VDestroy(acor); N_VDestroy(tempv); N_VDestroy(ftemp); for (i=0; i < j; i++) N_VDestroy(zn[i]); return(FALSE); } } /* Update solver workspace lengths */ lrw += (qmax + 5)*lrw1; liw += (qmax + 5)*liw1; /* Store the value of qmax used here */ cv_mem->cv_qmax_alloc = qmax; return(TRUE); } /* * cvFreeVectors * * This routine frees the CVODES vectors allocated in cvAllocVectors. */ static void cvFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_alloc; N_VDestroy(ewt); N_VDestroy(acor); N_VDestroy(tempv); N_VDestroy(ftemp); for (j=0; j <= maxord; j++) N_VDestroy(zn[j]); lrw -= (maxord + 5)*lrw1; liw -= (maxord + 5)*liw1; if (cv_mem->cv_VabstolMallocDone) { N_VDestroy(Vabstol); lrw -= lrw1; liw -= liw1; } } /* * CVodeQuadAllocVectors * * NOTE: Space for ewtQ is allocated even when errconQ=FALSE, * although in this case, ewtQ is never used. The reason for this * decision is to allow the user to re-initialize the quadrature * computation with errconQ=TRUE, after an initialization with * errconQ=FALSE, without new memory allocation within * CVodeQuadReInit. */ static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ewtQ */ ewtQ = N_VClone(tmpl); if (ewtQ == NULL) { return(FALSE); } /* Allocate acorQ */ acorQ = N_VClone(tmpl); if (acorQ == NULL) { N_VDestroy(ewtQ); return(FALSE); } /* Allocate yQ */ yQ = N_VClone(tmpl); if (yQ == NULL) { N_VDestroy(ewtQ); N_VDestroy(acorQ); return(FALSE); } /* Allocate tempvQ */ tempvQ = N_VClone(tmpl); if (tempvQ == NULL) { N_VDestroy(ewtQ); N_VDestroy(acorQ); N_VDestroy(yQ); return(FALSE); } /* Allocate zQn[0] ... zQn[maxord] */ for (j=0; j <= qmax; j++) { znQ[j] = N_VClone(tmpl); if (znQ[j] == NULL) { N_VDestroy(ewtQ); N_VDestroy(acorQ); N_VDestroy(yQ); N_VDestroy(tempvQ); for (i=0; i < j; i++) N_VDestroy(znQ[i]); return(FALSE); } } /* Store the value of qmax used here */ cv_mem->cv_qmax_allocQ = qmax; /* Update solver workspace lengths */ lrw += (qmax + 5)*lrw1Q; liw += (qmax + 5)*liw1Q; return(TRUE); } /* * cvQuadFreeVectors * * This routine frees the CVODES vectors allocated in cvQuadAllocVectors. */ static void cvQuadFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocQ; N_VDestroy(ewtQ); N_VDestroy(acorQ); N_VDestroy(yQ); N_VDestroy(tempvQ); for (j=0; j<=maxord; j++) N_VDestroy(znQ[j]); lrw -= (maxord + 5)*lrw1Q; liw -= (maxord + 5)*liw1Q; if (cv_mem->cv_VabstolQMallocDone) { N_VDestroy(VabstolQ); lrw -= lrw1Q; liw -= liw1Q; } cv_mem->cv_VabstolQMallocDone = FALSE; } /* * cvSensAllocVectors * * Create (through duplication) N_Vectors used for sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate yS */ yS = N_VCloneVectorArray(Ns, tmpl); if (yS == NULL) { return(FALSE); } /* Allocate ewtS */ ewtS = N_VCloneVectorArray(Ns, tmpl); if (ewtS == NULL) { N_VDestroyVectorArray(yS, Ns); return(FALSE); } /* Allocate acorS */ acorS = N_VCloneVectorArray(Ns, tmpl); if (acorS == NULL) { N_VDestroyVectorArray(yS, Ns); N_VDestroyVectorArray(ewtS, Ns); return(FALSE); } /* Allocate tempvS */ tempvS = N_VCloneVectorArray(Ns, tmpl); if (tempvS == NULL) { N_VDestroyVectorArray(yS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(acorS, Ns); return(FALSE); } /* Allocate ftempS */ ftempS = N_VCloneVectorArray(Ns, tmpl); if (ftempS == NULL) { N_VDestroyVectorArray(yS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(acorS, Ns); N_VDestroyVectorArray(tempvS, Ns); return(FALSE); } /* Allocate znS */ for (j=0; j<=qmax; j++) { znS[j] = N_VCloneVectorArray(Ns, tmpl); if (znS[j] == NULL) { N_VDestroyVectorArray(yS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(acorS, Ns); N_VDestroyVectorArray(tempvS, Ns); N_VDestroyVectorArray(ftempS, Ns); for (i=0; icv_qmax_allocS = qmax; return(TRUE); } /* * cvSensFreeVectors * * This routine frees the CVODES vectors allocated in cvSensAllocVectors. */ static void cvSensFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocS; N_VDestroyVectorArray(yS, Ns); N_VDestroyVectorArray(ewtS, Ns); N_VDestroyVectorArray(acorS, Ns); N_VDestroyVectorArray(tempvS, Ns); N_VDestroyVectorArray(ftempS, Ns); for (j=0; j<=maxord; j++) N_VDestroyVectorArray(znS[j], Ns); free(pbar); pbar = NULL; free(plist); plist = NULL; lrw -= (maxord + 6)*Ns*lrw1 + Ns; liw -= (maxord + 6)*Ns*liw1 + Ns; if (cv_mem->cv_VabstolSMallocDone) { N_VDestroyVectorArray(VabstolS, Ns); lrw -= Ns*lrw1; liw -= Ns*liw1; } if (cv_mem->cv_SabstolSMallocDone) { free(SabstolS); SabstolS = NULL; lrw -= Ns; } cv_mem->cv_VabstolSMallocDone = FALSE; cv_mem->cv_SabstolSMallocDone = FALSE; } /* * cvQuadSensAllocVectors * * Create (through duplication) N_Vectors used for quadrature sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ftempQ */ ftempQ = N_VClone(tmpl); if (ftempQ == NULL) { return(FALSE); } /* Allocate yQS */ yQS = N_VCloneVectorArray(Ns, tmpl); if (yQS == NULL) { N_VDestroy(ftempQ); return(FALSE); } /* Allocate ewtQS */ ewtQS = N_VCloneVectorArray(Ns, tmpl); if (ewtQS == NULL) { N_VDestroy(ftempQ); N_VDestroyVectorArray(yQS, Ns); return(FALSE); } /* Allocate acorQS */ acorQS = N_VCloneVectorArray(Ns, tmpl); if (acorQS == NULL) { N_VDestroy(ftempQ); N_VDestroyVectorArray(yQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); return(FALSE); } /* Allocate tempvQS */ tempvQS = N_VCloneVectorArray(Ns, tmpl); if (tempvQS == NULL) { N_VDestroy(ftempQ); N_VDestroyVectorArray(yQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(acorQS, Ns); return(FALSE); } /* Allocate znQS */ for (j=0; j<=qmax; j++) { znQS[j] = N_VCloneVectorArray(Ns, tmpl); if (znQS[j] == NULL) { N_VDestroy(ftempQ); N_VDestroyVectorArray(yQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(acorQS, Ns); N_VDestroyVectorArray(tempvQS, Ns); for (i=0; icv_qmax_allocQS = qmax; return(TRUE); } /* * cvQuadSensFreeVectors * * This routine frees the CVODES vectors allocated in cvQuadSensAllocVectors. */ static void cvQuadSensFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocQS; N_VDestroy(ftempQ); N_VDestroyVectorArray(yQS, Ns); N_VDestroyVectorArray(ewtQS, Ns); N_VDestroyVectorArray(acorQS, Ns); N_VDestroyVectorArray(tempvQS, Ns); for (j=0; j<=maxord; j++) N_VDestroyVectorArray(znQS[j], Ns); lrw -= (maxord + 5)*Ns*lrw1Q; liw -= (maxord + 5)*Ns*liw1Q; if (cv_mem->cv_VabstolQSMallocDone) { N_VDestroyVectorArray(VabstolQS, Ns); lrw -= Ns*lrw1Q; liw -= Ns*liw1Q; } if (cv_mem->cv_SabstolQSMallocDone) { free(SabstolQS); SabstolQS = NULL; lrw -= Ns; } cv_mem->cv_VabstolQSMallocDone = FALSE; cv_mem->cv_SabstolQSMallocDone = FALSE; } /* * ----------------------------------------------------------------- * Initial stepsize calculation * ----------------------------------------------------------------- */ /* * cvHin * * This routine computes a tentative initial step size h0. * If tout is too close to tn (= t0), then cvHin returns CV_TOO_CLOSE * and h remains uninitialized. Note that here tout is either the value * passed to CVode at the first call or the value of tstop (if tstop is * enabled and it is closer to t0=tn than tout). * If any RHS function fails unrecoverably, cvHin returns CV_*RHSFUNC_FAIL. * If any RHS function fails recoverably too many times and recovery is * not possible, cvHin returns CV_REPTD_*RHSFUNC_ERR. * Otherwise, cvHin sets h to the chosen value h0 and returns CV_SUCCESS. * * The algorithm used seeks to find h0 as a solution of * (WRMS norm of (h0^2 ydd / 2)) = 1, * where ydd = estimated second derivative of y. Here, y includes * all variables considered in the error test. * * We start with an initial estimate equal to the geometric mean of the * lower and upper bounds on the step size. * * Loop up to MAX_ITERS times to find h0. * Stop if new and previous values differ by a factor < 2. * Stop if hnew/hg > 2 after one iteration, as this probably means * that the ydd value is bad because of cancellation error. * * For each new proposed hg, we allow MAX_ITERS attempts to * resolve a possible recoverable failure from f() by reducing * the proposed stepsize by a factor of 0.2. If a legal stepsize * still cannot be found, fall back on a previous value if possible, * or else return CV_REPTD_RHSFUNC_ERR. * * Finally, we apply a bias (0.5) and verify that h0 is within bounds. */ static int cvHin(CVodeMem cv_mem, realtype tout) { int retval, sign, count1, count2; realtype tdiff, tdist, tround, hlb, hub; realtype hg, hgs, hs, hnew, hrat, h0, yddnrm; booleantype hgOK, hnewOK; /* If tout is too close to tn, give up */ if ((tdiff = tout-tn) == ZERO) return(CV_TOO_CLOSE); sign = (tdiff > ZERO) ? 1 : -1; tdist = ABS(tdiff); tround = uround * MAX(ABS(tn), ABS(tout)); if (tdist < TWO*tround) return(CV_TOO_CLOSE); /* Set lower and upper bounds on h0, and take geometric mean as first trial value. Exit with this value if the bounds cross each other. */ hlb = HLB_FACTOR * tround; hub = cvUpperBoundH0(cv_mem, tdist); hg = RSqrt(hlb*hub); if (hub < hlb) { if (sign == -1) h = -hg; else h = hg; return(CV_SUCCESS); } /* Outer loop */ hnewOK = FALSE; hs = hg; /* safeguard against 'uninitialized variable' warning */ for(count1 = 1; count1 <= MAX_ITERS; count1++) { /* Attempts to estimate ydd */ hgOK = FALSE; for (count2 = 1; count2 <= MAX_ITERS; count2++) { hgs = hg*sign; retval = cvYddNorm(cv_mem, hgs, &yddnrm); /* If a RHS function failed unrecoverably, give up */ if (retval < 0) return(retval); /* If successful, we can use ydd */ if (retval == CV_SUCCESS) {hgOK = TRUE; break;} /* A RHS function failed recoverably; cut step size and test it again */ hg *= POINT2; } /* If a RHS function failed recoverably MAX_ITERS times */ if (!hgOK) { /* Exit if this is the first or second pass. No recovery possible */ if (count1 <= 2) if (retval == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); if (retval == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); if (retval == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); /* We have a fall-back option. The value hs is a previous hnew which passed through f(). Use it and break */ hnew = hs; break; } /* The proposed step size is feasible. Save it. */ hs = hg; /* If the stopping criteria was met, or if this is the last pass, stop */ if ( (hnewOK) || (count1 == MAX_ITERS)) {hnew = hg; break;} /* Propose new step size */ hnew = (yddnrm*hub*hub > TWO) ? RSqrt(TWO/yddnrm) : RSqrt(hg*hub); hrat = hnew/hg; /* Accept hnew if it does not differ from hg by more than a factor of 2 */ if ((hrat > HALF) && (hrat < TWO)) { hnewOK = TRUE; } /* After one pass, if ydd seems to be bad, use fall-back value. */ if ((count1 > 1) && (hrat > TWO)) { hnew = hg; hnewOK = TRUE; } /* Send this value back through f() */ hg = hnew; } /* Apply bounds, bias factor, and attach sign */ h0 = H_BIAS*hnew; if (h0 < hlb) h0 = hlb; if (h0 > hub) h0 = hub; if (sign == -1) h0 = -h0; h = h0; return(CV_SUCCESS); } /* * cvUpperBoundH0 * * This routine sets an upper bound on abs(h0) based on * tdist = tn - t0 and the values of y[i]/y'[i]. */ static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist) { realtype hub_inv, hubQ_inv, hubS_inv, hubQS_inv, hub; N_Vector temp1, temp2; N_Vector tempQ1, tempQ2; N_Vector *tempS1; N_Vector *tempQS1; int is; /* * Bound based on |y|/|y'| -- allow at most an increase of * HUB_FACTOR in y0 (based on a forward Euler step). The weight * factor is used as a safeguard against zero components in y0. */ temp1 = tempv; temp2 = acor; N_VAbs(zn[0], temp2); efun(zn[0], temp1, e_data); N_VInv(temp1, temp1); N_VLinearSum(HUB_FACTOR, temp2, ONE, temp1, temp1); N_VAbs(zn[1], temp2); N_VDiv(temp2, temp1, temp1); hub_inv = N_VMaxNorm(temp1); /* Bound based on |yQ|/|yQ'| */ if (quadr && errconQ) { tempQ1 = tempvQ; tempQ2 = acorQ; N_VAbs(znQ[0], tempQ2); cvQuadEwtSet(cv_mem, znQ[0], tempQ1); N_VInv(tempQ1, tempQ1); N_VLinearSum(HUB_FACTOR, tempQ2, ONE, tempQ1, tempQ1); N_VAbs(znQ[1], tempQ2); N_VDiv(tempQ2, tempQ1, tempQ1); hubQ_inv = N_VMaxNorm(tempQ1); if (hubQ_inv > hub_inv) hub_inv = hubQ_inv; } /* Bound based on |yS|/|yS'| */ if (sensi && errconS) { tempS1 = acorS; cvSensEwtSet(cv_mem, znS[0], tempS1); for (is=0; is hub_inv) hub_inv = hubS_inv; } } /* Bound based on |yQS|/|yQS'| */ if (quadr_sensi && errconQS) { tempQ1 = tempvQ; tempQ2 = acorQ; tempQS1 = acorQS; cvQuadSensEwtSet(cv_mem, znQS[0], tempQS1); for (is=0; is hub_inv) hub_inv = hubQS_inv; } } /* * bound based on tdist -- allow at most a step of magnitude * HUB_FACTOR * tdist */ hub = HUB_FACTOR*tdist; /* Use the smaler of the two */ if (hub*hub_inv > ONE) hub = ONE/hub_inv; return(hub); } /* * cvYddNorm * * This routine computes an estimate of the second derivative of Y * using a difference quotient, and returns its WRMS norm. * * Y contains all variables included in the error test. */ static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm) { int retval, is; N_Vector wrk1, wrk2; /* y <- h*y'(t) + y(t) */ N_VLinearSum(hg, zn[1], ONE, zn[0], y); if (sensi && errconS) for (is=0; is 0) return(RHSFUNC_RECVR); if (quadr && errconQ) { retval = fQ(tn+hg, y, tempvQ, user_data); nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(QRHSFUNC_RECVR); } if (sensi && errconS) { wrk1 = ftemp; wrk2 = acor; retval = cvSensRhsWrapper(cv_mem, tn+hg, y, tempv, yS, tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } if (quadr_sensi && errconQS) { wrk1 = ftemp; wrk2 = acorQ; retval = fQS(Ns, tn+hg, y, yS, tempvQ, tempvQS, fQS_data, wrk1, wrk2); nfQSe++; if (retval < 0) return(CV_QSRHSFUNC_FAIL); if (retval > 0) return(QSRHSFUNC_RECVR); } /* Load estimate of ||y''|| into tempv: * tempv <- (1/h) * f(t+h, h*y'(t)+y(t)) - y'(t) */ N_VLinearSum(ONE, tempv, -ONE, zn[1], tempv); N_VScale(ONE/hg, tempv, tempv); *yddnrm = N_VWrmsNorm(tempv, ewt); if (quadr && errconQ) { N_VLinearSum(ONE, tempvQ, -ONE, znQ[1], tempvQ); N_VScale(ONE/hg, tempvQ, tempvQ); *yddnrm = cvQuadUpdateNorm(cv_mem, *yddnrm, tempvQ, ewtQ); } if (sensi && errconS) { for (is=0; iscv_user_efun) e_data = user_data; else e_data = cv_mem; /* Load intial error weights */ ier = efun(zn[0], ewt, e_data); if (ier != 0) { if (itol == CV_WF) cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_FAIL); else cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWT); return(CV_ILL_INPUT); } /* Quadrature initial setup */ if (quadr && errconQ) { /* Did the user specify tolerances? */ if (itolQ == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQ); return(CV_ILL_INPUT); } /* Load ewtQ */ ier = cvQuadEwtSet(cv_mem, znQ[0], ewtQ); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTQ); return(CV_ILL_INPUT); } } if (!quadr) errconQ = FALSE; /* Forward sensitivity initial setup */ if (sensi) { /* Did the user specify tolerances? */ if (itolS == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLS); return(CV_ILL_INPUT); } /* If using the internal DQ functions, we must have access to the problem parameters */ if(fSDQ && (p == NULL)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_P); return(CV_ILL_INPUT); } /* Load ewtS */ ier = cvSensEwtSet(cv_mem, znS[0], ewtS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTS); return(CV_ILL_INPUT); } } /* FSA of quadrature variables */ if (quadr_sensi) { /* If using the internal DQ functions, we must have access to fQ * (i.e. quadrature integration must be enabled) and to the problem parameters */ if (fQSDQ) { /* Test if quadratures are defined, so we can use fQ */ if (!quadr) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_FQ); return(CV_ILL_INPUT); } /* Test if we have the problem parameters */ if(p == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NULL_P); return(CV_ILL_INPUT); } } if (errconQS) { /* Did the user specify tolerances? */ if (itolQS == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQS); return(CV_ILL_INPUT); } /* If needed, did the user provide quadrature tolerances? */ if ( (itolQS == CV_EE) && (itolQ == CV_NN) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_NO_TOLQ); return(CV_ILL_INPUT); } /* Load ewtQS */ ier = cvQuadSensEwtSet(cv_mem, znQS[0], ewtQS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_EWTQS); return(CV_ILL_INPUT); } } } else { errconQS = FALSE; } /* Check if lsolve function exists (if needed) and call linit function (if it exists) */ if (iter == CV_NEWTON) { if (lsolve == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_LSOLVE_NULL); return(CV_ILL_INPUT); } if (linit != NULL) { ier = linit(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_LINIT_FAIL, "CVODES", "CVode", MSGCV_LINIT_FAIL); return(CV_LINIT_FAIL); } } } return(CV_SUCCESS); } /* * cvEwtSet * * This routine is responsible for setting the error weight vector ewt, * according to tol_type, as follows: * * (1) ewt[i] = 1 / (reltol * ABS(ycur[i]) + *abstol), i=0,...,neq-1 * if tol_type = CV_SS * (2) ewt[i] = 1 / (reltol * ABS(ycur[i]) + abstol[i]), i=0,...,neq-1 * if tol_type = CV_SV * * cvEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines cvEwtSetSS, cvEwtSetSV. */ int cvEwtSet(N_Vector ycur, N_Vector weight, void *data) { CVodeMem cv_mem; int flag = 0; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; switch(itol) { case CV_SS: flag = cvEwtSetSS(cv_mem, ycur, weight); break; case CV_SV: flag = cvEwtSetSV(cv_mem, ycur, weight); break; } return(flag); } /* * cvEwtSetSS * * This routine sets ewt as decribed above in the case tol_type = CV_SS. * It tests for non-positive components before inverting. cvEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv); N_VScale(reltol, tempv, tempv); N_VAddConst(tempv, Sabstol, tempv); if (N_VMin(tempv) <= ZERO) return(-1); N_VInv(tempv, weight); return(0); } /* * cvEwtSetSV * * This routine sets ewt as decribed above in the case tol_type = CV_SV. * It tests for non-positive components before inverting. cvEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, tempv); N_VLinearSum(reltol, tempv, ONE, Vabstol, tempv); if (N_VMin(tempv) <= ZERO) return(-1); N_VInv(tempv, weight); return(0); } /* * cvQuadEwtSet * */ static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { int flag=0; switch (itolQ) { case CV_SS: flag = cvQuadEwtSetSS(cv_mem, qcur, weightQ); break; case CV_SV: flag = cvQuadEwtSetSV(cv_mem, qcur, weightQ); break; } return(flag); } /* * cvQuadEwtSetSS * */ static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { N_VAbs(qcur, tempvQ); N_VScale(reltolQ, tempvQ, tempvQ); N_VAddConst(tempvQ, SabstolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * cvQuadEwtSetSV * */ static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { N_VAbs(qcur, tempvQ); N_VLinearSum(reltolQ, tempvQ, ONE, VabstolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * cvSensEwtSet * */ static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int flag=0; switch (itolS) { case CV_EE: flag = cvSensEwtSetEE(cv_mem, yScur, weightS); break; case CV_SS: flag = cvSensEwtSetSS(cv_mem, yScur, weightS); break; case CV_SV: flag = cvSensEwtSetSV(cv_mem, yScur, weightS); break; } return(flag); } /* * cvSensEwtSetEE * * In this case, the error weight vector for the i-th sensitivity is set to * * ewtS_i = pbar_i * efun(pbar_i*yS_i) * * In other words, the scaled sensitivity pbar_i * yS_i has the same error * weight vector calculation as the solution vector. * */ static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int is; N_Vector pyS; int flag; /* Use tempvS[0] as temporary storage for the scaled sensitivity */ pyS = tempvS[0]; for (is=0; is 0) && (hprime != h)) cvAdjustParams(cv_mem); /* Looping point for attempts to take a step */ saved_t = tn; nflag = FIRST_CALL; loop { cvPredict(cv_mem); cvSet(cv_mem); /* ------ Correct state variables ------ */ nflag = cvNls(cv_mem, nflag); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &ncfn); /* Go back in loop if we need to predict again (nflag=PREV_CONV_FAIL) */ if (kflag == PREDICT_AGAIN) continue; /* Return if nonlinear solve failed and recovery not possible. */ if (kflag != DO_ERROR_TEST) return(kflag); /* Perform error test (nflag=CV_SUCCESS) */ eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, acnrm, &nef, &netf, &dsm); /* Go back in loop if we need to predict again (nflag=PREV_ERR_FAIL) */ if (eflag == TRY_AGAIN) continue; /* Return if error test failed and recovery not possible. */ if (eflag != CV_SUCCESS) return(eflag); /* Error test passed (eflag=CV_SUCCESS, nflag=CV_SUCCESS), go on */ /* ------ Correct the quadrature variables ------ */ if (quadr) { ncf = nef = 0; /* reset counters for states */ nflag = cvQuadNls(cv_mem); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &ncfn); if (kflag == PREDICT_AGAIN) continue; if (kflag != DO_ERROR_TEST) return(kflag); /* Error test on quadratures */ if (errconQ) { acnrmQ = N_VWrmsNorm(acorQ, ewtQ); eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, acnrmQ, &nefQ, &netfQ, &dsmQ); if (eflag == TRY_AGAIN) continue; if (eflag != CV_SUCCESS) return(eflag); /* Set dsm = max(dsm, dsmQ) to be used in cvPrepareNextStep */ if (dsmQ > dsm) dsm = dsmQ; } } /* ------ Correct the sensitivity variables (STAGGERED or STAGGERED1) ------- */ if (do_sensi_stg || do_sensi_stg1) { ncf = nef = 0; /* reset counters for states */ if (quadr) nefQ = 0; /* reset counter for quadratures */ /* Evaluate f at converged y, needed for future evaluations of sens. RHS * If f() fails recoverably, treat it as a convergence failure and * attempt the step again */ retval = f(tn, y, ftemp, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) { nflag = PREV_CONV_FAIL; continue; } if (do_sensi_stg) { /* Nonlinear solve for sensitivities (all-at-once) */ nflag = cvStgrNls(cv_mem); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncfS, &ncfnS); } else { /* Nonlinear solve for sensitivities (one-by-one) */ for (is=0; is dsm) dsm = dsmS; } } /* ------ Correct the quadrature sensitivity variables ------ */ if (quadr_sensi) { /* Reset local convergence and error test failure counters */ ncf = nef = 0; if (quadr) nefQ = 0; if (do_sensi_stg) ncfS = nefS = 0; if (do_sensi_stg1) { for (is=0; is dsm) dsm = dsmQS; } } /* Everything went fine; exit loop */ break; } /* Nonlinear system solve and error test were both successful. Update data, and consider change of step and/or order. */ cvCompleteStep(cv_mem); cvPrepareNextStep(cv_mem, dsm); /* If Stablilty Limit Detection is turned on, call stability limit detection routine for possible order reduction. */ if (sldeton) cvBDFStab(cv_mem); etamax = (nst <= SMALL_NST) ? ETAMX2 : ETAMX3; /* Finally, we rescale the acor array to be the estimated local error vector. */ N_VScale(tq[2], acor, acor); if (quadr) N_VScale(tq[2], acorQ, acorQ); if (sensi) for (is=0; is xi_0 = 0 */ for (i=0; i <= qmax; i++) l[i] = ZERO; l[1] = ONE; hsum = ZERO; for (j=1; j <= q-2; j++) { hsum += tau[j]; xi = hsum / hscale; for (i=j+1; i >= 1; i--) l[i] = l[i]*xi + l[i-1]; } for (j=1; j <= q-2; j++) l[j+1] = q * (l[j] / (j+1)); for (j=2; j < q; j++) N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); if (quadr) for (j=2; j < q; j++) N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); if (sensi) for (is=0; is 1) { for (j=1; j < q; j++) { hsum += tau[j+1]; xi = hsum / hscale; prod *= xi; alpha0 -= ONE / (j+1); alpha1 += ONE / xi; for (i=j+2; i >= 2; i--) l[i] = l[i]*xiold + l[i-1]; xiold = xi; } } A1 = (-alpha0 - alpha1) / prod; /* zn[indx_acor] contains the value Delta_n = y_n - y_n(0) This value was stored there at the previous successful step (in cvCompleteStep) A1 contains dbar = (1/xi* - 1/xi_q)/prod(xi_j) */ N_VScale(A1, zn[indx_acor], zn[L]); for (j=2; j <= q; j++) N_VLinearSum(l[j], zn[L], ONE, zn[j], zn[j]); if (quadr) { N_VScale(A1, znQ[indx_acor], znQ[L]); for (j=2; j <= q; j++) N_VLinearSum(l[j], znQ[L], ONE, znQ[j], znQ[j]); } if (sensi) { for (is=0; is= 2; i--) l[i] = l[i]*xi + l[i-1]; } for (j=2; j < q; j++) N_VLinearSum(-l[j], zn[q], ONE, zn[j], zn[j]); if (quadr) { for (j=2; j < q; j++) N_VLinearSum(-l[j], znQ[q], ONE, znQ[j], znQ[j]); } if (sensi) { for (is=0; is ZERO) tn = tstop; } for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, zn[j-1], ONE, zn[j], zn[j-1]); if (quadr) { for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, znQ[j-1], ONE, znQ[j], znQ[j-1]); } if (sensi) { for (is=0; is= k; j--) N_VLinearSum(ONE, znS[j-1][is], ONE, znS[j][is], znS[j-1][is]); } } if (quadr_sensi) { for (is=0; is= k; j--) N_VLinearSum(ONE, znQS[j-1][is], ONE, znQS[j][is], znQS[j-1][is]); } } } /* * cvSet * * This routine is a high level routine which calls cvSetAdams or * cvSetBDF to set the polynomial l, the test quantity array tq, * and the related variables rl1, gamma, and gamrat. * * The array tq is loaded with constants used in the control of estimated * local errors and in the nonlinear convergence test. Specifically, while * running at order q, the components of tq are as follows: * tq[1] = a coefficient used to get the est. local error at order q-1 * tq[2] = a coefficient used to get the est. local error at order q * tq[3] = a coefficient used to get the est. local error at order q+1 * tq[4] = constant used in nonlinear iteration convergence test * tq[5] = coefficient used to get the order q+2 derivative vector used in * the est. local error at order q+1 */ static void cvSet(CVodeMem cv_mem) { switch(lmm) { case CV_ADAMS: cvSetAdams(cv_mem); break; case CV_BDF: cvSetBDF(cv_mem); break; } rl1 = ONE / l[1]; gamma = h * rl1; if (nst == 0) gammap = gamma; gamrat = (nst > 0) ? gamma / gammap : ONE; /* protect x / x != 1.0 */ } /* * cvSetAdams * * This routine handles the computation of l and tq for the * case lmm == CV_ADAMS. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * (d/dx) Lambda(x) = c * PRODUCT (1 + x / xi_i) , where * i=1 * Lambda(-1) = 0, Lambda(0) = 1, and c is a normalization factor. * Here xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void cvSetAdams(CVodeMem cv_mem) { realtype m[L_MAX], M[3], hsum; if (q == 1) { l[0] = l[1] = tq[1] = tq[5] = ONE; tq[2] = HALF; tq[3] = ONE/TWELVE; tq[4] = nlscoef / tq[2]; /* = 0.1 / tq[2] */ return; } hsum = cvAdamsStart(cv_mem, m); M[0] = cvAltSum(q-1, m, 1); M[1] = cvAltSum(q-1, m, 2); cvAdamsFinish(cv_mem, m, M, hsum); } /* * cvAdamsStart * * This routine generates in m[] the coefficients of the product * polynomial needed for the Adams l and tq coefficients for q > 1. */ static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]) { realtype hsum, xi_inv, sum; int i, j; hsum = h; m[0] = ONE; for (i=1; i <= q; i++) m[i] = ZERO; for (j=1; j < q; j++) { if ((j==q-1) && (qwait == 1)) { sum = cvAltSum(q-2, m, 2); tq[1] = q * sum / m[q-2]; } xi_inv = h / hsum; for (i=j; i >= 1; i--) m[i] += m[i-1] * xi_inv; hsum += tau[j]; /* The m[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } return(hsum); } /* * cvAdamsFinish * * This routine completes the calculation of the Adams l and tq. */ static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum) { int i; realtype M0_inv, xi, xi_inv; M0_inv = ONE / M[0]; l[0] = ONE; for (i=1; i <= q; i++) l[i] = M0_inv * (m[i-1] / i); xi = hsum / h; xi_inv = ONE / xi; tq[2] = M[1] * M0_inv / xi; tq[5] = xi / l[q]; if (qwait == 1) { for (i=q; i >= 1; i--) m[i] += m[i-1] * xi_inv; M[2] = cvAltSum(q, m, 2); tq[3] = M[2] * M0_inv / L; } tq[4] = nlscoef / tq[2]; } /* * cvAltSum * * cvAltSum returns the value of the alternating sum * sum (i= 0 ... iend) [ (-1)^i * (a[i] / (i + k)) ]. * If iend < 0 then cvAltSum returns 0. * This operation is needed to compute the integral, from -1 to 0, * of a polynomial x^(k-1) M(x) given the coefficients of M(x). */ static realtype cvAltSum(int iend, realtype a[], int k) { int i, sign; realtype sum; if (iend < 0) return(ZERO); sum = ZERO; sign = 1; for (i=0; i <= iend; i++) { sum += sign * (a[i] / (i+k)); sign = -sign; } return(sum); } /* * cvSetBDF * * This routine computes the coefficients l and tq in the case * lmm == CV_BDF. cvSetBDF calls cvSetTqBDF to set the test * quantity array tq. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * Lambda(x) = (1 + x / xi*_q) * PRODUCT (1 + x / xi_i) , where * i=1 * xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void cvSetBDF(CVodeMem cv_mem) { realtype alpha0, alpha0_hat, xi_inv, xistar_inv, hsum; int i,j; l[0] = l[1] = xi_inv = xistar_inv = ONE; for (i=2; i <= q; i++) l[i] = ZERO; alpha0 = alpha0_hat = -ONE; hsum = h; if (q > 1) { for (j=2; j < q; j++) { hsum += tau[j-1]; xi_inv = h / hsum; alpha0 -= ONE / j; for (i=j; i >= 1; i--) l[i] += l[i-1]*xi_inv; /* The l[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } /* j = q */ alpha0 -= ONE / q; xistar_inv = -l[1] - alpha0; hsum += tau[q-1]; xi_inv = h / hsum; alpha0_hat = -l[1] - xi_inv; for (i=q; i >= 1; i--) l[i] += l[i-1]*xistar_inv; } cvSetTqBDF(cv_mem, hsum, alpha0, alpha0_hat, xi_inv, xistar_inv); } /* * cvSetTqBDF * * This routine sets the test quantity array tq in the case * lmm == CV_BDF. */ static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv) { realtype A1, A2, A3, A4, A5, A6; realtype C, Cpinv, Cppinv; A1 = ONE - alpha0_hat + alpha0; A2 = ONE + q * A1; tq[2] = ABS(A1 / (alpha0 * A2)); tq[5] = ABS(A2 * xistar_inv / (l[q] * xi_inv)); if (qwait == 1) { if (q > 1) { C = xistar_inv / l[q]; A3 = alpha0 + ONE / q; A4 = alpha0_hat + xi_inv; Cpinv = (ONE - A4 + A3) / A3; tq[1] = ABS(C * Cpinv); } else tq[1] = ONE; hsum += tau[q]; xi_inv = h / hsum; A5 = alpha0 - (ONE / (q+1)); A6 = alpha0_hat - xi_inv; Cppinv = (ONE - A6 + A5) / A2; tq[3] = ABS(Cppinv / (xi_inv * (q+2) * A5)); } tq[4] = nlscoef / tq[2]; } /* * ----------------------------------------------------------------- * Nonlinear solver functions * ----------------------------------------------------------------- */ /* * cvNls * * This routine attempts to solve the nonlinear system associated * with a single implicit step of the linear multistep method. * Depending on iter, it calls cvNlsFunctional or cvNlsNewton * to do the work. */ static int cvNls(CVodeMem cv_mem, int nflag) { int flag=CV_SUCCESS; switch(iter) { case CV_FUNCTIONAL: flag = cvNlsFunctional(cv_mem); break; case CV_NEWTON: flag = cvNlsNewton(cv_mem, nflag); break; } return(flag); } /* * cvNlsFunctional * * This routine attempts to solve the nonlinear system using * functional iteration (no matrices involved). * * This routine also handles the functional iteration of the * combined system (states + sensitivities) when sensitivities are * computed using the CV_SIMULTANEOUS approach. * * Possible return values are: * * CV_SUCCESS ---> continue with error test * * CV_RHSFUNC_FAIL -+ * CV_SRHSFUNC_FAIL -+-> halt the integration * * CONV_FAIL -+ * RHSFUNC_RECVR |-> predict again or stop if too many * SRHSFUNC_RECVR -+ * */ static int cvNlsFunctional(CVodeMem cv_mem) { int m; realtype del, delS, Del, Delp, dcon; int retval, is; booleantype do_sensi_sim; N_Vector wrk1, wrk2; /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); /* Initialize counter and evaluate f at predicted y */ crate = ONE; m = 0; /* Initialize delS and Delp to avoid compiler warning message */ delS = Delp = ZERO; retval = f(tn, zn[0], tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); if (do_sensi_sim) { wrk1 = ftemp; wrk2 = ftempS[0]; retval = cvSensRhsWrapper(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } /* Initialize correction to zero */ N_VConst(ZERO, acor); if (do_sensi_sim) { for (is=0; is 0, an estimate of the convergence rate constant is stored in crate, and used in the test. Recall that, even when errconS=FALSE, all variables are used in the convergence test. Hence, we use Del (and not del). However, acnrm is used in the error test and thus it has different forms depending on errconS (and this explains why we have to carry around del and delS) */ Del = (do_sensi_sim) ? delS : del; if (m > 0) crate = MAX(CRDOWN * crate, Del / Delp); dcon = Del * MIN(ONE, crate) / tq[4]; if (dcon <= ONE) { if (m == 0) if (do_sensi_sim && errconS) acnrm = delS; else acnrm = del; else { acnrm = N_VWrmsNorm(acor, ewt); if (do_sensi_sim && errconS) acnrm = cvSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); } return(CV_SUCCESS); /* Convergence achieved */ } /* Stop at maxcor iterations or if iter. seems to be diverging */ m++; if ((m==maxcor) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); /* Save norm of correction, evaluate f, and loop again */ Delp = Del; retval = f(tn, y, tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); if (do_sensi_sim) { wrk1 = ftemp; wrk2 = ftempS[0]; retval = cvSensRhsWrapper(cv_mem, tn, y, tempv, yS, tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } } /* end loop */ } /* * cvNlsNewton * * This routine handles the Newton iteration. It calls lsetup if * indicated, calls cvNewtonIteration to perform the iteration, and * retries a failed attempt at Newton iteration if that is indicated. * See return values at top of this file. * * This routine also handles the Newton iteration of the combined * system when sensitivities are computed using the CV_SIMULTANEOUS * approach. Since in that case we use a quasi-Newton on the * combined system (by approximating the Jacobian matrix by its * block diagonal) and thus only solve linear systems with * multiple right hand sides (all sharing the same coefficient * matrix - whatever iteration matrix we decide on) we set-up * the linear solver to handle N equations at a time. * * Possible return values: * * CV_SUCCESS ---> continue with error test * * CV_RHSFUNC_FAIL -+ * CV_LSETUP_FAIL | * CV_LSOLVE_FAIL |-> halt the integration * CV_SRHSFUNC_FAIL -+ * * CONV_FAIL -+ * RHSFUNC_RECVR |-> predict again or stop if too many * SRHSFUNC_RECVR -+ * */ static int cvNlsNewton(CVodeMem cv_mem, int nflag) { N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; int convfail, ier; booleantype callSetup, do_sensi_sim; int retval, is; /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ do_sensi_sim = (sensi && (ism==CV_SIMULTANEOUS)); vtemp1 = acor; /* rename acor as vtemp1 for readability */ vtemp2 = y; /* rename y as vtemp2 for readability */ vtemp3 = tempv; /* rename tempv as vtemp3 for readability */ /* Set flag convfail, input to lsetup for its evaluation decision */ convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? CV_NO_FAILURES : CV_FAIL_OTHER; /* Decide whether or not to call setup routine (if one exists) */ if (setupNonNull) { callSetup = (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || (nst == 0) || (nst >= nstlp + MSBP) || (ABS(gamrat-ONE) > DGMAX); /* Decide whether to force a call to setup */ if (forceSetup) { callSetup = TRUE; convfail = CV_FAIL_OTHER; } } else { crate = ONE; crateS = ONE; /* if NO lsetup all conv. rates are set to ONE */ callSetup = FALSE; } /* Looping point for the solution of the nonlinear system. Evaluate f at the predicted y, call lsetup if indicated, and call cvNewtonIteration for the Newton iteration itself. */ loop { retval = f(tn, zn[0], ftemp, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); if (do_sensi_sim) { wrk1 = tempv; wrk2 = tempvS[0]; retval = cvSensRhsWrapper(cv_mem, tn, zn[0], ftemp, znS[0], ftempS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } if (callSetup) { ier = lsetup(cv_mem, convfail, zn[0], ftemp, &jcur, vtemp1, vtemp2, vtemp3); nsetups++; callSetup = FALSE; forceSetup = FALSE; gamrat = ONE; gammap = gamma; crate = ONE; crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ nstlp = nst; /* Return if lsetup failed */ if (ier < 0) return(CV_LSETUP_FAIL); if (ier > 0) return(CONV_FAIL); } /* Set acor to zero and load prediction into y vector */ N_VConst(ZERO, acor); N_VScale(ONE, zn[0], y); if (do_sensi_sim) for (is=0; is 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Solve the sensitivity linear systems and do the same tests on the return value of lsolve. */ if (do_sensi_sim) { for (is=0; is 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } } } /* Get WRMS norm of correction; add correction to acor and y */ del = N_VWrmsNorm(b, ewt); N_VLinearSum(ONE, acor, ONE, b, acor); N_VLinearSum(ONE, zn[0], ONE, acor, y); if (do_sensi_sim) { delS = cvSensUpdateNorm(cv_mem, del, bS, ewtS); for (is=0; is 0, an estimate of the convergence rate constant is stored in crate, and used in the test. */ Del = (do_sensi_sim) ? delS : del; if (m > 0) crate = MAX(CRDOWN * crate, Del/Delp); dcon = Del * MIN(ONE, crate) / tq[4]; if (dcon <= ONE) { if (m == 0) if (do_sensi_sim && errconS) acnrm = delS; else acnrm = del; else { acnrm = N_VWrmsNorm(acor, ewt); if (do_sensi_sim && errconS) acnrm = cvSensUpdateNorm(cv_mem, acnrm, acorS, ewtS); } jcur = FALSE; return(CV_SUCCESS); /* Convergence achieved */ } mnewt = ++m; /* Stop at maxcor iterations or if iter. seems to be diverging. If still not converged and Jacobian data is not current, signal to try the solution again */ if ((m == maxcor) || ((m >= 2) && (Del > RDIV * Delp))) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Save norm of correction, evaluate f, and loop again */ Delp = Del; retval = f(tn, y, ftemp, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(RHSFUNC_RECVR); } if (do_sensi_sim) { wrk1 = tempv; wrk2 = tempvS[0]; retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(SRHSFUNC_RECVR); } } } /* end loop */ } /* * cvQuadNls * * This routine solves for the quadrature variables at the new step. * It does not solve a nonlinear system, but rather updates the * quadrature variables. The name for this function is just for * uniformity purposes. * * Possible return values (interpreted by cvHandleNFlag) * * CV_SUCCESS -> continue with error test * CV_QRHSFUNC_FAIL -> halt the integration * QRHSFUNC_RECVR -> predict again or stop if too many * */ static int cvQuadNls(CVodeMem cv_mem) { int retval; /* Save quadrature correction in acorQ */ retval = fQ(tn, y, acorQ, user_data); nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(QRHSFUNC_RECVR); /* If needed, save the value of yQdot = fQ into ftempQ * for use in evaluating fQS */ if (quadr_sensi) { N_VScale(ONE, acorQ, ftempQ); } N_VLinearSum(h, acorQ, -ONE, znQ[1], acorQ); N_VScale(rl1, acorQ, acorQ); /* Apply correction to quadrature variables */ N_VLinearSum(ONE, znQ[0], ONE, acorQ, yQ); return(CV_SUCCESS); } /* * cvQuadSensNls * * This routine solves for the quadrature sensitivity variables * at the new step. It does not solve a nonlinear system, but * rather updates the quadrature variables. The name for this * function is just for uniformity purposes. * * Possible return values (interpreted by cvHandleNFlag) * * CV_SUCCESS -> continue with error test * CV_QSRHSFUNC_FAIL -> halt the integration * QSRHSFUNC_RECVR -> predict again or stop if too many * */ static int cvQuadSensNls(CVodeMem cv_mem) { int is, retval; /* Save quadrature correction in acorQ */ retval = fQS(Ns, tn, y, yS, ftempQ, acorQS, user_data, tempv, tempvQ); nfQSe++; if (retval < 0) return(CV_QSRHSFUNC_FAIL); if (retval > 0) return(QSRHSFUNC_RECVR); for (is=0; is 0) return(SRHSFUNC_RECVR); /* Initialize correction to zero */ for (is=0; is 0, an estimate of the convergence rate constant is stored in crateS, and used in the test. acnrmS contains the norm of the corrections (yS_n-yS_n(0)) and will be used in the error test (if errconS==TRUE) */ if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); dcon = Del * MIN(ONE, crateS) / tq[4]; if (dcon <= ONE) { if (errconS) acnrmS = (m==0)? Del : cvSensNorm(cv_mem, acorS, ewtS); return(CV_SUCCESS); /* Convergence achieved */ } /* Stop at maxcor iterations or if iter. seems to be diverging */ m++; if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); /* Save norm of correction, evaluate f, and loop again */ Delp = Del; wrk1 = tempv; wrk2 = ftempS[0]; retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } /* end loop */ } /* * cvStgrNlsNewton * * This routine attempts to solve the sensitivity linear systems using * Newton iteration. It calls cvStgrNlsNewton to perform the actual * iteration. If the Newton iteration fails with out-of-date Jacobian * data (ier=TRY_AGAIN), it calls lsetup and retries the Newton iteration. * This second try is unlikely to happen when using a Krylov linear solver. * * Possible return values: * * CV_SUCCESS * * CV_LSOLVE_FAIL -+ * CV_LSETUP_FAIL | * CV_SRHSFUNC_FAIL -+ * * CONV_FAIL -+ * SRHSFUNC_RECVR -+ */ static int cvStgrNlsNewton(CVodeMem cv_mem) { int retval, is; int convfail, ier; N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; loop { /* Set acorS to zero and load prediction into yS vector */ for (is=0; is 0) return(SRHSFUNC_RECVR); /* Do the Newton iteration */ ier = cvStgrNewtonIteration(cv_mem); /* If the solve was successful (ier=CV_SUCCESS) or if an error that cannot be fixed by a call to lsetup occured (ier = CV_LSOLVE_FAIL or CONV_FAIL) return */ if (ier != TRY_AGAIN) return(ier); /* There was a convergence failure and the Jacobian-related data appears not to be current. Call lsetup with convfail=CV_FAIL_BAD_J and then loop again */ convfail = CV_FAIL_BAD_J; /* Rename some vectors for readibility */ vtemp1 = tempv; vtemp2 = yS[0]; vtemp3 = ftempS[0]; /* Call linear solver setup at converged y */ ier = lsetup(cv_mem, convfail, y, ftemp, &jcur, vtemp1, vtemp2, vtemp3); nsetups++; nsetupsS++; gamrat = ONE; gammap = gamma; crate = ONE; crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ nstlp = nst; /* Return if lsetup failed */ if (ier < 0) return(CV_LSETUP_FAIL); if (ier > 0) return(CONV_FAIL); } /* end loop */ } /* * cvStgrNewtonIteration * * This routine performs the Newton iteration for all sensitivities. * If the iteration succeeds, it returns the value CV_SUCCESS. * If not, it may signal the cvStgrNlsNewton routine to call lsetup and * reattempt the iteration, by returning the value TRY_AGAIN. (In this case, * cvStgrNlsNewton must set convfail to CV_FAIL_BAD_J before calling setup again). * Otherwise, this routine returns one of the appropriate values * CV_LSOLVE_FAIL or CONV_FAIL back to cvStgrNlsNewton. */ static int cvStgrNewtonIteration(CVodeMem cv_mem) { int m, retval; realtype Del, Delp, dcon; N_Vector *bS, wrk1, wrk2; int is; m = 0; /* Initialize Delp to avoid compiler warning message */ Delp = ZERO; /* ftemp <- f(t_n, y_n) y <- y_n ftempS <- fS(t_n, y_n(0), s_n(0)) acorS <- 0 yS <- yS_n(0) */ loop { /* Evaluate the residual of the nonlinear systems */ for (is=0; is 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } } /* Get norm of correction; add correction to acorS and yS */ Del = cvSensNorm(cv_mem, bS, ewtS); for (is=0; is 0, an estimate of the convergence rate constant is stored in crateS, and used in the test. */ if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); dcon = Del * MIN(ONE, crateS) / tq[4]; if (dcon <= ONE) { if (errconS) acnrmS = (m==0) ? Del : cvSensNorm(cv_mem, acorS, ewtS); jcur = FALSE; return(CV_SUCCESS); /* Convergence achieved */ } m++; /* Stop at maxcor iterations or if iter. seems to be diverging. If still not converged and Jacobian data is not current, signal to try the solution again */ if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Save norm of correction, evaluate fS, and loop again */ Delp = Del; wrk1 = tempv; wrk2 = tempvS[0]; retval = cvSensRhsWrapper(cv_mem, tn, y, ftemp, yS, ftempS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(SRHSFUNC_RECVR); } } /* end loop */ } /* * cvStgr1Nls * * This is a high-level routine that attempts to solve the i-th * sensitivity linear system using nonlinear iterations (CV_FUNCTIONAL * or CV_NEWTON - depending on the value of iter) once the states y_n * were obtained and passed the error test. */ static int cvStgr1Nls(CVodeMem cv_mem, int is) { int flag=CV_SUCCESS; switch(iter) { case CV_FUNCTIONAL: flag = cvStgr1NlsFunctional(cv_mem,is); break; case CV_NEWTON: flag = cvStgr1NlsNewton(cv_mem,is); break; } return(flag); } /* * cvStgr1NlsFunctional * * This routine attempts to solve the i-th sensitivity linear system * using functional iteration (no matrices involved). * * Possible return values: * CV_SUCCESS, * CV_SRHSFUNC_FAIL, * CONV_FAIL, SRHSFUNC_RECVR */ static int cvStgr1NlsFunctional(CVodeMem cv_mem, int is) { int retval, m; realtype Del, Delp, dcon; N_Vector wrk1, wrk2; /* Initialize estimated conv. rate and counter */ crateS = ONE; m = 0; /* Initialize Delp to avoid compiler warning message */ Delp = ZERO; /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ wrk1 = tempv; wrk2 = ftempS[0]; retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, znS[0][is], tempvS[is], wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* Initialize correction to zero */ N_VConst(ZERO,acorS[is]); /* Loop until convergence; accumulate corrections in acorS */ loop { nniS1[is]++; /* Correct yS from last fS value */ N_VLinearSum(h, tempvS[is], -ONE, znS[1][is], tempvS[is]); N_VScale(rl1, tempvS[is], tempvS[is]); N_VLinearSum(ONE, znS[0][is], ONE, tempvS[is], yS[is]); /* Get WRMS norm of current correction to use in convergence test */ N_VLinearSum(ONE, tempvS[is], -ONE, acorS[is], acorS[is]); Del = N_VWrmsNorm(acorS[is], ewtS[is]); N_VScale(ONE, tempvS[is], acorS[is]); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crateS, and used in the test. */ if (m > 0) crateS = MAX(CRDOWN * crateS, Del / Delp); dcon = Del * MIN(ONE, crateS) / tq[4]; if (dcon <= ONE) { return(CV_SUCCESS); /* Convergence achieved */ } /* Stop at maxcor iterations or if iter. seems to be diverging */ m++; if ((m==maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) return(CONV_FAIL); /* Save norm of correction, evaluate f, and loop again */ Delp = Del; wrk1 = tempv; wrk2 = ftempS[0]; retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], tempvS[is], wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } /* end loop */ } /* * cvStgr1NlsNewton * * This routine attempts to solve the i-th sensitivity linear system * using Newton iteration. It calls cvStgr1NlsNewton to perform the * actual iteration. If the Newton iteration fails with out-of-date * Jacobian data (ier=TRY_AGAIN), it calls lsetup and retries the * Newton iteration. This second try is unlikely to happen when * using a Krylov linear solver. * * Possible return values: * * CV_SUCCESS * * CV_LSOLVE_FAIL * CV_LSETUP_FAIL * CV_SRHSFUNC_FAIL * * CONV_FAIL * SRHSFUNC_RECVR */ static int cvStgr1NlsNewton(CVodeMem cv_mem, int is) { int convfail, retval, ier; N_Vector vtemp1, vtemp2, vtemp3, wrk1, wrk2; loop { /* Set acorS to zero and load prediction into yS vector */ N_VConst(ZERO, acorS[is]); N_VScale(ONE, znS[0][is], yS[is]); /* Evaluate fS at predicted yS but with converged y (and corresponding f) */ wrk1 = tempv; wrk2 = tempvS[0]; retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* Do the Newton iteration */ ier = cvStgr1NewtonIteration(cv_mem, is); /* If the solve was successful (ier=CV_SUCCESS) or if an error that cannot be fixed by a call to lsetup occured (ier = CV_LSOLVE_FAIL or CONV_FAIL) return */ if (ier != TRY_AGAIN) return(ier); /* There was a convergence failure and the Jacobian-related data appears not to be current. Call lsetup with convfail=CV_FAIL_BAD_J and then loop again */ convfail = CV_FAIL_BAD_J; /* Rename some vectors for readibility */ vtemp1 = tempv; vtemp2 = yS[0]; vtemp3 = ftempS[0]; /* Call linear solver setup at converged y */ ier = lsetup(cv_mem, convfail, y, ftemp, &jcur, vtemp1, vtemp2, vtemp3); nsetups++; nsetupsS++; gamrat = ONE; crate = ONE; crateS = ONE; /* after lsetup all conv. rates are reset to ONE */ gammap = gamma; nstlp = nst; /* Return if lsetup failed */ if (ier < 0) return(CV_LSETUP_FAIL); if (ier > 0) return(CONV_FAIL); } /* end loop */ } /* * cvStgr1NewtonIteration * * This routine performs the Newton iteration for the i-th sensitivity. * If the iteration succeeds, it returns the value CV_SUCCESS. * If not, it may signal the cvStgr1NlsNewton routine to call lsetup * and reattempt the iteration, by returning the value TRY_AGAIN. * (In this case, cvStgr1NlsNewton must set convfail to CV_FAIL_BAD_J * before calling setup again). Otherwise, this routine returns one * of the appropriate values CV_LSOLVE_FAIL or CONV_FAIL back to * cvStgr1NlsNewton. */ static int cvStgr1NewtonIteration(CVodeMem cv_mem, int is) { int m, retval; realtype Del, Delp, dcon; N_Vector *bS, wrk1, wrk2; m = 0; /* Initialize Delp to avoid compiler warning message */ Delp = ZERO; /* ftemp <- f(t_n, y_n) y <- y_n ftempS[is] <- fS(is, t_n, y_n(0), s_n(0)) acorS[is] <- 0 yS[is] <- yS_n(0)[is] */ loop { /* Evaluate the residual of the nonlinear systems */ N_VLinearSum(rl1, znS[1][is], ONE, acorS[is], tempvS[is]); N_VLinearSum(gamma, ftempS[is], -ONE, tempvS[is], tempvS[is]); /* Call the lsolve function */ bS = tempvS; nniS1[is]++; retval = lsolve(cv_mem, bS[is], ewtS[is], y, ftemp); /* Unrecoverable error in lsolve */ if (retval < 0) return(CV_LSOLVE_FAIL); /* Recoverable error in lsolve and Jacobian data not current */ if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Get norm of correction; add correction to acorS and yS */ Del = N_VWrmsNorm(bS[is], ewtS[is]); N_VLinearSum(ONE, acorS[is], ONE, bS[is], acorS[is]); N_VLinearSum(ONE, znS[0][is], ONE, acorS[is], yS[is]); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crateS, and used in the test. */ if (m > 0) crateS = MAX(CRDOWN * crateS, Del/Delp); dcon = Del * MIN(ONE, crateS) / tq[4]; if (dcon <= ONE) { jcur = FALSE; return(CV_SUCCESS); /* Convergence achieved */ } m++; /* Stop at maxcor iterations or if iter. seems to be diverging. If still not converged and Jacobian data is not current, signal to try the solution again */ if ((m == maxcorS) || ((m >= 2) && (Del > RDIV * Delp))) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(CONV_FAIL); } /* Save norm of correction, evaluate fS, and loop again */ Delp = Del; wrk1 = tempv; wrk2 = tempvS[0]; retval = cvSensRhs1Wrapper(cv_mem, tn, y, ftemp, is, yS[is], ftempS[is], wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) { if ((!jcur) && (setupNonNull)) return(TRY_AGAIN); else return(SRHSFUNC_RECVR); } } /* end loop */ } /* * cvHandleNFlag * * This routine takes action on the return value nflag = *nflagPtr * returned by cvNls, as follows: * * If cvNls succeeded in solving the nonlinear system, then * cvHandleNFlag returns the constant DO_ERROR_TEST, which tells cvStep * to perform the error test. * * If the nonlinear system was not solved successfully, then ncfn and * ncf = *ncfPtr are incremented and Nordsieck array zn is restored. * * If the solution of the nonlinear system failed due to an * unrecoverable failure by setup, we return the value CV_LSETUP_FAIL. * * If it failed due to an unrecoverable failure in solve, then we return * the value CV_LSOLVE_FAIL. * * If it failed due to an unrecoverable failure in rhs, then we return * the value CV_RHSFUNC_FAIL. * * If it failed due to an unrecoverable failure in quad rhs, then we return * the value CV_QRHSFUNC_FAIL. * * If it failed due to an unrecoverable failure in sensi rhs, then we return * the value CV_SRHSFUNC_FAIL. * * Otherwise, a recoverable failure occurred when solving the * nonlinear system (cvNls returned nflag = CONV_FAIL, RHSFUNC_RECVR, or * SRHSFUNC_RECVR). * In this case, if ncf is now equal to maxncf or |h| = hmin, * we return the value CV_CONV_FAILURE (if nflag=CONV_FAIL), or * CV_REPTD_RHSFUNC_ERR (if nflag=RHSFUNC_RECVR), or CV_REPTD_SRHSFUNC_ERR * (if nflag=SRHSFUNC_RECVR). * If not, we set *nflagPtr = PREV_CONV_FAIL and return the value * PREDICT_AGAIN, telling cvStep to reattempt the step. * */ static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr, long int *ncfnPtr) { int nflag; nflag = *nflagPtr; if (nflag == CV_SUCCESS) return(DO_ERROR_TEST); /* The nonlinear soln. failed; increment ncfn and restore zn */ (*ncfnPtr)++; cvRestore(cv_mem, saved_t); /* Return if lsetup, lsolve, or some rhs failed unrecoverably */ if (nflag == CV_LSETUP_FAIL) return(CV_LSETUP_FAIL); if (nflag == CV_LSOLVE_FAIL) return(CV_LSOLVE_FAIL); if (nflag == CV_RHSFUNC_FAIL) return(CV_RHSFUNC_FAIL); if (nflag == CV_QRHSFUNC_FAIL) return(CV_QRHSFUNC_FAIL); if (nflag == CV_SRHSFUNC_FAIL) return(CV_SRHSFUNC_FAIL); if (nflag == CV_QSRHSFUNC_FAIL) return(CV_QSRHSFUNC_FAIL); /* At this point, nflag = CONV_FAIL, RHSFUNC_RECVR, or SRHSFUNC_RECVR; increment ncf */ (*ncfPtr)++; etamax = ONE; /* If we had maxncf failures or |h| = hmin, return CV_CONV_FAILURE, CV_REPTD_RHSFUNC_ERR, CV_REPTD_QRHSFUNC_ERR, or CV_REPTD_SRHSFUNC_ERR */ if ((ABS(h) <= hmin*ONEPSM) || (*ncfPtr == maxncf)) { if (nflag == CONV_FAIL) return(CV_CONV_FAILURE); if (nflag == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); if (nflag == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); if (nflag == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); if (nflag == QSRHSFUNC_RECVR) return(CV_REPTD_QSRHSFUNC_ERR); } /* Reduce step size; return to reattempt the step */ eta = MAX(ETACF, hmin / ABS(h)); *nflagPtr = PREV_CONV_FAIL; cvRescale(cv_mem); return(PREDICT_AGAIN); } /* * cvRestore * * This routine restores the value of tn to saved_t and undoes the * prediction. After execution of cvRestore, the Nordsieck array zn has * the same values as before the call to cvPredict. */ static void cvRestore(CVodeMem cv_mem, realtype saved_t) { int j, k; int is; tn = saved_t; for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, zn[j-1], -ONE, zn[j], zn[j-1]); if (quadr) { for (k = 1; k <= q; k++) for (j = q; j >= k; j--) N_VLinearSum(ONE, znQ[j-1], -ONE, znQ[j], znQ[j-1]); } if (sensi) { for (is=0; is= k; j--) N_VLinearSum(ONE, znS[j-1][is], -ONE, znS[j][is], znS[j-1][is]); } } if (quadr_sensi) { for (is=0; is= k; j--) N_VLinearSum(ONE, znQS[j-1][is], -ONE, znQS[j][is], znQS[j-1][is]); } } } /* * ----------------------------------------------------------------- * Error Test * ----------------------------------------------------------------- */ /* * cvDoErrorTest * * This routine performs the local error test, for the state, quadrature, * or sensitivity variables. Its last three arguments change depending * on which variables the error test is to be performed on. * * The weighted local error norm dsm is loaded into *dsmPtr, and * the test dsm ?<= 1 is made. * * If the test passes, cvDoErrorTest returns CV_SUCCESS. * * If the test fails, we undo the step just taken (call cvRestore) and * * - if maxnef error test failures have occurred or if ABS(h) = hmin, * we return CV_ERR_FAILURE. * * - if more than MXNEF1 error test failures have occurred, an order * reduction is forced. If already at order 1, restart by reloading * zn from scratch (also znQ and znS if appropriate). * If f() fails, we return CV_RHSFUNC_FAIL or CV_UNREC_RHSFUNC_ERR; * if fQ() fails, we return CV_QRHSFUNC_FAIL or CV_UNREC_QRHSFUNC_ERR; * if cvSensRhsWrapper() fails, we return CV_SRHSFUNC_FAIL or CV_UNREC_SRHSFUNC_ERR; * (no recovery is possible at this stage). * * - otherwise, set *nflagPtr to PREV_ERR_FAIL, and return TRY_AGAIN. * */ static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, realtype acor_nrm, int *nefPtr, long int *netfPtr, realtype *dsmPtr) { realtype dsm; int retval, is; N_Vector wrk1, wrk2; dsm = acor_nrm * tq[2]; /* If est. local error norm dsm passes test, return CV_SUCCESS */ *dsmPtr = dsm; if (dsm <= ONE) return(CV_SUCCESS); /* Test failed; increment counters, set nflag, and restore zn array */ (*nefPtr)++; (*netfPtr)++; *nflagPtr = PREV_ERR_FAIL; cvRestore(cv_mem, saved_t); /* At maxnef failures or |h| = hmin, return CV_ERR_FAILURE */ if ((ABS(h) <= hmin*ONEPSM) || (*nefPtr == maxnef)) return(CV_ERR_FAILURE); /* Set etamax = 1 to prevent step size increase at end of this step */ etamax = ONE; /* Set h ratio eta from dsm, rescale, and return for retry of step */ if (*nefPtr <= MXNEF1) { eta = ONE / (RPowerR(BIAS2*dsm,ONE/L) + ADDON); eta = MAX(ETAMIN, MAX(eta, hmin / ABS(h))); if (*nefPtr >= SMALL_NEF) eta = MIN(eta, ETAMXF); cvRescale(cv_mem); return(TRY_AGAIN); } /* After MXNEF1 failures, force an order reduction and retry step */ if (q > 1) { eta = MAX(ETAMIN, hmin / ABS(h)); cvAdjustOrder(cv_mem,-1); L = q; q--; qwait = L; cvRescale(cv_mem); return(TRY_AGAIN); } /* If already at order 1, restart: reload zn, znQ, znS, znQS from scratch */ eta = MAX(ETAMIN, hmin / ABS(h)); h *= eta; next_h = h; hscale = h; qwait = LONG_WAIT; nscon = 0; retval = f(tn, zn[0], tempv, user_data); nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_RHSFUNC_ERR); N_VScale(h, tempv, zn[1]); if (quadr) { retval = fQ(tn, zn[0], tempvQ, user_data); nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_QRHSFUNC_ERR); N_VScale(h, tempvQ, znQ[1]); } if (sensi) { wrk1 = ftemp; wrk2 = ftempS[0]; retval = cvSensRhsWrapper(cv_mem, tn, zn[0], tempv, znS[0], tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_SRHSFUNC_ERR); for (is=0; is 0) return(CV_UNREC_QSRHSFUNC_ERR); for (is=0; is= 2; i--) tau[i] = tau[i-1]; if ((q==1) && (nst > 1)) tau[2] = tau[1]; tau[1] = h; /* Apply correction to column j of zn: l_j * Delta_n */ for (j=0; j <= q; j++) N_VLinearSum(l[j], acor, ONE, zn[j], zn[j]); if (quadr) { for (j=0; j <= q; j++) N_VLinearSum(l[j], acorQ, ONE, znQ[j], znQ[j]); } if (sensi) { for (is=0; is 1) { ddn = N_VWrmsNorm(zn[q], ewt); if ( quadr && errconQ) { ddn = cvQuadUpdateNorm(cv_mem, ddn, znQ[q], ewtQ); } if ( sensi && errconS ) { ddn = cvSensUpdateNorm(cv_mem, ddn, znS[q], ewtS); } if ( quadr_sensi && errconQS ) { ddn = cvQuadSensUpdateNorm(cv_mem, ddn, znQS[q], ewtQS); } ddn = ddn * tq[1]; etaqm1 = ONE/(RPowerR(BIAS1*ddn, ONE/q) + ADDON); } return(etaqm1); } /* * cvComputeEtaqp1 * * This routine computes and returns the value of etaqp1 for a * possible increase in order by 1. */ static realtype cvComputeEtaqp1(CVodeMem cv_mem) { realtype dup, cquot; int is; etaqp1 = ZERO; if (q != qmax) { if (saved_tq5 == ZERO) return(etaqp1); cquot = (tq[5] / saved_tq5) * RPowerI(h/tau[2], L); N_VLinearSum(-cquot, zn[qmax], ONE, acor, tempv); dup = N_VWrmsNorm(tempv, ewt); if ( quadr && errconQ ) { N_VLinearSum(-cquot, znQ[qmax], ONE, acorQ, tempvQ); dup = cvQuadUpdateNorm(cv_mem, dup, tempvQ, ewtQ); } if ( sensi && errconS ) { for (is=0; is= 3) { for (k = 1; k <= 3; k++) for (i = 5; i >= 2; i--) ssdat[i][k] = ssdat[i-1][k]; factorial = 1; for (i = 1; i <= q-1; i++) factorial *= i; sq = factorial*q*(q+1)*acnrm/MAX(tq[5],TINY); sqm1 = factorial*q*N_VWrmsNorm(zn[q], ewt); sqm2 = factorial*N_VWrmsNorm(zn[q-1], ewt); ssdat[1][1] = sqm2*sqm2; ssdat[1][2] = sqm1*sqm1; ssdat[1][3] = sq*sq; } if (qprime >= q) { /* If order is 3 or greater, and enough ssdat has been saved, nscon >= q+5, then call stability limit detection routine. */ if ( (q >= 3) && (nscon >= q+5) ) { ldflag = cvSLdet(cv_mem); if (ldflag > 3) { /* A stability limit violation is indicated by a return flag of 4, 5, or 6. Reduce new order. */ qprime = q-1; eta = etaqm1; eta = MIN(eta,etamax); eta = eta/MAX(ONE,ABS(h)*hmax_inv*eta); hprime = h*eta; nor = nor + 1; } } } else { /* Otherwise, let order increase happen, and reset stability limit counter, nscon. */ nscon = 0; } } /* * cvSLdet * * This routine detects stability limitation using stored scaled * derivatives data. cvSLdet returns the magnitude of the * dominate characteristic root, rr. The presents of a stability * limit is indicated by rr > "something a little less then 1.0", * and a positive kflag. This routine should only be called if * order is greater than or equal to 3, and data has been collected * for 5 time steps. * * Returned values: * kflag = 1 -> Found stable characteristic root, normal matrix case * kflag = 2 -> Found stable characteristic root, quartic solution * kflag = 3 -> Found stable characteristic root, quartic solution, * with Newton correction * kflag = 4 -> Found stability violation, normal matrix case * kflag = 5 -> Found stability violation, quartic solution * kflag = 6 -> Found stability violation, quartic solution, * with Newton correction * * kflag < 0 -> No stability limitation, * or could not compute limitation. * * kflag = -1 -> Min/max ratio of ssdat too small. * kflag = -2 -> For normal matrix case, vmax > vrrt2*vrrt2 * kflag = -3 -> For normal matrix case, The three ratios * are inconsistent. * kflag = -4 -> Small coefficient prevents elimination of quartics. * kflag = -5 -> R value from quartics not consistent. * kflag = -6 -> No corrected root passes test on qk values * kflag = -7 -> Trouble solving for sigsq. * kflag = -8 -> Trouble solving for B, or R via B. * kflag = -9 -> R via sigsq[k] disagrees with R from data. */ static int cvSLdet(CVodeMem cv_mem) { int i, k, j, it, kmin=0, kflag=0; realtype rat[5][4], rav[4], qkr[4], sigsq[4], smax[4], ssmax[4]; realtype drr[4], rrc[4],sqmx[4], qjk[4][4], vrat[5], qc[6][4], qco[6][4]; realtype rr, rrcut, vrrtol, vrrt2, sqtol, rrtol; realtype smink, smaxk, sumrat, sumrsq, vmin, vmax, drrmax, adrr; realtype tem, sqmax, saqk, qp, s, sqmaxk, saqj, sqmin; realtype rsa, rsb, rsc, rsd, rd1a, rd1b, rd1c; realtype rd2a, rd2b, rd3a, cest1, corr1; realtype ratp, ratm, qfac1, qfac2, bb, rrb; /* The following are cutoffs and tolerances used by this routine */ rrcut = RCONST(0.98); vrrtol = RCONST(1.0e-4); vrrt2 = RCONST(5.0e-4); sqtol = RCONST(1.0e-3); rrtol = RCONST(1.0e-2); rr = ZERO; /* Index k corresponds to the degree of the interpolating polynomial. */ /* k = 1 -> q-1 */ /* k = 2 -> q */ /* k = 3 -> q+1 */ /* Index i is a backward-in-time index, i = 1 -> current time, */ /* i = 2 -> previous step, etc */ /* get maxima, minima, and variances, and form quartic coefficients */ for (k=1; k<=3; k++) { smink = ssdat[1][k]; smaxk = ZERO; for (i=1; i<=5; i++) { smink = MIN(smink,ssdat[i][k]); smaxk = MAX(smaxk,ssdat[i][k]); } if (smink < TINY*smaxk) { kflag = -1; return(kflag); } smax[k] = smaxk; ssmax[k] = smaxk*smaxk; sumrat = ZERO; sumrsq = ZERO; for (i=1; i<=4; i++) { rat[i][k] = ssdat[i][k]/ssdat[i+1][k]; sumrat = sumrat + rat[i][k]; sumrsq = sumrsq + rat[i][k]*rat[i][k]; } rav[k] = FOURTH*sumrat; vrat[k] = ABS(FOURTH*sumrsq - rav[k]*rav[k]); qc[5][k] = ssdat[1][k]*ssdat[3][k] - ssdat[2][k]*ssdat[2][k]; qc[4][k] = ssdat[2][k]*ssdat[3][k] - ssdat[1][k]*ssdat[4][k]; qc[3][k] = ZERO; qc[2][k] = ssdat[2][k]*ssdat[5][k] - ssdat[3][k]*ssdat[4][k]; qc[1][k] = ssdat[4][k]*ssdat[4][k] - ssdat[3][k]*ssdat[5][k]; for (i=1; i<=5; i++) { qco[i][k] = qc[i][k]; } } /* End of k loop */ /* Isolate normal or nearly-normal matrix case. Three quartic will have common or nearly-common roots in this case. Return a kflag = 1 if this procedure works. If three root differ more than vrrt2, return error kflag = -3. */ vmin = MIN(vrat[1],MIN(vrat[2],vrat[3])); vmax = MAX(vrat[1],MAX(vrat[2],vrat[3])); if (vmin < vrrtol*vrrtol) { if (vmax > vrrt2*vrrt2) { kflag = -2; return(kflag); } else { rr = (rav[1] + rav[2] + rav[3])/THREE; drrmax = ZERO; for (k = 1;k<=3;k++) { adrr = ABS(rav[k] - rr); drrmax = MAX(drrmax, adrr); } if (drrmax > vrrt2) kflag = -3; kflag = 1; /* can compute charactistic root, drop to next section */ } } else { /* use the quartics to get rr. */ if (ABS(qco[1][1]) < TINY*ssmax[1]) { kflag = -4; return(kflag); } tem = qco[1][2]/qco[1][1]; for (i=2; i<=5; i++) { qco[i][2] = qco[i][2] - tem*qco[i][1]; } qco[1][2] = ZERO; tem = qco[1][3]/qco[1][1]; for (i=2; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][1]; } qco[1][3] = ZERO; if (ABS(qco[2][2]) < TINY*ssmax[2]) { kflag = -4; return(kflag); } tem = qco[2][3]/qco[2][2]; for (i=3; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][2]; } if (ABS(qco[4][3]) < TINY*ssmax[3]) { kflag = -4; return(kflag); } rr = -qco[5][3]/qco[4][3]; if (rr < TINY || rr > HUN) { kflag = -5; return(kflag); } for (k=1; k<=3; k++) { qkr[k] = qc[5][k] + rr*(qc[4][k] + rr*rr*(qc[2][k] + rr*qc[1][k])); } sqmax = ZERO; for (k=1; k<=3; k++) { saqk = ABS(qkr[k])/ssmax[k]; if (saqk > sqmax) sqmax = saqk; } if (sqmax < sqtol) { kflag = 2; /* can compute charactistic root, drop to "given rr,etc" */ } else { /* do Newton corrections to improve rr. */ for (it=1; it<=3; it++) { for (k=1; k<=3; k++) { qp = qc[4][k] + rr*rr*(THREE*qc[2][k] + rr*FOUR*qc[1][k]); drr[k] = ZERO; if (ABS(qp) > TINY*ssmax[k]) drr[k] = -qkr[k]/qp; rrc[k] = rr + drr[k]; } for (k=1; k<=3; k++) { s = rrc[k]; sqmaxk = ZERO; for (j=1; j<=3; j++) { qjk[j][k] = qc[5][j] + s*(qc[4][j] + s*s*(qc[2][j] + s*qc[1][j])); saqj = ABS(qjk[j][k])/ssmax[j]; if (saqj > sqmaxk) sqmaxk = saqj; } sqmx[k] = sqmaxk; } sqmin = sqmx[1] + ONE; for (k=1; k<=3; k++) { if (sqmx[k] < sqmin) { kmin = k; sqmin = sqmx[k]; } } rr = rrc[kmin]; if (sqmin < sqtol) { kflag = 3; /* can compute charactistic root */ /* break out of Newton correction loop and drop to "given rr,etc" */ break; } else { for (j=1; j<=3; j++) { qkr[j] = qjk[j][kmin]; } } } /* end of Newton correction loop */ if (sqmin > sqtol) { kflag = -6; return(kflag); } } /* end of if (sqmax < sqtol) else */ } /* end of if (vmin < vrrtol*vrrtol) else, quartics to get rr. */ /* given rr, find sigsq[k] and verify rr. */ /* All positive kflag drop to this section */ for (k=1; k<=3; k++) { rsa = ssdat[1][k]; rsb = ssdat[2][k]*rr; rsc = ssdat[3][k]*rr*rr; rsd = ssdat[4][k]*rr*rr*rr; rd1a = rsa - rsb; rd1b = rsb - rsc; rd1c = rsc - rsd; rd2a = rd1a - rd1b; rd2b = rd1b - rd1c; rd3a = rd2a - rd2b; if (ABS(rd1b) < TINY*smax[k]) { kflag = -7; return(kflag); } cest1 = -rd3a/rd1b; if (cest1 < TINY || cest1 > FOUR) { kflag = -7; return(kflag); } corr1 = (rd2b/cest1)/(rr*rr); sigsq[k] = ssdat[3][k] + corr1; } if (sigsq[2] < TINY) { kflag = -8; return(kflag); } ratp = sigsq[3]/sigsq[2]; ratm = sigsq[1]/sigsq[2]; qfac1 = FOURTH*(q*q - ONE); qfac2 = TWO/(q - ONE); bb = ratp*ratm - ONE - qfac1*ratp; tem = ONE - qfac2*bb; if (ABS(tem) < TINY) { kflag = -8; return(kflag); } rrb = ONE/tem; if (ABS(rrb - rr) > rrtol) { kflag = -9; return(kflag); } /* Check to see if rr is above cutoff rrcut */ if (rr > rrcut) { if (kflag == 1) kflag = 4; if (kflag == 2) kflag = 5; if (kflag == 3) kflag = 6; } /* All positive kflag returned at this point */ return(kflag); } /* * ----------------------------------------------------------------- * Functions for rootfinding * ----------------------------------------------------------------- */ /* * cvRcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck1(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < nrtfn; i++) iroots[i] = 0; tlo = tn; ttol = (ABS(tn) + ABS(h))*uround*HUN; /* Evaluate g at initial t and check for zero values. */ retval = gfun(tlo, zn[0], glo, user_data); nge = 1; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(glo[i]) == ZERO) { zroot = TRUE; gactive[i] = FALSE; } } if (!zroot) return(CV_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = MAX(ttol/ABS(h), TENTH); smallh = hratio*h; tplus = tlo + smallh; N_VLinearSum(ONE, zn[0], hratio, zn[1], y); retval = gfun(tplus, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < nrtfn; i++) { if (!gactive[i] && ABS(ghi[i]) != ZERO) { gactive[i] = TRUE; glo[i] = ghi[i]; } } return(CV_SUCCESS); } /* * cvRcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * CVode. This may be the previous tn, the previous tout value, or * the last root location. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * CLOSERT = 3 if a close pair of zeros was found, or * RTFOUND = 1 if a new zero of g was found near tlo, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck2(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (irfnd == 0) return(CV_SUCCESS); (void) CVodeGetDky(cv_mem, tlo, 0, y); retval = gfun(tlo, y, glo, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = FALSE; for (i = 0; i < nrtfn; i++) iroots[i] = 0; for (i = 0; i < nrtfn; i++) { if (!gactive[i]) continue; if (ABS(glo[i]) == ZERO) { zroot = TRUE; iroots[i] = 1; } } if (!zroot) return(CV_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ ttol = (ABS(tn) + ABS(h))*uround*HUN; smallh = (h > ZERO) ? ttol : -ttol; tplus = tlo + smallh; if ( (tplus - tn)*h >= ZERO) { hratio = smallh/h; N_VLinearSum(ONE, y, hratio, zn[1], y); } else { (void) CVodeGetDky(cv_mem, tplus, 0, y); } retval = gfun(tplus, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = FALSE; for (i = 0; i < nrtfn; i++) { if (ABS(ghi[i]) == ZERO) { if (!gactive[i]) continue; if (iroots[i] == 1) return(CLOSERT); zroot = TRUE; iroots[i] = 1; } else { if (iroots[i] == 1) glo[i] = ghi[i]; } } if (zroot) return(RTFOUND); return(CV_SUCCESS); } /* * cvRcheck3 * * This routine interfaces to cvRootFind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck3(CVodeMem cv_mem) { int i, retval, ier; /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ if (taskc == CV_ONE_STEP) { thi = tn; N_VScale(ONE, zn[0], y); } if (taskc == CV_NORMAL) { if ( (toutc - tn)*h >= ZERO) { thi = tn; N_VScale(ONE, zn[0], y); } else { thi = toutc; (void) CVodeGetDky(cv_mem, thi, 0, y); } } /* Set ghi = g(thi) and call cvRootFind to search (tlo,thi) for roots. */ retval = gfun(thi, y, ghi, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); ttol = (ABS(tn) + ABS(h))*uround*HUN; ier = cvRootFind(cv_mem); if (ier == CV_RTFUNC_FAIL) return(CV_RTFUNC_FAIL); for(i=0; i 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to TRUE for all i=0,...,nrtfn-1, but it may be * reset to FALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on TRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (ABS(tlo), ABS(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, and must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * CV_RTFUNC_FAIL = -12 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int cvRootFind(CVodeMem cv_mem) { realtype alpha, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(ghi[i]/(ghi[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return CV_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { trout = thi; for (i = 0; i < nrtfn; i++) grout[i] = ghi[i]; if (!zroot) return(CV_SUCCESS); for (i = 0; i < nrtfn; i++) { iroots[i] = 0; if(!gactive[i]) continue; if (ABS(ghi[i]) == ZERO) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alpha to avoid compiler warning */ alpha = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; loop { /* Looping point */ /* Set weight alpha. On the first two passes, set alpha = 1. Thereafter, reset alpha according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alpha = 1. If the sides were the same, then double alpha (if high side), or halve alpha (if low side). The next guess tmid is the secant method value if alpha = 1, but is closer to tlo if alpha < 1, and closer to thi if alpha > 1. */ if (sideprev == side) { alpha = (side == 2) ? alpha*TWO : alpha*HALF; } else { alpha = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = thi - (thi - tlo)*ghi[imax]/(ghi[imax] - alpha*glo[imax]); if (ABS(tmid - tlo) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; tmid = tlo + fracsub*(thi - tlo); } if (ABS(thi - tmid) < HALF*ttol) { fracint = ABS(thi - tlo)/ttol; fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; tmid = thi - fracsub*(thi - tlo); } (void) CVodeGetDky(cv_mem, tmid, 0, y); retval = gfun(tmid, y, grout, user_data); nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = FALSE; sgnchg = FALSE; sideprev = side; for (i = 0; i < nrtfn; i++) { if(!gactive[i]) continue; if (ABS(grout[i]) == ZERO) { if(rootdir[i]*glo[i] <= ZERO) { zroot = TRUE; } } else { if ( (glo[i]*grout[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) { gfrac = ABS(grout[i]/(grout[i] - glo[i])); if (gfrac > maxfrac) { sgnchg = TRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (ABS(thi - tlo) <= ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ thi = tmid; for (i = 0; i < nrtfn; i++) ghi[i] = grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ tlo = tmid; for (i = 0; i < nrtfn; i++) glo[i] = grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (ABS(thi - tlo) <= ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ trout = thi; for (i = 0; i < nrtfn; i++) { grout[i] = ghi[i]; iroots[i] = 0; if(!gactive[i]) continue; if ( (ABS(ghi[i]) == ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; if ( (glo[i]*ghi[i] < ZERO) && (rootdir[i]*glo[i] <= ZERO) ) iroots[i] = glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ----------------------------------------------------------------- * Functions for combined norms * ----------------------------------------------------------------- */ /* * cvQuadUpdateNorm * * Updates the norm old_nrm to account for all quadratures. */ static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ) { realtype qnrm; qnrm = N_VWrmsNorm(xQ, wQ); if (old_nrm > qnrm) return(old_nrm); else return(qnrm); } /* * cvSensNorm * * This routine returns the maximum over the weighted root mean * square norm of xS with weight vectors wS: * * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } * * Called by cvSensUpdateNorm or directly in the CV_STAGGERED approach * during the NLS solution and before the error test. */ static realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS) { int is; realtype nrm, snrm; nrm = N_VWrmsNorm(xS[0],wS[0]); for (is=1; is nrm ) nrm = snrm; } return(nrm); } /* * cvSensUpdateNorm * * Updates the norm old_nrm to account for all sensitivities. */ static realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS) { realtype snrm; snrm = cvSensNorm(cv_mem, xS, wS); if (old_nrm > snrm) return(old_nrm); else return(snrm); } /* * cvQuadSensNorm * * This routine returns the maximum over the weighted root mean * square norm of xQS with weight vectors wQS: * * max { wrms(xQS[0],wS[0]) ... wrms(xQS[Ns-1],wS[Ns-1]) } * * Called by cvQuadSensUpdateNorm. */ static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS) { int is; realtype nrm, snrm; nrm = N_VWrmsNorm(xQS[0],wQS[0]); for (is=1; is nrm ) nrm = snrm; } return(nrm); } /* * cvSensUpdateNorm * * Updates the norm old_nrm to account for all quadrature sensitivities. */ static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS) { realtype snrm; snrm = cvQuadSensNorm(cv_mem, xQS, wQS); if (old_nrm > snrm) return(old_nrm); else return(snrm); } /* * ----------------------------------------------------------------- * Wrappers for sensitivity RHS * ----------------------------------------------------------------- */ /* * cvSensRhsWrapper * * CVSensRhs is a high level routine that returns right hand side * of sensitivity equations. Depending on the 'ifS' flag, it either * calls directly the fS routine (ifS=CV_ALLSENS) or (if ifS=CV_ONESENS) * calls the fS1 routine in a loop over all sensitivities. * * CVSensRhs is called: * (*) by CVode at the first step * (*) by cvYddNorm if errcon=TRUE * (*) by cvNlsFunctional, cvNlsNewton, and cvNewtonIteration * if ism=CV_SIMULTANEOUS * (*) by cvDoErrorTest when restarting from scratch * (*) in the corrector loop if ism=CV_STAGGERED * (*) by cvStgrDoErrorTest when restarting from scratch * * The return value is that of the sensitivity RHS function fS, * */ int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, N_Vector *yScur, N_Vector *fScur, N_Vector temp1, N_Vector temp2) { int retval=0, is; if (ifS==CV_ALLSENS) { retval = fS(Ns, time, ycur, fcur, yScur, fScur, fS_data, temp1, temp2); nfSe++; } else { for (is=0; iscv_ehfun) #define eh_data (cv_mem->cv_eh_data) void cvProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to cvProcessError) */ va_start(ap, msgfmt); /* Compose the message */ vsprintf(msg, msgfmt, ap); if (cv_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, msg); fprintf(stderr, "\n\n"); #endif } else { /* We can call ehfun */ /* Call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* * cvErrHandler is the default error handling function. * It sends the error message to the stream pointed to by cv_errfp */ #define errfp (cv_mem->cv_errfp) void cvErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { CVodeMem cv_mem; char err_type[10]; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; if (error_code == CV_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (errfp!=NULL) { fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(errfp," %s\n\n",msg); } #endif return; } sundials-2.5.0/src/cvodes/CMakeLists.txt0000600000175000017500000000735411741421150021031 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the CVODES library INSTALL(CODE "MESSAGE(\"\nInstall CVODES\n\")") # Add variable cvodes_SOURCES with the sources for the CVODES library SET(cvodes_SOURCES cvodes.c cvodea.c cvodes_io.c cvodea_io.c cvodes_direct.c cvodes_band.c cvodes_dense.c cvodes_diag.c cvodes_spils.c cvodes_spbcgs.c cvodes_spgmr.c cvodes_sptfqmr.c cvodes_bandpre.c cvodes_bbdpre.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the CVODES library SET(shared_SOURCES sundials_nvector.c sundials_math.c sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_spbcgs.c sundials_spgmr.c sundials_sptfqmr.c ) # Add prefix with complete path to the common SUNDIALS sources ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable cvodes_HEADERS with the exported CVODES header files SET(cvodes_HEADERS cvodes_band.h cvodes_bandpre.h cvodes_bbdpre.h cvodes_dense.h cvodes_diag.h cvodes_direct.h cvodes.h cvodes_spbcgs.h cvodes_spgmr.h cvodes_spils.h cvodes_sptfqmr.h ) # Add prefix with complete path to the CVODES header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvodes/ cvodes_HEADERS) # If Blas/Lapack support was enabled, set-up additional file lists IF(LAPACK_FOUND) SET(cvodes_BL_SOURCES cvodes_lapack.c) SET(cvodes_BL_HEADERS cvodes_lapack.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/cvodes/ cvodes_BL_HEADERS) ELSE(LAPACK_FOUND) SET(cvodes_BL_SOURCES "") SET(cvodes_BL_HEADERS "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static CVODES library ADD_LIBRARY(sundials_cvodes_static STATIC ${cvodes_SOURCES} ${cvodes_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_cvodes_static PROPERTIES OUTPUT_NAME sundials_cvodes CLEAN_DIRECT_OUTPUT 1) # Install the CVODES library INSTALL(TARGETS sundials_cvodes_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the CVODES library ADD_LIBRARY(sundials_cvodes_shared SHARED ${cvodes_SOURCES} ${cvodes_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_cvodes_shared PROPERTIES OUTPUT_NAME sundials_cvodes CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_cvodes_shared PROPERTIES VERSION ${cvodeslib_VERSION} SOVERSION ${cvodeslib_SOVERSION}) # Install the CVODES library INSTALL(TARGETS sundials_cvodes_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the CVODES header files INSTALL(FILES ${cvodes_HEADERS} ${cvodes_BL_HEADERS} DESTINATION include/cvodes) # Install the CVODES implementation header file INSTALL(FILES cvodes_impl.h DESTINATION include/cvodes) # MESSAGE(STATUS "Added CVODES module") sundials-2.5.0/src/cvodes/cvodes_io.c0000600000175000017500000012062511741421150020404 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.19 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the CVODES solver. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ================================================================= * CVODES optional input functions * ================================================================= */ /* * CVodeSetErrHandlerFn * * Specifies the error handler function */ int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrHandlerFn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_ehfun = ehfun; cv_mem->cv_eh_data = eh_data; return(CV_SUCCESS); } /* * CVodeSetErrFile * * Specifies the FILE pointer for output (NULL means no messages) */ int CVodeSetErrFile(void *cvode_mem, FILE *errfp) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrFile", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errfp = errfp; return(CV_SUCCESS); } /* * CVodeSetIterType * * Specifies the iteration type (CV_FUNCTIONAL or CV_NEWTON) */ int CVodeSetIterType(void *cvode_mem, int iter) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetIterType", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if ((iter != CV_FUNCTIONAL) && (iter != CV_NEWTON)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetIterType", MSGCV_BAD_ITER); return (CV_ILL_INPUT); } cv_mem->cv_iter = iter; return(CV_SUCCESS); } /* * CVodeSetUserData * * Specifies the user data pointer for f */ int CVodeSetUserData(void *cvode_mem, void *user_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetUserData", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_user_data = user_data; return(CV_SUCCESS); } /* * CVodeSetMaxOrd * * Specifies the maximum method order */ int CVodeSetMaxOrd(void *cvode_mem, int maxord) { CVodeMem cv_mem; int qmax_alloc; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxOrd", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (maxord <= 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_NEG_MAXORD); return(CV_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ qmax_alloc = cv_mem->cv_qmax_alloc; qmax_alloc = MIN(qmax_alloc, cv_mem->cv_qmax_allocQ); qmax_alloc = MIN(qmax_alloc, cv_mem->cv_qmax_allocS); if (maxord > qmax_alloc) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_BAD_MAXORD); return(CV_ILL_INPUT); } cv_mem->cv_qmax = maxord; return(CV_SUCCESS); } /* * CVodeSetMaxNumSteps * * Specifies the maximum number of integration steps */ int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) cv_mem->cv_mxstep = MXSTEP_DEFAULT; else cv_mem->cv_mxstep = mxsteps; return(CV_SUCCESS); } /* * CVodeSetMaxHnilWarns * * Specifies the maximum number of warnings for small h */ int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxHnilWarns", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxhnil = mxhnil; return(CV_SUCCESS); } /* *CVodeSetStabLimDet * * Turns on/off the stability limit detection algorithm */ int CVodeSetStabLimDet(void *cvode_mem, booleantype sldet) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStabLimDet", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if( sldet && (cv_mem->cv_lmm != CV_BDF) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStabLimDet", MSGCV_SET_SLDET); return(CV_ILL_INPUT); } cv_mem->cv_sldeton = sldet; return(CV_SUCCESS); } /* * CVodeSetInitStep * * Specifies the initial step size */ int CVodeSetInitStep(void *cvode_mem, realtype hin) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_hin = hin; return(CV_SUCCESS); } /* * CVodeSetMinStep * * Specifies the minimum step size */ int CVodeSetMinStep(void *cvode_mem, realtype hmin) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMinStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmin<0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_NEG_HMIN); return(CV_ILL_INPUT); } /* Passing 0 sets hmin = zero */ if (hmin == ZERO) { cv_mem->cv_hmin = HMIN_DEFAULT; return(CV_SUCCESS); } if (hmin * cv_mem->cv_hmax_inv > ONE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmin = hmin; return(CV_SUCCESS); } /* * CVodeSetMaxStep * * Specifies the maximum step size */ int CVodeSetMaxStep(void *cvode_mem, realtype hmax) { realtype hmax_inv; CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxStep", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmax < 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_NEG_HMAX); return(CV_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; return(CV_SUCCESS); } hmax_inv = ONE/hmax; if (hmax_inv * cv_mem->cv_hmin > ONE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmax_inv = hmax_inv; return(CV_SUCCESS); } /* * CVodeSetStopTime * * Specifies the time beyond which the integration is not to proceed. */ int CVodeSetStopTime(void *cvode_mem, realtype tstop) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStopTime", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* If CVode was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If CVodeSetStopTime is called before the first call to CVode, * tstop will be checked in CVode. */ if (cv_mem->cv_nst > 0) { if ( (tstop - cv_mem->cv_tn) * cv_mem->cv_h < ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStopTime", MSGCV_BAD_TSTOP, cv_mem->cv_tn); return(CV_ILL_INPUT); } } cv_mem->cv_tstop = tstop; cv_mem->cv_tstopset = TRUE; return(CV_SUCCESS); } /* * CVodeSetMaxErrTestFails * * Specifies the maximum number of error test failures during one * step try. */ int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxErrTestFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxnef = maxnef; return(CV_SUCCESS); } /* * CVodeSetMaxConvFails * * Specifies the maximum number of nonlinear convergence failures * during one step try. */ int CVodeSetMaxConvFails(void *cvode_mem, int maxncf) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxConvFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxncf = maxncf; return(CV_SUCCESS); } /* * CVodeSetMaxNonlinIters * * Specifies the maximum number of nonlinear iterations during * one solve. */ int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxcor = maxcor; return(CV_SUCCESS); } /* * CVodeSetNonlinConvCoef * * Specifies the coeficient in the nonlinear solver convergence * test */ int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinConvCoef", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_nlscoef = nlscoef; return(CV_SUCCESS); } /* * CVodeSetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int CVodeSetRootDirection(void *cvode_mem, int *rootdir) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetRootDirection", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; if (nrt==0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetRootDirection", MSGCV_NO_ROOT); return(CV_ILL_INPUT); } for(i=0; icv_rootdir[i] = rootdir[i]; return(CV_SUCCESS); } /* * CVodeSetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int CVodeSetNoInactiveRootWarn(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNoInactiveRootWarn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxgnull = 0; return(CV_SUCCESS); } /* * ================================================================= * Quadrature optional input functions * ================================================================= */ int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errconQ = errconQ; return(CV_SUCCESS); } /* * ================================================================= * FSA optional input functions * ================================================================= */ int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensDQMethod", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if ( (DQtype != CV_CENTERED) && (DQtype != CV_FORWARD) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQTYPE); return(CV_ILL_INPUT); } if (DQrhomax < ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQRHO); return(CV_ILL_INPUT); } cv_mem->cv_DQtype = DQtype; cv_mem->cv_DQrhomax = DQrhomax; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errconS = errconS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensMaxNonlinIters", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxcorS = maxcorS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensParams", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetSensParams", MSGCV_NO_SENSI); return(CV_NO_SENS); } Ns = cv_mem->cv_Ns; /* Parameters */ cv_mem->cv_p = p; /* pbar */ if (pbar != NULL) for (is=0; iscv_pbar[is] = ABS(pbar[is]); } else for (is=0; iscv_pbar[is] = ONE; /* plist */ if (plist != NULL) for (is=0; iscv_plist[is] = plist[is]; } else for (is=0; iscv_plist[is] = is; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetQuadSensTolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } cv_mem->cv_errconQS = errconQS; return(CV_SUCCESS); } /* * ================================================================= * CVODES optional output functions * ================================================================= */ /* * Readability constants */ #define nst (cv_mem->cv_nst) #define nfe (cv_mem->cv_nfe) #define ncfn (cv_mem->cv_ncfn) #define netf (cv_mem->cv_netf) #define nni (cv_mem->cv_nni) #define nsetups (cv_mem->cv_nsetups) #define qu (cv_mem->cv_qu) #define next_q (cv_mem->cv_next_q) #define ewt (cv_mem->cv_ewt) #define hu (cv_mem->cv_hu) #define next_h (cv_mem->cv_next_h) #define h0u (cv_mem->cv_h0u) #define tolsf (cv_mem->cv_tolsf) #define acor (cv_mem->cv_acor) #define lrw (cv_mem->cv_lrw) #define liw (cv_mem->cv_liw) #define nge (cv_mem->cv_nge) #define iroots (cv_mem->cv_iroots) #define nor (cv_mem->cv_nor) #define sldeton (cv_mem->cv_sldeton) #define tn (cv_mem->cv_tn) #define efun (cv_mem->cv_efun) /* * CVodeGetNumSteps * * Returns the current number of integration steps */ int CVodeGetNumSteps(void *cvode_mem, long int *nsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = nst; return(CV_SUCCESS); } /* * CVodeGetNumRhsEvals * * Returns the current number of calls to f */ int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nfevals = nfe; return(CV_SUCCESS); } /* * CVodeGetNumLinSolvSetups * * Returns the current number of calls to the linear solver setup routine */ int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumLinSolvSetups", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nlinsetups = nsetups; return(CV_SUCCESS); } /* * CVodeGetNumErrTestFails * * Returns the current number of error test failures */ int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *netfails = netf; return(CV_SUCCESS); } /* * CVodeGetLastOrder * * Returns the order on the last succesful step */ int CVodeGetLastOrder(void *cvode_mem, int *qlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qlast = qu; return(CV_SUCCESS); } /* * CVodeGetCurrentOrder * * Returns the order to be attempted on the next step */ int CVodeGetCurrentOrder(void *cvode_mem, int *qcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qcur = next_q; return(CV_SUCCESS); } /* * CVodeGetNumStabLimOrderReds * * Returns the number of order reductions triggered by the stability * limit detection algorithm */ int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumStabLimOrderReds", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sldeton==FALSE) *nslred = 0; else *nslred = nor; return(CV_SUCCESS); } /* * CVodeGetActualInitStep * * Returns the step size used on the first step */ int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetActualInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hinused = h0u; return(CV_SUCCESS); } /* * CVodeGetLastStep * * Returns the step size used on the last successful step */ int CVodeGetLastStep(void *cvode_mem, realtype *hlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hlast = hu; return(CV_SUCCESS); } /* * CVodeGetCurrentStep * * Returns the step size to be attempted on the next step */ int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hcur = next_h; return(CV_SUCCESS); } /* * CVodeGetCurrentTime * * Returns the current value of the independent variable */ int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentTime", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tcur = tn; return(CV_SUCCESS); } /* * CVodeGetTolScaleFactor * * Returns a suggested factor for scaling tolerances */ int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfact) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetTolScaleFactor", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tolsfact = tolsf; return(CV_SUCCESS); } /* * CVodeGetErrWeights * * This routine returns the current weight vector. */ int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, ewt, eweight); return(CV_SUCCESS); } /* * CVodeGetEstLocalErrors * * Returns an estimate of the local error */ int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetEstLocalErrors", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, acor, ele); return(CV_SUCCESS); } /* * CVodeGetWorkSpace * * Returns integrator work space requirements */ int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetWorkSpace", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *leniw = liw; *lenrw = lrw; return(CV_SUCCESS); } /* * CVodeGetIntegratorStats * * Returns integrator statistics */ int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetIntegratorStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = nst; *nfevals = nfe; *nlinsetups = nsetups; *netfails = netf; *qlast = qu; *qcur = next_q; *hinused = h0u; *hlast = hu; *hcur = next_h; *tcur = tn; return(CV_SUCCESS); } /* * CVodeGetNumGEvals * * Returns the current number of calls to g (for rootfinding) */ int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumGEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *ngevals = nge; return(CV_SUCCESS); } /* * CVodeGetRootInfo * * Returns pointer to array rootsfound showing roots found */ int CVodeGetRootInfo(void *cvode_mem, int *rootsfound) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetRootInfo", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; for (i=0; icv_quadr) #define nfQe (cv_mem->cv_nfQe) #define netfQ (cv_mem->cv_netfQ) #define ewtQ (cv_mem->cv_ewtQ) #define errconQ (cv_mem->cv_errconQ) /*-----------------------------------------------------------------*/ int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr==FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nfQevals = nfQe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr==FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nQetfails = netfQ; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr==FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_QUAD); return(CV_NO_QUAD); } if(errconQ) N_VScale(ONE, ewtQ, eQweight); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr==FALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadStats", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nfQevals = nfQe; *nQetfails = netfQ; return(CV_SUCCESS); } /* * ================================================================= * Quadrature FSA optional output functions * ================================================================= */ /* * Readability constants */ #define quadr_sensi (cv_mem->cv_quadr_sensi) #define nfQSe (cv_mem->cv_nfQSe) #define netfQS (cv_mem->cv_netfQS) #define ewtQS (cv_mem->cv_ewtQS) #define errconQS (cv_mem->cv_errconQS) /*-----------------------------------------------------------------*/ int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr_sensi == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } *nfQSevals = nfQSe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr_sensi == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } *nQSetfails = netfQS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (quadr_sensi == FALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } Ns = cv_mem->cv_Ns; if (errconQS) for (is=0; iscv_sensi) #define ism (cv_mem->cv_ism) #define ewtS (cv_mem->cv_ewtS) #define nfSe (cv_mem->cv_nfSe) #define nfeS (cv_mem->cv_nfeS) #define nniS (cv_mem->cv_nniS) #define ncfnS (cv_mem->cv_ncfnS) #define netfS (cv_mem->cv_netfS) #define nsetupsS (cv_mem->cv_nsetupsS) #define nniS1 (cv_mem->cv_nniS1) #define ncfnS1 (cv_mem->cv_ncfnS1) #define ncfS1 (cv_mem->cv_ncfS1) /*-----------------------------------------------------------------*/ int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nfSevals = nfSe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nfevalsS = nfeS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nSetfails = netfS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nlinsetupsS = nsetupsS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_SENSI); return(CV_NO_SENS); } Ns = cv_mem->cv_Ns; for (is=0; iscv_Ns; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvIters", MSGCV_NO_SENSI); return(CV_NO_SENS); } if(ism==CV_STAGGERED1) for(is=0; iscv_Ns; if (sensi==FALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvConvFails", MSGCV_NO_SENSI); return(CV_NO_SENS); } if(ism==CV_STAGGERED1) for(is=0; is #include #include "cvodes_impl.h" #include #include /* * ================================================================= * MACRO DEFINITIONS * ================================================================= */ #define loop for(;;) /* * ================================================================= * CVODEA PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) /* real 0.0 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for IMget */ /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static CkpntMem CVAckpntInit(CVodeMem cv_mem); static CkpntMem CVAckpntNew(CVodeMem cv_mem); static void CVAckpntDelete(CkpntMem *ck_memPtr); static void CVAbckpbDelete(CVodeBMem *cvB_memPtr); static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem); static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem); static int CVAfindIndex(CVodeMem cv_mem, realtype t, long int *indx, booleantype *newpoint); static booleantype CVAhermiteMalloc(CVodeMem cv_mem); static void CVAhermiteFree(CVodeMem cv_mem); static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d); static booleantype CVApolynomialMalloc(CVodeMem cv_mem); static void CVApolynomialFree(CVodeMem cv_mem); static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d); /* Wrappers */ static int CVArhs(realtype t, N_Vector yB, N_Vector yBdot, void *cvode_mem); static int CVArhsQ(realtype t, N_Vector yB, N_Vector qBdot, void *cvode_mem); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * CVodeAdjInit * * This routine initializes ASA and allocates space for the adjoint * memory structure. */ int CVodeAdjInit(void *cvode_mem, long int steps, int interp) { CVadjMem ca_mem; CVodeMem cv_mem; long int i, ii; /* --------------- * Check arguments * --------------- */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem)cvode_mem; if (steps <= 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_STEPS); return(CV_ILL_INPUT); } if ( (interp != CV_HERMITE) && (interp != CV_POLYNOMIAL) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_INTERP); return(CV_ILL_INPUT); } /* ---------------------------- * Allocate CVODEA memory block * ---------------------------- */ ca_mem = NULL; ca_mem = (CVadjMem) malloc(sizeof(struct CVadjMemRec)); if (ca_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Attach ca_mem to CVodeMem structure */ cv_mem->cv_adj_mem = ca_mem; /* ------------------------------ * Initialization of check points * ------------------------------ */ /* Set Check Points linked list to NULL */ ca_mem->ck_mem = NULL; /* Initialize nckpnts to ZERO */ ca_mem->ca_nckpnts = 0; /* No interpolation data is available */ ca_mem->ca_ckpntData = NULL; /* ------------------------------------ * Initialization of interpolation data * ------------------------------------ */ /* Interpolation type */ ca_mem->ca_IMtype = interp; /* Number of steps between check points */ ca_mem->ca_nsteps = steps; /* Allocate space for the array of Data Point structures */ ca_mem->dt_mem = NULL; ca_mem->dt_mem = (DtpntMem *) malloc((steps+1)*sizeof(struct DtpntMemRec *)); if (ca_mem->dt_mem == NULL) { free(ca_mem); ca_mem = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } for (i=0; i<=steps; i++) { ca_mem->dt_mem[i] = NULL; ca_mem->dt_mem[i] = (DtpntMem) malloc(sizeof(struct DtpntMemRec)); if (ca_mem->dt_mem[i] == NULL) { for(ii=0; iidt_mem[ii]); ca_mem->dt_mem[ii] = NULL;} free(ca_mem->dt_mem); ca_mem->dt_mem = NULL; free(ca_mem); ca_mem = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /* Attach functions for the appropriate interpolation module */ switch(interp) { case CV_HERMITE: ca_mem->ca_IMmalloc = CVAhermiteMalloc; ca_mem->ca_IMfree = CVAhermiteFree; ca_mem->ca_IMget = CVAhermiteGetY; ca_mem->ca_IMstore = CVAhermiteStorePnt; break; case CV_POLYNOMIAL: ca_mem->ca_IMmalloc = CVApolynomialMalloc; ca_mem->ca_IMfree = CVApolynomialFree; ca_mem->ca_IMget = CVApolynomialGetY; ca_mem->ca_IMstore = CVApolynomialStorePnt; break; } /* The interpolation module has not been initialized yet */ ca_mem->ca_IMmallocDone = FALSE; /* By default we will store but not interpolate sensitivities * - IMstoreSensi will be set in CVodeF to FALSE if FSA is not enabled * or if the user can force this through CVodeSetAdjNoSensi * - IMinterpSensi will be set in CVodeB to TRUE if IMstoreSensi is * TRUE and if at least one backward problem requires sensitivities */ ca_mem->ca_IMstoreSensi = TRUE; ca_mem->ca_IMinterpSensi = FALSE; /* ------------------------------------ * Initialize list of backward problems * ------------------------------------ */ ca_mem->cvB_mem = NULL; ca_mem->ca_bckpbCrt = NULL; ca_mem->ca_nbckpbs = 0; /* -------------------------------- * CVodeF and CVodeB not called yet * -------------------------------- */ ca_mem->ca_firstCVodeFcall = TRUE; ca_mem->ca_tstopCVodeFcall = FALSE; ca_mem->ca_firstCVodeBcall = TRUE; /* --------------------------------------------- * ASA initialized and allocated * --------------------------------------------- */ cv_mem->cv_adj = TRUE; cv_mem->cv_adjMallocDone = TRUE; return(CV_SUCCESS); } /* CVodeAdjReInit * * This routine reinitializes the CVODEA memory structure assuming that the * the number of steps between check points and the type of interpolation * remain unchanged. * The list of check points (and associated memory) is deleted. * The list of backward problems is kept (however, new backward problems can * be added to this list by calling CVodeCreateB). * The CVODES memory for the forward and backward problems can be reinitialized * separately by calling CVodeReInit and CVodeReInitB, respectively. * NOTE: if a completely new list of backward problems is also needed, then * simply free the adjoint memory (by calling CVodeAdjFree) and reinitialize * ASA with CVodeAdjInit. */ int CVodeAdjReInit(void *cvode_mem) { CVadjMem ca_mem; CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeAdjReInit", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Free current list of Check Points */ while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); /* Initialization of check points */ ca_mem->ck_mem = NULL; ca_mem->ca_nckpnts = 0; ca_mem->ca_ckpntData = NULL; /* CVodeF and CVodeB not called yet */ ca_mem->ca_firstCVodeFcall = TRUE; ca_mem->ca_tstopCVodeFcall = FALSE; ca_mem->ca_firstCVodeBcall = TRUE; return(CV_SUCCESS); } /* * CVodeAdjFree * * This routine frees the memory allocated by CVodeAdjInit. */ void CVodeAdjFree(void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; long int i; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_adjMallocDone) { ca_mem = cv_mem->cv_adj_mem; /* Delete check points one by one */ while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); /* Free vectors at all data points */ if (ca_mem->ca_IMmallocDone) { ca_mem->ca_IMfree(cv_mem); } for(i=0; i<=ca_mem->ca_nsteps; i++) { free(ca_mem->dt_mem[i]); ca_mem->dt_mem[i] = NULL; } free(ca_mem->dt_mem); ca_mem->dt_mem = NULL; /* Delete backward problems one by one */ while (ca_mem->cvB_mem != NULL) CVAbckpbDelete(&(ca_mem->cvB_mem)); /* Free CVODEA memory */ free(ca_mem); cv_mem->cv_adj_mem = NULL; } } /* * ----------------------------------------------------------------- * Readibility Constants * ----------------------------------------------------------------- */ #define tinitial (ca_mem->ca_tinitial) #define tfinal (ca_mem->ca_tfinal) #define nckpnts (ca_mem->ca_nckpnts) #define nsteps (ca_mem->ca_nsteps) #define nbckpbs (ca_mem->ca_nbckpbs) #define ckpntData (ca_mem->ca_ckpntData) #define np (ca_mem->ca_np) #define ytmp (ca_mem->ca_ytmp) #define yStmp (ca_mem->ca_yStmp) #define Y (ca_mem->ca_Y) #define YS (ca_mem->ca_YS) #define T (ca_mem->ca_T) #define IMmalloc (ca_mem->ca_IMmalloc) #define IMfree (ca_mem->ca_IMfree) #define IMget (ca_mem->ca_IMget) #define IMstore (ca_mem->ca_IMstore) #define IMmallocDone (ca_mem->ca_IMmallocDone) #define IMstoreSensi (ca_mem->ca_IMstoreSensi) #define IMinterpSensi (ca_mem->ca_IMinterpSensi) #define IMnewData (ca_mem->ca_IMnewData) #define uround (cv_mem->cv_uround) #define zn (cv_mem->cv_zn) #define nst (cv_mem->cv_nst) #define q (cv_mem->cv_q) #define qu (cv_mem->cv_qu) #define qprime (cv_mem->cv_qprime) #define qwait (cv_mem->cv_qwait) #define L (cv_mem->cv_L) #define gammap (cv_mem->cv_gammap) #define h (cv_mem->cv_h) #define hprime (cv_mem->cv_hprime) #define hscale (cv_mem->cv_hscale) #define eta (cv_mem->cv_eta) #define etamax (cv_mem->cv_etamax) #define tn (cv_mem->cv_tn) #define tretlast (cv_mem->cv_tretlast) #define tau (cv_mem->cv_tau) #define tq (cv_mem->cv_tq) #define l (cv_mem->cv_l) #define saved_tq5 (cv_mem->cv_saved_tq5) #define forceSetup (cv_mem->cv_forceSetup) #define f (cv_mem->cv_f) #define lmm (cv_mem->cv_lmm) #define iter (cv_mem->cv_iter) #define reltol (cv_mem->cv_reltol) #define user_data (cv_mem->cv_user_data) #define errfp (cv_mem->cv_errfp) #define h0u (cv_mem->cv_h0u) #define tempv (cv_mem->cv_tempv) #define quadr (cv_mem->cv_quadr) #define errconQ (cv_mem->cv_errconQ) #define znQ (cv_mem->cv_znQ) #define tempvQ (cv_mem->cv_tempvQ) #define sensi (cv_mem->cv_sensi) #define Ns (cv_mem->cv_Ns) #define errconS (cv_mem->cv_errconS) #define znS (cv_mem->cv_znS) #define quadr_sensi (cv_mem->cv_quadr_sensi) #define errconQS (cv_mem->cv_errconQS) #define znQS (cv_mem->cv_znQS) #define t0_ (ck_mem->ck_t0) #define t1_ (ck_mem->ck_t1) #define zn_ (ck_mem->ck_zn) #define znQ_ (ck_mem->ck_znQ) #define znS_ (ck_mem->ck_znS) #define znQS_ (ck_mem->ck_znQS) #define quadr_ (ck_mem->ck_quadr) #define sensi_ (ck_mem->ck_sensi) #define quadr_sensi_ (ck_mem->ck_quadr_sensi) #define Ns_ (ck_mem->ck_Ns) #define zqm_ (ck_mem->ck_zqm) #define nst_ (ck_mem->ck_nst) #define tretlast_ (ck_mem->ck_tretlast) #define q_ (ck_mem->ck_q) #define qprime_ (ck_mem->ck_qprime) #define qwait_ (ck_mem->ck_qwait) #define L_ (ck_mem->ck_L) #define gammap_ (ck_mem->ck_gammap) #define h_ (ck_mem->ck_h) #define hprime_ (ck_mem->ck_hprime) #define hscale_ (ck_mem->ck_hscale) #define eta_ (ck_mem->ck_eta) #define etamax_ (ck_mem->ck_etamax) #define tau_ (ck_mem->ck_tau) #define tq_ (ck_mem->ck_tq) #define l_ (ck_mem->ck_l) #define saved_tq5_ (ck_mem->ck_saved_tq5) #define next_ (ck_mem->ck_next) /* * CVodeF * * This routine integrates to tout and returns solution into yout. * In the same time, it stores check point data every 'steps' steps. * * CVodeF can be called repeatedly by the user. * * ncheckPtr points to the number of check points stored so far. */ int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask, int *ncheckPtr) { CVadjMem ca_mem; CVodeMem cv_mem; CkpntMem tmp; DtpntMem *dt_mem; int flag, i; booleantype iret, allocOK; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeF", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeF", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check for yout != NULL */ if (yout == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_YOUT_NULL); return(CV_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_TRET_NULL); return(CV_ILL_INPUT); } /* Check for valid itask */ if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_BAD_ITASK); return(CV_ILL_INPUT); } /* All error checking done */ dt_mem = ca_mem->dt_mem; /* If tstop is enabled, store some info */ if (cv_mem->cv_tstopset) { ca_mem->ca_tstopCVodeFcall = TRUE; ca_mem->ca_tstopCVodeF = cv_mem->cv_tstop; } /* We will call CVode in CV_ONE_STEP mode, regardless * of what itask is, so flag if we need to return */ if (itask == CV_ONE_STEP) iret = TRUE; else iret = FALSE; /* On the first step: * - set tinitial * - initialize list of check points * - if needed, initialize the interpolation module * - load dt_mem[0] * On subsequent steps, test if taking a new step is necessary. */ if ( ca_mem->ca_firstCVodeFcall ) { tinitial = tn; ca_mem->ck_mem = CVAckpntInit(cv_mem); if (ca_mem->ck_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } if ( !IMmallocDone ) { /* Do we need to store sensitivities? */ if (!sensi) IMstoreSensi = FALSE; /* Allocate space for interpolation data */ allocOK = IMmalloc(cv_mem); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Rename zn and, if needed, znS for use in interpolation */ for (i=0;it = ca_mem->ck_mem->ck_t0; IMstore(cv_mem, dt_mem[0]); ca_mem->ca_firstCVodeFcall = FALSE; } else if ( (tn - tout)*h >= ZERO ) { /* If tout was passed, return interpolated solution. No changes to ck_mem or dt_mem are needed. */ *tret = tout; flag = CVodeGetDky(cv_mem, tout, 0, yout); *ncheckPtr = nckpnts; IMnewData = TRUE; ckpntData = ca_mem->ck_mem; np = nst % nsteps + 1; return(flag); } /* Integrate to tout (in CV_ONE_STEP mode) while loading check points */ loop { /* Perform one step of the integration */ flag = CVode(cv_mem, tout, yout, tret, CV_ONE_STEP); if (flag < 0) break; /* Test if a new check point is needed */ if ( nst % nsteps == 0 ) { ca_mem->ck_mem->ck_t1 = *tret; /* Create a new check point, load it, and append it to the list */ tmp = CVAckpntNew(cv_mem); if (tmp == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); flag = CV_MEM_FAIL; break; } tmp->ck_next = ca_mem->ck_mem; ca_mem->ck_mem = tmp; nckpnts++; forceSetup = TRUE; /* Reset i=0 and load dt_mem[0] */ dt_mem[0]->t = ca_mem->ck_mem->ck_t0; IMstore(cv_mem, dt_mem[0]); } else { /* Load next point in dt_mem */ dt_mem[nst%nsteps]->t = *tret; IMstore(cv_mem, dt_mem[nst%nsteps]); } /* Set t1 field of the current ckeck point structure for the case in which there will be no future check points */ ca_mem->ck_mem->ck_t1 = *tret; /* tfinal is now set to *tret */ tfinal = *tret; /* Return if in CV_ONE_STEP mode */ if (iret) break; /* Return if tout reached */ if ( (*tret - tout)*h >= ZERO ) { *tret = tout; CVodeGetDky(cv_mem, tout, 0, yout); /* Reset tretlast in cv_mem so that CVodeGetQuad and CVodeGetSens * evaluate quadratures and/or sensitivities at the proper time */ cv_mem->cv_tretlast = tout; break; } } /* end of loop() */ /* Get ncheck from ca_mem */ *ncheckPtr = nckpnts; /* Data is available for the last interval */ IMnewData = TRUE; ckpntData = ca_mem->ck_mem; np = nst % nsteps + 1; return(flag); } /* * ================================================================= * FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ int CVodeCreateB(void *cvode_mem, int lmmB, int iterB, int *which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem new_cvB_mem; void *cvodeB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeCreateB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeCreateB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Allocate space for new CVodeBMem object */ new_cvB_mem = NULL; new_cvB_mem = (CVodeBMem) malloc(sizeof(struct CVodeBMemRec)); if (new_cvB_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Create and set a new CVODES object for the backward problem */ cvodeB_mem = CVodeCreate(lmmB, iterB); if (cvodeB_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } CVodeSetUserData(cvodeB_mem, cvode_mem); CVodeSetMaxHnilWarns(cvodeB_mem, -1); CVodeSetErrHandlerFn(cvodeB_mem, cv_mem->cv_ehfun, cv_mem->cv_eh_data); CVodeSetErrFile(cvodeB_mem, cv_mem->cv_errfp); /* Set/initialize fields in the new CVodeBMem object, new_cvB_mem */ new_cvB_mem->cv_index = nbckpbs; new_cvB_mem->cv_mem = (CVodeMem) cvodeB_mem; new_cvB_mem->cv_f = NULL; new_cvB_mem->cv_fs = NULL; new_cvB_mem->cv_fQ = NULL; new_cvB_mem->cv_fQs = NULL; new_cvB_mem->cv_user_data = NULL; new_cvB_mem->cv_lmem = NULL; new_cvB_mem->cv_lfree = NULL; new_cvB_mem->cv_pmem = NULL; new_cvB_mem->cv_pfree = NULL; new_cvB_mem->cv_y = NULL; new_cvB_mem->cv_f_withSensi = FALSE; new_cvB_mem->cv_fQ_withSensi = FALSE; /* Attach the new object to the linked list cvB_mem */ new_cvB_mem->cv_next = ca_mem->cvB_mem; ca_mem->cvB_mem = new_cvB_mem; /* Return the index of the newly created CVodeBMem object. * This must be passed to CVodeInitB and to other ***B * functions to set optional inputs for this backward problem */ *which = nbckpbs; nbckpbs++; return(CV_SUCCESS); } int CVodeInitB(void *cvode_mem, int which, CVRhsFnB fB, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Allocate and set the CVODES object */ flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); if (flag != CV_SUCCESS) return(flag); /* Copy fB function in cvB_mem */ cvB_mem->cv_f_withSensi = FALSE; cvB_mem->cv_f = fB; /* Allocate space and initialize the y Nvector in cvB_mem */ cvB_mem->cv_t0 = tB0; cvB_mem->cv_y = N_VClone(yB0); N_VScale(ONE, yB0, cvB_mem->cv_y); return(CV_SUCCESS); } int CVodeInitBS(void *cvode_mem, int which, CVRhsFnBS fBs, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitBS", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitBS", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitBS", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Allocate and set the CVODES object */ flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); if (flag != CV_SUCCESS) return(flag); /* Copy fBs function in cvB_mem */ cvB_mem->cv_f_withSensi = TRUE; cvB_mem->cv_fs = fBs; /* Allocate space and initialize the y Nvector in cvB_mem */ cvB_mem->cv_t0 = tB0; cvB_mem->cv_y = N_VClone(yB0); N_VScale(ONE, yB0, cvB_mem->cv_y); return(CV_SUCCESS); } int CVodeReInitB(void *cvode_mem, int which, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeReInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeReInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeReInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Reinitialize CVODES object */ flag = CVodeReInit(cvodeB_mem, tB0, yB0); return(flag); } int CVodeSStolerancesB(void *cvode_mem, int which, realtype reltolB, realtype abstolB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Set tolerances */ flag = CVodeSStolerances(cvodeB_mem, reltolB, abstolB); return(flag); } int CVodeSVtolerancesB(void *cvode_mem, int which, realtype reltolB, N_Vector abstolB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSVtolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Set tolerances */ flag = CVodeSVtolerances(cvodeB_mem, reltolB, abstolB); return(flag); } int CVodeQuadInitB(void *cvode_mem, int which, CVQuadRhsFnB fQB, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); if (flag != CV_SUCCESS) return(flag); cvB_mem->cv_fQ_withSensi = FALSE; cvB_mem->cv_fQ = fQB; return(CV_SUCCESS); } int CVodeQuadInitBS(void *cvode_mem, int which, CVQuadRhsFnBS fQBs, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitBS", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); if (flag != CV_SUCCESS) return(flag); cvB_mem->cv_fQ_withSensi = TRUE; cvB_mem->cv_fQs = fQBs; return(CV_SUCCESS); } int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadReInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadReInit(cvodeB_mem, yQB0); if (flag != CV_SUCCESS) return(flag); return(CV_SUCCESS); } int CVodeQuadSStolerancesB(void *cvode_mem, int which, realtype reltolQB, realtype abstolQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadSStolerances(cvodeB_mem, reltolQB, abstolQB); return(flag); } int CVodeQuadSVtolerancesB(void *cvode_mem, int which, realtype reltolQB, N_Vector abstolQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadSVtolerances(cvodeB_mem, reltolQB, abstolQB); return(flag); } /* * CVodeB * * This routine performs the backward integration towards tBout * of all backward problems that were defined. * When necessary, it performs a forward integration between two * consecutive check points to update interpolation data. * * On a successful return, CVodeB returns CV_SUCCESS. * * NOTE that CVodeB DOES NOT return the solution for the backward * problem(s). Use CVodeGetB to extract the solution at tBret * for any given backward problem. * * If there are multiple backward problems and multiple check points, * CVodeB may not succeed in getting all problems to take one step * when called in ONE_STEP mode. */ int CVodeB(void *cvode_mem, realtype tBout, int itaskB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem, tmp_cvB_mem; CkpntMem ck_mem; int sign, flag; realtype tfuzz, tBret, tBn; booleantype gotCheckpoint, isActive, reachedTBout; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check if any backward problem has been defined */ if ( nbckpbs == 0 ) { cvProcessError(cv_mem, CV_NO_BCK, "CVODEA", "CVodeB", MSGCV_NO_BCK); return(CV_NO_BCK); } cvB_mem = ca_mem->cvB_mem; /* Check whether CVodeF has been called */ if ( ca_mem->ca_firstCVodeFcall ) { cvProcessError(cv_mem, CV_NO_FWD, "CVODEA", "CVodeB", MSGCV_NO_FWD); return(CV_NO_FWD); } sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* If this is the first call, loop over all backward problems and * - check that tB0 is valid * - check that tBout is ahead of tB0 in the backward direction * - check whether we need to interpolate forward sensitivities */ if ( ca_mem->ca_firstCVodeBcall ) { tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( (sign*(tBn-tinitial) < ZERO) || (sign*(tfinal-tBn) < ZERO) ) { cvProcessError(cv_mem, CV_BAD_TB0, "CVODEA", "CVodeB", MSGCV_BAD_TB0, tmp_cvB_mem->cv_index); return(CV_BAD_TB0); } if (sign*(tBn-tBout) <= ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_TBOUT, tmp_cvB_mem->cv_index); return(CV_ILL_INPUT); } if ( tmp_cvB_mem->cv_f_withSensi || tmp_cvB_mem->cv_fQ_withSensi ) IMinterpSensi = TRUE; tmp_cvB_mem = tmp_cvB_mem->cv_next; } if ( IMinterpSensi && !IMstoreSensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_SENSI); return(CV_ILL_INPUT); } ca_mem->ca_firstCVodeBcall = FALSE; } /* Check if itaskB is legal */ if ( (itaskB != CV_NORMAL) && (itaskB != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_ITASKB); return(CV_ILL_INPUT); } /* Check if tBout is legal */ if ( (sign*(tBout-tinitial) < ZERO) || (sign*(tfinal-tBout) < ZERO) ) { tfuzz = HUNDRED*uround*(ABS(tinitial) + ABS(tfinal)); if ( (sign*(tBout-tinitial) < ZERO) && (ABS(tBout-tinitial) < tfuzz) ) { tBout = tinitial; } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_TBOUT); return(CV_ILL_INPUT); } } /* Loop through the check points and stop as soon as a backward * problem has its tn value behind the current check point's t0_ * value (in the backward direction) */ ck_mem = ca_mem->ck_mem; gotCheckpoint = FALSE; loop { tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( sign*(tBn-t0_) > ZERO ) { gotCheckpoint = TRUE; break; } if ( (itaskB==CV_NORMAL) && (tBn == t0_) && (sign*(tBout-t0_) >= ZERO) ) { gotCheckpoint = TRUE; break; } tmp_cvB_mem = tmp_cvB_mem->cv_next; } if (gotCheckpoint) break; if (next_ == NULL) break; ck_mem = next_; } /* Starting with the current check point from above, loop over check points while propagating backward problems */ loop { /* Store interpolation data if not available. This is the 2nd forward integration pass */ if (ck_mem != ckpntData) { flag = CVAdataStore(cv_mem, ck_mem); if (flag != CV_SUCCESS) break; } /* Loop through all backward problems and, if needed, * propagate their solution towards tBout */ tmp_cvB_mem = cvB_mem; while (tmp_cvB_mem != NULL) { /* Decide if current backward problem is "active" in this check point */ isActive = TRUE; tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( (tBn == t0_) && (sign*(tBout-t0_) < ZERO ) ) isActive = FALSE; if ( (tBn == t0_) && (itaskB==CV_ONE_STEP) ) isActive = FALSE; if ( sign * (tBn - t0_) < ZERO ) isActive = FALSE; if ( isActive ) { /* Store the address of current backward problem memory * in ca_mem to be used in the wrapper functions */ ca_mem->ca_bckpbCrt = tmp_cvB_mem; /* Integrate current backward problem */ CVodeSetStopTime(tmp_cvB_mem->cv_mem, t0_); flag = CVode(tmp_cvB_mem->cv_mem, tBout, tmp_cvB_mem->cv_y, &tBret, itaskB); /* Set the time at which we will report solution and/or quadratures */ tmp_cvB_mem->cv_tout = tBret; /* If an error occurred, exit while loop */ if (flag < 0) break; } else { flag = CV_SUCCESS; tmp_cvB_mem->cv_tout = tBn; } /* Move to next backward problem */ tmp_cvB_mem = tmp_cvB_mem->cv_next; } /* If an error occurred, return now */ if (flag <0) { cvProcessError(cv_mem, flag, "CVODEA", "CVodeB", MSGCV_BACK_ERROR, tmp_cvB_mem->cv_index); return(flag); } /* If in CV_ONE_STEP mode, return now (flag = CV_SUCCESS) */ if (itaskB == CV_ONE_STEP) break; /* If all backward problems have succesfully reached tBout, return now */ reachedTBout = TRUE; tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { if ( sign*(tmp_cvB_mem->cv_tout - tBout) > ZERO ) { reachedTBout = FALSE; break; } tmp_cvB_mem = tmp_cvB_mem->cv_next; } if ( reachedTBout ) break; /* Move check point in linked list to next one */ ck_mem = next_; } return(flag); } int CVodeGetB(void *cvode_mem, int which, realtype *tret, N_Vector yB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } N_VScale(ONE, cvB_mem->cv_y, yB); *tret = cvB_mem->cv_tout; return(CV_SUCCESS); } /* * CVodeGetQuadB */ int CVodeGetQuadB(void *cvode_mem, int which, realtype *tret, N_Vector qB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; long int nstB; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetQuadB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetQuadB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetQuadB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* If the integration for this backward problem has not started yet, * simply return the current value of qB (i.e. the final conditions) */ flag = CVodeGetNumSteps(cvodeB_mem, &nstB); if (nstB == 0) { N_VScale(ONE, cvB_mem->cv_mem->cv_znQ[0], qB); *tret = cvB_mem->cv_tout; } else { flag = CVodeGetQuad(cvodeB_mem, tret, qB); } return(flag); } /* * ================================================================= * PRIVATE FUNCTIONS FOR CHECK POINTS * ================================================================= */ /* * CVAckpntInit * * This routine initializes the check point linked list with * information from the initial time. */ static CkpntMem CVAckpntInit(CVodeMem cv_mem) { CkpntMem ck_mem; int is; /* Allocate space for ckdata */ ck_mem = NULL; ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (ck_mem == NULL) return(NULL); zn_[0] = N_VClone(tempv); if (zn_[0] == NULL) { free(ck_mem); ck_mem = NULL; return(NULL); } zn_[1] = N_VClone(tempv); if (zn_[1] == NULL) { N_VDestroy(zn_[0]); free(ck_mem); ck_mem = NULL; return(NULL); } /* zn_[qmax] was not allocated */ zqm_ = 0; /* Load ckdata from cv_mem */ N_VScale(ONE, zn[0], zn_[0]); t0_ = tn; nst_ = 0; q_ = 1; h_ = 0.0; /* Do we need to carry quadratures */ quadr_ = quadr && errconQ; if (quadr_) { znQ_[0] = N_VClone(tempvQ); if (znQ_[0] == NULL) { N_VDestroy(zn_[0]); N_VDestroy(zn_[1]); free(ck_mem); ck_mem = NULL; return(NULL); } N_VScale(ONE, znQ[0], znQ_[0]); } /* Do we need to carry sensitivities? */ sensi_ = sensi; if (sensi_) { Ns_ = Ns; znS_[0] = N_VCloneVectorArray(Ns, tempv); if (znS_[0] == NULL) { N_VDestroy(zn_[0]); N_VDestroy(zn_[1]); if (quadr_) N_VDestroy(znQ_[0]); free(ck_mem); ck_mem = NULL; return(NULL); } for (is=0; isck_next = NULL; /* Test if we need to allocate space for the last zn. * NOTE: zn(qmax) may be needed for a hot restart, if an order * increase is deemed necessary at the first step after a check point */ qmax = cv_mem->cv_qmax; zqm_ = (q < qmax) ? qmax : 0; for (j=0; j<=q; j++) { zn_[j] = N_VClone(tempv); if (zn_[j] == NULL) { for (jj=0; jjck_next; /* free N_Vectors in tmp */ for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_zn[j]); if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_zn[tmp->ck_zqm]); /* free N_Vectors for quadratures in tmp * Note that at the check point at t_initial, only znQ_[0] * was allocated */ if (tmp->ck_quadr) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_znQ[j]); if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_znQ[tmp->ck_zqm]); } else { N_VDestroy(tmp->ck_znQ[0]); } } /* free N_Vectors for sensitivities in tmp * Note that at the check point at t_initial, only znS_[0] * was allocated */ if (tmp->ck_sensi) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znS[j], tmp->ck_Ns); if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znS[tmp->ck_zqm], tmp->ck_Ns); } else { N_VDestroyVectorArray(tmp->ck_znS[0], tmp->ck_Ns); } } /* free N_Vectors for quadrature sensitivities in tmp * Note that at the check point at t_initial, only znQS_[0] * was allocated */ if (tmp->ck_quadr_sensi) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znQS[j], tmp->ck_Ns); if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znQS[tmp->ck_zqm], tmp->ck_Ns); } else { N_VDestroyVectorArray(tmp->ck_znQS[0], tmp->ck_Ns); } } free(tmp); tmp = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ static void CVAbckpbDelete(CVodeBMem *cvB_memPtr) { CVodeBMem tmp; void *cvode_mem; if (*cvB_memPtr != NULL) { /* Save head of the list */ tmp = *cvB_memPtr; /* Move head of the list */ *cvB_memPtr = (*cvB_memPtr)->cv_next; /* Free CVODES memory in tmp */ cvode_mem = (void *)(tmp->cv_mem); CVodeFree(&cvode_mem); /* Free linear solver memory */ if (tmp->cv_lfree != NULL) tmp->cv_lfree(tmp); /* Free preconditioner memory */ if (tmp->cv_pfree != NULL) tmp->cv_pfree(tmp); /* Free workspace Nvector */ N_VDestroy(tmp->cv_y); free(tmp); tmp = NULL; } } /* * ================================================================= * PRIVATE FUNCTIONS FOR INTERPOLATION * ================================================================= */ /* * CVAdataStore * * This routine integrates the forward model starting at the check * point ck_mem and stores y and yprime at all intermediate steps. * * Return values: * CV_SUCCESS * CV_REIFWD_FAIL * CV_FWD_FAIL */ static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; realtype t; long int i; int flag, sign; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Initialize cv_mem with data from ck_mem */ flag = CVAckpntGet(cv_mem, ck_mem); if (flag != CV_SUCCESS) return(CV_REIFWD_FAIL); /* Set first structure in dt_mem[0] */ dt_mem[0]->t = t0_; IMstore(cv_mem, dt_mem[0]); /* Decide whether TSTOP must be activated */ if (ca_mem->ca_tstopCVodeFcall) { CVodeSetStopTime(cv_mem, ca_mem->ca_tstopCVodeF); } sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* Run CVode to set following structures in dt_mem[i] */ i = 1; do { flag = CVode(cv_mem, t1_, ytmp, &t, CV_ONE_STEP); if (flag < 0) return(CV_FWD_FAIL); dt_mem[i]->t = t; IMstore(cv_mem, dt_mem[i]); i++; } while ( sign*(t1_ - t) > ZERO ); IMnewData = TRUE; /* New data is now available */ ckpntData = ck_mem; /* starting at this check point */ np = i; /* and we have this many points */ return(CV_SUCCESS); } /* * CVAckpntGet * * This routine prepares CVODES for a hot restart from * the check point ck_mem */ static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem) { int flag, j, is, qmax; if (next_ == NULL) { /* In this case, we just call the reinitialization routine, * but make sure we use the same initial stepsize as on * the first run. */ CVodeSetInitStep(cv_mem, h0u); flag = CVodeReInit(cv_mem, t0_, zn_[0]); if (flag != CV_SUCCESS) return(flag); if (quadr_) { flag = CVodeQuadReInit(cv_mem, znQ_[0]); if (flag != CV_SUCCESS) return(flag); } if (sensi_) { flag = CVodeSensReInit(cv_mem, cv_mem->cv_ism, znS_[0]); if (flag != CV_SUCCESS) return(flag); } if (quadr_sensi_) { flag = CVodeQuadSensReInit(cv_mem, znQS_[0]); if (flag != CV_SUCCESS) return(flag); } } else { qmax = cv_mem->cv_qmax; /* Copy parameters from check point data structure */ nst = nst_; tretlast = tretlast_; q = q_; qprime = qprime_; qwait = qwait_; L = L_; gammap = gammap_; h = h_; hprime = hprime_; hscale = hscale_; eta = eta_; etamax = etamax_; tn = t0_; saved_tq5 = saved_tq5_; /* Copy the arrays from check point data structure */ for (j=0; j<=q; j++) N_VScale(ONE, zn_[j], zn[j]); if ( q < qmax ) N_VScale(ONE, zn_[qmax], zn[qmax]); if (quadr_) { for (j=0; j<=q; j++) N_VScale(ONE, znQ_[j], znQ[j]); if ( q < qmax ) N_VScale(ONE, znQ_[qmax], znQ[qmax]); } if (sensi_) { for (is=0; iscv_adj_mem; dt_mem = ca_mem->dt_mem; *newpoint = FALSE; /* Find the direction of integration */ sign = (tfinal - tinitial > ZERO) ? 1 : -1; /* If this is the first time we use new data */ if (IMnewData) { ilast = np-1; *newpoint = TRUE; IMnewData = FALSE; } /* Search for indx starting from ilast */ to_left = ( sign*(t - dt_mem[ilast-1]->t) < ZERO); to_right = ( sign*(t - dt_mem[ilast]->t) > ZERO); if ( to_left ) { /* look for a new indx to the left */ *newpoint = TRUE; *indx = ilast; loop { if ( *indx == 0 ) break; if ( sign*(t - dt_mem[*indx-1]->t) <= ZERO ) (*indx)--; else break; } if ( *indx == 0 ) ilast = 1; else ilast = *indx; if ( *indx == 0 ) { /* t is beyond leftmost limit. Is it too far? */ if ( ABS(t - dt_mem[0]->t) > FUZZ_FACTOR * uround ) { return(CV_GETY_BADT); } } } else if ( to_right ) { /* look for a new indx to the right */ *newpoint = TRUE; *indx = ilast; loop { if ( sign*(t - dt_mem[*indx]->t) > ZERO) (*indx)++; else break; } ilast = *indx; } else { /* ilast is still OK */ *indx = ilast; } return(CV_SUCCESS); } /* * CVodeGetAdjY * * This routine returns the interpolated forward solution at time t. * The user must allocate space for y. */ int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y) { CVodeMem cv_mem; CVadjMem ca_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjY", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; flag = IMget(cv_mem, t, y, NULL); return(flag); } /* * ----------------------------------------------------------------- * Functions specific to cubic Hermite interpolation * ----------------------------------------------------------------- */ /* * CVAhermiteMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. */ static booleantype CVAhermiteMalloc(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i, ii=0; booleantype allocOK; allocOK = TRUE; ca_mem = cv_mem->cv_adj_mem; /* Allocate space for the vectors ytmp and yStmp */ ytmp = N_VClone(tempv); if (ytmp == NULL) { return(FALSE); } if (IMstoreSensi) { yStmp = N_VCloneVectorArray(Ns, tempv); if (yStmp == NULL) { N_VDestroy(ytmp); return(FALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = ca_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = NULL; content = (HermiteDataMem) malloc(sizeof(struct HermiteDataMemRec)); if (content == NULL) { ii = i; allocOK = FALSE; break; } content->y = N_VClone(tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = FALSE; break; } content->yd = N_VClone(tempv); if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = FALSE; break; } if (IMstoreSensi) { content->yS = N_VCloneVectorArray(Ns, tempv); if (content->yS == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = FALSE; break; } content->ySd = N_VCloneVectorArray(Ns, tempv); if (content->ySd == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, Ns); free(content); content = NULL; ii = i; allocOK = FALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(ytmp); if (IMstoreSensi) { N_VDestroyVectorArray(yStmp, Ns); } for (i=0; icontent); N_VDestroy(content->y); N_VDestroy(content->yd); if (IMstoreSensi) { N_VDestroyVectorArray(content->yS, Ns); N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * CVAhermiteFree * * This routine frees the memory allocated for data storage. */ static void CVAhermiteFree(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i; ca_mem = cv_mem->cv_adj_mem; N_VDestroy(ytmp); if (IMstoreSensi) { N_VDestroyVectorArray(yStmp, Ns); } dt_mem = ca_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = (HermiteDataMem) (dt_mem[i]->content); N_VDestroy(content->y); N_VDestroy(content->yd); if (IMstoreSensi) { N_VDestroyVectorArray(content->yS, Ns); N_VDestroyVectorArray(content->ySd, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } /* * CVAhermiteStorePnt ( -> IMstore ) * * This routine stores a new point (y,yd) in the structure d for use * in the cubic Hermite interpolation. * Note that the time is already stored. */ static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d) { CVadjMem ca_mem; HermiteDataMem content; int is, retval; ca_mem = cv_mem->cv_adj_mem; content = (HermiteDataMem) d->content; /* Load solution */ N_VScale(ONE, zn[0], content->y); if (IMstoreSensi) { for (is=0; isyS[is]); } /* Load derivative */ if (nst == 0) { retval = f(tn, content->y, content->yd, user_data); if (IMstoreSensi) { retval = cvSensRhsWrapper(cv_mem, tn, content->y, content->yd, content->yS, content->ySd, cv_mem->cv_tempv, cv_mem->cv_ftemp); } } else { N_VScale(ONE/h, zn[1], content->yd); if (IMstoreSensi) { for (is=0; isySd[is]); } } return(0); } /* * CVAhermiteGetY ( -> IMget ) * * This routine uses cubic piece-wise Hermite interpolation for * the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB) but * can be directly called by the user through CVodeGetAdjY */ static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content0, content1; realtype t0, t1, delta; realtype factor1, factor2, factor3; N_Vector y0, yd0, y1, yd1; N_Vector *yS0, *ySd0, *yS1, *ySd1; int flag, is, NS; long int indx; booleantype newpoint; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Local value of Ns */ NS = IMinterpSensi ? Ns : 0; /* Get the index in dt_mem */ flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); if (flag != CV_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content0 = (HermiteDataMem) (dt_mem[0]->content); N_VScale(ONE, content0->y, y); for (is=0; isyS[is], yS[is]); return(CV_SUCCESS); } /* Extract stuff from the appropriate data points */ t0 = dt_mem[indx-1]->t; t1 = dt_mem[indx]->t; delta = t1 - t0; content0 = (HermiteDataMem) (dt_mem[indx-1]->content); y0 = content0->y; yd0 = content0->yd; if (IMinterpSensi) { yS0 = content0->yS; ySd0 = content0->ySd; } if (newpoint) { /* Recompute Y0 and Y1 */ content1 = (HermiteDataMem) (dt_mem[indx]->content); y1 = content1->y; yd1 = content1->yd; N_VLinearSum(ONE, y1, -ONE, y0, Y[0]); N_VLinearSum(ONE, yd1, ONE, yd0, Y[1]); N_VLinearSum(delta, Y[1], -TWO, Y[0], Y[1]); N_VLinearSum(ONE, Y[0], -delta, yd0, Y[0]); yS1 = content1->yS; ySd1 = content1->ySd; for (is=0; iscv_adj_mem; /* Allocate space for the vectors ytmp and yStmp */ ytmp = N_VClone(tempv); if (ytmp == NULL) { return(FALSE); } if (IMstoreSensi) { yStmp = N_VCloneVectorArray(Ns, tempv); if (yStmp == NULL) { N_VDestroy(ytmp); return(FALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = ca_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = NULL; content = (PolynomialDataMem) malloc(sizeof(struct PolynomialDataMemRec)); if (content == NULL) { ii = i; allocOK = FALSE; break; } content->y = N_VClone(tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = FALSE; break; } if (IMstoreSensi) { content->yS = N_VCloneVectorArray(Ns, tempv); if (content->yS == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = FALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(ytmp); if (IMstoreSensi) { N_VDestroyVectorArray(yStmp, Ns); } for (i=0; icontent); N_VDestroy(content->y); if (IMstoreSensi) { N_VDestroyVectorArray(content->yS, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * CVApolynomialFree * * This routine frees the memeory allocated for data storage. */ static void CVApolynomialFree(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i; ca_mem = cv_mem->cv_adj_mem; N_VDestroy(ytmp); if (IMstoreSensi) { N_VDestroyVectorArray(yStmp, Ns); } dt_mem = ca_mem->dt_mem; for (i=0; i<=nsteps; i++) { content = (PolynomialDataMem) (dt_mem[i]->content); N_VDestroy(content->y); if (IMstoreSensi) { N_VDestroyVectorArray(content->yS, Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } /* * CVApolynomialStorePnt ( -> IMstore ) * * This routine stores a new point y in the structure d for use * in the Polynomial interpolation. * Note that the time is already stored. */ static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d) { CVadjMem ca_mem; PolynomialDataMem content; int is; ca_mem = cv_mem->cv_adj_mem; content = (PolynomialDataMem) d->content; N_VScale(ONE, zn[0], content->y); if (IMstoreSensi) { for (is=0; isyS[is]); } content->order = qu; return(0); } /* * CVApolynomialGetY ( -> IMget ) * * This routine uses polynomial interpolation for the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB)) but * can be directly called by the user through CVodeGetAdjY. */ static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS) { CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; int flag, dir, order, i, j, is, NS; long int indx, base; booleantype newpoint; realtype dt, factor; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Local value of Ns */ NS = IMinterpSensi ? Ns : 0; /* Get the index in dt_mem */ flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); if (flag != CV_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content = (PolynomialDataMem) (dt_mem[0]->content); N_VScale(ONE, content->y, y); for (is=0; isyS[is], yS[is]); return(CV_SUCCESS); } /* Scaling factor */ dt = ABS(dt_mem[indx]->t - dt_mem[indx-1]->t); /* Find the direction of the forward integration */ dir = (tfinal - tinitial > ZERO) ? 1 : -1; /* Establish the base point depending on the integration direction. Modify the base if there are not enough points for the current order */ if (dir == 1) { base = indx; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if(indx < order) base += order-indx; } else { base = indx-1; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if (np-indx > order) base -= indx+order-np; } /* Recompute Y (divided differences for Newton polynomial) if needed */ if (newpoint) { /* Store 0-th order DD */ if (dir == 1) { for(j=0;j<=order;j++) { T[j] = dt_mem[base-j]->t; content = (PolynomialDataMem) (dt_mem[base-j]->content); N_VScale(ONE, content->y, Y[j]); for (is=0; isyS[is], YS[j][is]); } } else { for(j=0;j<=order;j++) { T[j] = dt_mem[base-1+j]->t; content = (PolynomialDataMem) (dt_mem[base-1+j]->content); N_VScale(ONE, content->y, Y[j]); for (is=0; isyS[is], YS[j][is]); } } /* Compute higher-order DD */ for(i=1;i<=order;i++) { for(j=order;j>=i;j--) { factor = dt/(T[j]-T[j-i]); N_VLinearSum(factor, Y[j], -factor, Y[j-1], Y[j]); for (is=0; is=0; i--) { factor = (t-T[i])/dt; N_VLinearSum(factor, y, ONE, Y[i], y); for (is=0; iscv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; /* Get forward solution from interpolation */ if (IMinterpSensi) flag = IMget(cv_mem, t, ytmp, yStmp); else flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVODEA", "CVArhs", MSGCV_BAD_TINTERP, t); return(-1); } /* Call the user's RHS function */ if (cvB_mem->cv_f_withSensi) retval = (cvB_mem->cv_fs)(t, ytmp, yStmp, yB, yBdot, cvB_mem->cv_user_data); else retval = (cvB_mem->cv_f)(t, ytmp, yB, yBdot, cvB_mem->cv_user_data); return(retval); } /* * CVArhsQ * * This routine interfaces to the CVQuadRhsFnB (or CVQuadRhsFnBS) routine * provided by the user. */ static int CVArhsQ(realtype t, N_Vector yB, N_Vector qBdot, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; int flag, retval; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; /* Get forward solution from interpolation */ if (IMinterpSensi) flag = IMget(cv_mem, t, ytmp, yStmp); else flag = IMget(cv_mem, t, ytmp, NULL); /* Call the user's RHS function */ if (cvB_mem->cv_fQ_withSensi) retval = (cvB_mem->cv_fQs)(t, ytmp, yStmp, yB, qBdot, cvB_mem->cv_user_data); else retval = (cvB_mem->cv_fQ)(t, ytmp, yB, qBdot, cvB_mem->cv_user_data); return(retval); } sundials-2.5.0/src/cvodes/cvodes_dense.c0000600000175000017500000003046211741421150021072 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.15 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSDENSE linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvodes_direct_impl.h" #include "cvodes_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* CVSDENSE linit, lsetup, lsolve, and lfree routines */ static int cvDenseInit(CVodeMem cv_mem); static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void cvDenseFree(CVodeMem cv_mem); /* CVSDENSE lfreeB function */ static void cvDenseFreeB(CVodeBMem cvb_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define jacDQ (cvdls_mem->d_jacDQ) #define jac (cvdls_mem->d_djac) #define M (cvdls_mem->d_M) #define lpivots (cvdls_mem->d_lpivots) #define savedJ (cvdls_mem->d_savedJ) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ----------------------------------------------------------------- * CVDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the dense linear solver module. CVDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be cvDenseInit, cvDenseSetup, cvDenseSolve, and cvDenseFree, * respectively. It allocates memory for a structure of type * CVDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to * TRUE, and the d_jac field to the default CVDenseDQJac. * Finally, it allocates memory for M, savedJ, and lpivots. * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVDense will first * test for compatible a compatible N_Vector internal * representation by checking that N_VGetArrayPointer and * N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ int CVDense(void *cvode_mem, long int N) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDENSE", "CVDense", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDENSE", "CVDense", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree !=NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvDenseInit; lsetup = cvDenseSetup; lsolve = cvDenseSolve; lfree = cvDenseFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Initialize Jacobian-related data */ jacDQ = TRUE; jac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = N; /* Allocate memory for M, savedJ, and pivot array */ M = NULL; M = NewDenseMat(N, N); if (M == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NULL; savedJ = NewDenseMat(N, N); if (savedJ == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDense", MSGD_MEM_FAIL); DestroyMat(M); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * cvDenseInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the dense * linear solver. * ----------------------------------------------------------------- */ static int cvDenseInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { jac = cvDlsDenseDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvDenseSetup * ----------------------------------------------------------------- * This routine does the setup operations for the dense linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the dense LU * factorization routine. * ----------------------------------------------------------------- */ static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { CVDlsMem cvdls_mem; booleantype jbad, jok; realtype dgamma; int retval; long int ier; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; DenseCopy(savedJ, M); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSDENSE", "cvDenseSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } DenseCopy(M, savedJ); } /* Scale and add I to get M = I - gamma*J */ DenseScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = DenseGETRF(M, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = ier; if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * cvDenseSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the dense linear solver * by calling the dense backsolve routine. The returned value is 0. * ----------------------------------------------------------------- */ static int cvDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { CVDlsMem cvdls_mem; realtype *bd; cvdls_mem = (CVDlsMem) lmem; bd = N_VGetArrayPointer(b); DenseGETRS(M, lpivots, bd); /* If CV_BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { N_VScale(TWO/(ONE + gamrat), b, b); } last_flag = CVDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * cvDenseFree * ----------------------------------------------------------------- * This routine frees memory specific to the dense linear solver. * ----------------------------------------------------------------- */ static void cvDenseFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyMat(savedJ); DestroyArray(lpivots); free(cvdls_mem); cv_mem->cv_lmem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVDenseB is a wraper around CVDense. It attaches the CVSDENSE linear solver * to the backward problem memory block. */ int CVDenseB(void *cvode_mem, int which, long int nB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVDlsMemB cvdlsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDENSE", "CVDenseB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDENSE", "CVDenseB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDENSE", "CVDenseB", MSGD_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVDlsMemRecB */ cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); if (cvdlsB_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSDENSE", "CVDenseB", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* set matrix type */ cvdlsB_mem->d_typeB = SUNDIALS_DENSE; /* initialize Jacobian function */ cvdlsB_mem->d_djacB = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvdlsB_mem; cvB_mem->cv_lfree = cvDenseFreeB; flag = CVDense(cvodeB_mem, nB); if (flag != CVDLS_SUCCESS) { free(cvdlsB_mem); cvdlsB_mem = NULL; } return(flag); } /* * cvDenseFreeB frees the memory associated with the CVSDENSE linear * solver for backward integration. */ static void cvDenseFreeB(CVodeBMem cvB_mem) { CVDlsMemB cvdlsB_mem; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); free(cvdlsB_mem); } sundials-2.5.0/src/cvodes/cvodes_direct.c0000600000175000017500000004720311741421150021247 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSDLS linear solvers * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "cvodes_impl.h" #include "cvodes_direct_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ /* Constant for DQ Jacobian approximation */ #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static int cvDlsDenseJacBWrapper(long int nB, realtype t, N_Vector yB, N_Vector fyB, DlsMat JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int cvDlsBandJacBWrapper(long int nB, long int mupperB, long int mlowerB, realtype t, N_Vector yB, N_Vector fyB, DlsMat Jac, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define uround (cv_mem->cv_uround) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define lmem (cv_mem->cv_lmem) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define ml (cvdls_mem->d_ml) #define mu (cvdls_mem->d_mu) #define smu (cvdls_mem->d_smu) #define jacDQ (cvdls_mem->d_jacDQ) #define djac (cvdls_mem->d_djac) #define bjac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define savedJ (cvdls_mem->d_savedJ) #define pivots (cvdls_mem->d_pivots) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define last_flag (cvdls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS (FORWARD INTEGRATION) * ================================================================= */ /* * CVDlsSetDenseJacFn specifies the dense Jacobian function. */ int CVDlsSetDenseJacFn(void *cvode_mem, CVDlsDenseJacFn jac) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetDenseJacFn", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; djac = jac; } else { jacDQ = TRUE; } return(CVDLS_SUCCESS); } /* * CVDlsSetBandJacFn specifies the band Jacobian function. */ int CVDlsSetBandJacFn(void *cvode_mem, CVDlsBandJacFn jac) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "CVDlsSetBandJacFn", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; bjac = jac; } else { jacDQ = TRUE; } return(CVDLS_SUCCESS); } /* * CVDlsGetWorkSpace returns the length of workspace allocated for the * CVDLS linear solver. */ int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetWorkSpace", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetWorkSpace", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; if (mtype == SUNDIALS_DENSE) { *lenrwLS = 2*n*n; *leniwLS = n; } else if (mtype == SUNDIALS_BAND) { *lenrwLS = n*(smu + mu + 2*ml + 2); *leniwLS = n; } return(CVDLS_SUCCESS); } /* * CVDlsGetNumJacEvals returns the number of Jacobian evaluations. */ int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetNumJacEvals", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetNumJacEvals", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *njevals = nje; return(CVDLS_SUCCESS); } /* * CVDlsGetNumRhsEvals returns the number of calls to the ODE function * needed for the DQ Jacobian approximation. */ int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetNumRhsEvals", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetNumRhsEvals", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *nfevalsLS = nfeDQ; return(CVDLS_SUCCESS); } /* * CVDlsGetReturnFlagName returns the name associated with a CVDLS * return value. */ char *CVDlsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVDLS_SUCCESS: sprintf(name,"CVDLS_SUCCESS"); break; case CVDLS_MEM_NULL: sprintf(name,"CVDLS_MEM_NULL"); break; case CVDLS_LMEM_NULL: sprintf(name,"CVDLS_LMEM_NULL"); break; case CVDLS_ILL_INPUT: sprintf(name,"CVDLS_ILL_INPUT"); break; case CVDLS_MEM_FAIL: sprintf(name,"CVDLS_MEM_FAIL"); break; case CVDLS_JACFUNC_UNRECVR: sprintf(name,"CVDLS_JACFUNC_UNRECVR"); break; case CVDLS_JACFUNC_RECVR: sprintf(name,"CVDLS_JACFUNC_RECVR"); break; default: sprintf(name,"NONE"); } return(name); } /* * CVDlsGetLastFlag returns the last flag set in a CVDLS function. */ int CVDlsGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsGetLastFlag", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVSDLS", "CVDlsGetLastFlag", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } cvdls_mem = (CVDlsMem) lmem; *flag = last_flag; return(CVDLS_SUCCESS); } /* * ================================================================= * DQ JACOBIAN APPROXIMATIONS * ================================================================= */ /* * ----------------------------------------------------------------- * cvDlsDenseDQJac * ----------------------------------------------------------------- * This routine generates a dense difference quotient approximation to * the Jacobian of f(t,y). It assumes that a dense matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of J is obtained via * the macro DENSE_COL and this pointer is associated with an N_Vector * using the N_VGetArrayPointer/N_VSetArrayPointer functions. * Finally, the actual computation of the jth column of the Jacobian is * done with a call to N_VLinearSum. * ----------------------------------------------------------------- */ int cvDlsDenseDQJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype fnorm, minInc, inc, inc_inv, yjsaved, srur; realtype *tmp2_data, *y_data, *ewt_data; N_Vector ftemp, jthCol; long int j; int retval = 0; CVodeMem cv_mem; CVDlsMem cvdls_mem; /* data points to cvode_mem */ cv_mem = (CVodeMem) data; cvdls_mem = (CVDlsMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for ewt, y */ ewt_data = N_VGetArrayPointer(ewt); y_data = N_VGetArrayPointer(y); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; for (j = 0; j < N; j++) { /* Generate the jth col of J(tn,y) */ N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); yjsaved = y_data[j]; inc = MAX(srur*ABS(yjsaved), minInc/ewt_data[j]); y_data[j] += inc; retval = f(t, y, ftemp, user_data); nfeDQ++; if (retval != 0) break; y_data[j] = yjsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); DENSE_COL(Jac,j) = N_VGetArrayPointer(jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /* * ----------------------------------------------------------------- * cvDlsBandDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation to * the Jacobian of f(t,y). It assumes that a band matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. This makes it possible to get the address of a column * of J via the macro BAND_COL and to write a simple for loop to set * each of the elements of a column in succession. * ----------------------------------------------------------------- */ int cvDlsBandDQJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { N_Vector ftemp, ytemp; realtype fnorm, minInc, inc, inc_inv, srur; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; long int group, i, j, width, ngroups, i1, i2; int retval = 0; CVodeMem cv_mem; CVDlsMem cvdls_mem; /* data points to cvode_mem */ cv_mem = (CVodeMem) data; cvdls_mem = (CVDlsMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = tmp1; ytemp = tmp2; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < N; j+=width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y */ retval = f(tn, ytemp, ftemp, user_data); nfeDQ++; if (retval != 0) break; /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(Jac,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mupper); i2 = MIN(j+mlower, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(retval); } /* * ================================================================= * BACKWARD INTEGRATION SUPPORT * ================================================================= */ /* * ----------------------------------------------------------------- * Additional readability replacements * ----------------------------------------------------------------- */ #define ytmp (ca_mem->ca_ytmp) #define yStmp (ca_mem->ca_yStmp) #define IMget (ca_mem->ca_IMget) #define mtypeB (cvdlsB_mem->d_typeB) #define djacB (cvdlsB_mem->d_djacB) #define bjacB (cvdlsB_mem->d_bjacB) /* * ----------------------------------------------------------------- * EXPORTED FUNCTIONS * ----------------------------------------------------------------- */ int CVDlsSetDenseJacFnB(void *cvode_mem, int which, CVDlsDenseJacFnB jacB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVDlsMemB cvdlsB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); if (cvB_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEMB_NULL, "CVSDLS", "CVDlsSetDenseJacFnB", MSGD_LMEMB_NULL); return(CVDLS_LMEMB_NULL); } cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); djacB = jacB; if (jacB != NULL) { flag = CVDlsSetDenseJacFn(cvodeB_mem, cvDlsDenseJacBWrapper); } else { flag = CVDlsSetDenseJacFn(cvodeB_mem, NULL); } return(flag); } int CVDlsSetBandJacFnB(void *cvode_mem, int which, CVDlsBandJacFnB jacB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVDlsMemB cvdlsB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); if (cvB_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVDLS_LMEMB_NULL, "CVSDLS", "CVDlsSetBandJacFnB", MSGD_LMEMB_NULL); return(CVDLS_LMEMB_NULL); } cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); bjacB = jacB; if (jacB != NULL) { flag = CVDlsSetBandJacFn(cvodeB_mem, cvDlsBandJacBWrapper); } else { flag = CVDlsSetBandJacFn(cvodeB_mem, NULL); } return(flag); } /* * ----------------------------------------------------------------- * PRIVATE INTERFACE FUNCTIONS * ----------------------------------------------------------------- */ /* * cvDlsDenseJacBWrapper * * This routine interfaces to the CVDlsDenseJacFnB routine provided * by the user. cvDlsDenseJacBWrapper is of type CVDlsDenseJacFn. * NOTE: data here contains cvode_mem */ static int cvDlsDenseJacBWrapper(long int nB, realtype t, N_Vector yB, N_Vector fyB, DlsMat JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVDlsMemB cvdlsB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSDLS", "cvDlsDenseJacBWrapper", MSGD_BAD_TINTERP); return(-1); } /* Call user's adjoint dense djacB routine (of type CVDlsDenseJacFnB) */ retval = djacB(nB, t, ytmp, yB, fyB, JB, cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B); return(retval); } /* * cvDlsBandJacBWrapper * * This routine interfaces to the CVBandJacFnB routine provided * by the user. cvDlsBandJacBWrapper is of type CVDlsBandJacFn. * NOTE: data here contains cvode_mem */ static int cvDlsBandJacBWrapper(long int nB, long int mupperB, long int mlowerB, realtype t, N_Vector yB, N_Vector fyB, DlsMat JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVDlsMemB cvdlsB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSDLS", "cvDlsBandJacBWrapper", MSGD_BAD_TINTERP); return(-1); } /* Call user's adjoint band bjacB routine (of type CVDlsBandJacFnB) */ retval = bjacB(nB, mupperB, mlowerB, t, ytmp, yB, fyB, JB, cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B); return(retval); } sundials-2.5.0/src/cvodes/cvodes_spgmr.c0000600000175000017500000004120511741421150021121 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 22:58:46 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPGMR linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvodes_spils_impl.h" #include "cvodes_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPGMR linit, lsetup, lsolve, and lfree routines */ static int CVSpgmrInit(CVodeMem cv_mem); static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSpgmrFree(CVodeMem cv_mem); /* CVSPGMR lfreeB function */ static void CVSpgmrFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define mnewt (cv_mem->cv_mnewt) #define ropt (cv_mem->cv_ropt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * CVSpgmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Spgmr linear solver module. CVSpgmr first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSpgmrInit, CVSpgmrSetup, CVSpgmrSolve, and CVSpgmrFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSpgmr allocates memory for ytemp and x, and calls * SpgmrMalloc to allocate memory for the Spgmr solver. * ----------------------------------------------------------------- */ int CVSpgmr(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPGMR", "CVSpgmr", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if(vec_tmpl->ops->nvdotprod == NULL) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSpgmrInit; lsetup = CVSpgmrSetup; lsolve = CVSpgmrSolve; lfree = CVSpgmrFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPGMR; /* Set Spgmr parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Spgmr parameters */ cvspils_mem->s_gstype = MODIFIED_GS; cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmr", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt( N_VDotProd(ytemp, ytemp) ); /* Call SpgmrMalloc to allocate workspace for Spgmr */ spgmr_mem = NULL; spgmr_mem = SpgmrMalloc(mxl, vec_tmpl); if (spgmr_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPGMR memory to spils memory structure */ spils_mem = (void *) spgmr_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability Replacements */ #define pretype (cvspils_mem->s_pretype) #define gstype (cvspils_mem->s_gstype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * CVSpgmrInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Spgmr * linear solver. * ----------------------------------------------------------------- */ static int CVSpgmrInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { cvProcessError(cv_mem, -1, "CVSPGMR", "CVSpgmrInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVSpgmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Spgmr linear solver. * It makes a decision as to whether or not to signal for re-evaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for re-evaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSpgmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, SPGMR_PSET_FAIL_UNREC, "CVSPGMR", "CVSpgmrSetup", MSGS_PSET_FAILED); last_flag = SPGMR_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPGMR_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPGMR_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * CVSpgmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SpgmrSolve * for the solution of the linear system Ax = b with the SPGMR method, * without restarts. The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SpgmrSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight, and no restarts are allowed. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SpgmrSolve. The success flag is * returned if SpgmrSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSpgmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac*tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SpgmrSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SpgmrSolve and copy x to b */ retval = SpgmrSolve(spgmr_mem, cv_mem, x, b, pretype, gstype, delta, 0, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPGMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPGMR_SUCCESS: return(0); break; case SPGMR_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPGMR_CONV_FAIL: return(1); break; case SPGMR_QRFACT_FAIL: return(1); break; case SPGMR_PSOLVE_FAIL_REC: return(1); break; case SPGMR_ATIMES_FAIL_REC: return(1); break; case SPGMR_MEM_NULL: return(-1); break; case SPGMR_ATIMES_FAIL_UNREC: cvProcessError(cv_mem, SPGMR_ATIMES_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPGMR_PSOLVE_FAIL_UNREC: cvProcessError(cv_mem, SPGMR_PSOLVE_FAIL_UNREC, "CVSPGMR", "CVSpgmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; case SPGMR_GS_FAIL: return(-1); break; case SPGMR_QRSOL_FAIL: return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * CVSpgmrFree * ----------------------------------------------------------------- * This routine frees memory specific to the Spgmr linear solver. * ----------------------------------------------------------------- */ static void CVSpgmrFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SpgmrMem spgmr_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); spgmr_mem = (SpgmrMem) spils_mem; SpgmrFree(spgmr_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Additional readability replacements */ #define pset_B (cvspilsB_mem->s_psetB) #define psolve_B (cvspilsB_mem->s_psolveB) #define jtimes_B (cvspilsB_mem->s_jtimesB) #define P_data_B (cvspilsB_mem->s_P_dataB) /* * CVSpgmrB * * Wrapper for the backward phase * */ int CVSpgmrB(void *cvode_mem, int which, int pretypeB, int maxlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVSpilsMemB cvspilsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPGMR", "CVSpgmrB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPGMR", "CVSpgmrB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPGMR", "CVSpgmrB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVSpilsMemRecB */ cvspilsB_mem = NULL; cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); if (cvspilsB_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPGMR", "CVSpgmrB", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } pset_B = NULL; psolve_B = NULL; P_data_B = NULL; /* initialize Jacobian function */ jtimes_B = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvspilsB_mem; cvB_mem->cv_lfree = CVSpgmrFreeB; flag = CVSpgmr(cvodeB_mem, pretypeB, maxlB); if (flag != CVSPILS_SUCCESS) { free(cvspilsB_mem); cvspilsB_mem = NULL; } return(flag); } /* * CVSpgmrFreeB */ static void CVSpgmrFreeB(CVodeBMem cvB_mem) { CVSpilsMemB cvspilsB_mem; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); free(cvspilsB_mem); } sundials-2.5.0/src/cvodes/cvodes_bbdpre_impl.h0000600000175000017500000000556111741421150022262 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:30:42 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the CVBBDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVSBBDPRE_IMPL_H #define _CVSBBDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ----------------------------------------------------------------- * Type: CVBBDPrecData * ----------------------------------------------------------------- */ typedef struct CVBBDPrecDataRec { /* passed by user to CVBBDPrecAlloc and used by PrecSetup/PrecSolve */ long int mudq, mldq, mukeep, mlkeep; realtype dqrely; CVLocalFn gloc; CVCommFn cfn; /* set by CVBBDPrecSetup and used by CVBBDPrecSolve */ DlsMat savedJ; DlsMat savedP; long int *lpivots; /* set by CVBBDPrecAlloc and used by CVBBDPrecSetup */ long int n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to cvode_mem */ void *cvode_mem; } *CVBBDPrecData; /* * ----------------------------------------------------------------- * Type: CVBBDPrecDataB * ----------------------------------------------------------------- */ typedef struct CVBBDPrecDataRecB { /* BBD user functions (glocB and cfnB) for backward run */ CVLocalFnB glocB; CVCommFnB cfnB; } *CVBBDPrecDataB; /* * ----------------------------------------------------------------- * CVBBDPRE error messages * ----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. CVBBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." #define MSGBBD_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." #define MSGBBD_BAD_WHICH "Illegal value for the which parameter." #define MSGBBD_PDATAB_NULL "BBD preconditioner memory is NULL for the backward integration." #define MSGBBD_BAD_TINTERP "Bad t for interpolation." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/cvodes_diag_impl.h0000600000175000017500000000432211741421150021722 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:30:42 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the diagonal linear solver, CVDIAG. * ----------------------------------------------------------------- */ #ifndef _CVSDIAG_IMPL_H #define _CVSDIAG_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: CVDiagMemRec, CVDiagMem * ----------------------------------------------------------------- * The type CVDiagMem is pointer to a CVDiagMemRec. * This structure contains CVDiag solver-specific data. * ----------------------------------------------------------------- */ typedef struct { realtype di_gammasv; /* gammasv = gamma at the last call to setup or solve */ N_Vector di_M; /* M = (I - gamma J)^{-1} , gamma = h / l1 */ N_Vector di_bit; /* temporary storage vector */ N_Vector di_bitcomp; /* temporary storage vector */ long int di_nfeDI; /* no. of calls to f due to difference quotient diagonal Jacobian approximation */ long int di_last_flag; /* last error return flag */ } CVDiagMemRec, *CVDiagMem; /* Error Messages */ #define MSGDG_CVMEM_NULL "Integrator memory is NULL." #define MSGDG_MEM_FAIL "A memory request failed." #define MSGDG_BAD_NVECTOR "A required vector operation is not implemented." #define MSGDG_LMEM_NULL "CVDIAG memory is NULL." #define MSGDG_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #define MSGDG_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGDG_BAD_WHICH "Illegal value for which." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/LICENSE0000600000175000017500000000550611741421150017273 0ustar sylvestresylvestreCopyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory Written by A.C. Hindmarsh and R. Serban. UCRL-CODE-155950 All rights reserved. This file is part of CVODES v2.1.0. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/src/cvodes/cvodes_direct_impl.h0000600000175000017500000001254111741421150022272 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:30:42 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the CVDLS linear solvers. * ----------------------------------------------------------------- */ #ifndef _CVSDLS_IMPL_H #define _CVSDLS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ================================================================= * C V S D I R E C T I N T E R N A L C O N S T A N T S * ================================================================= */ /* * ----------------------------------------------------------------- * CVDLS solver constants * ----------------------------------------------------------------- * CVD_MSBJ maximum number of steps between Jacobian evaluations * CVD_DGMAX maximum change in gamma between Jacobian evaluations * ----------------------------------------------------------------- */ #define CVD_MSBJ 50 #define CVD_DGMAX RCONST(0.2) /* * ================================================================= * PART I: F O R W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types: CVDlsMemRec, CVDlsMem * ----------------------------------------------------------------- * CVDlsMem is pointer to a CVDlsMemRec structure. * ----------------------------------------------------------------- */ typedef struct CVDlsMemRec { int d_type; /* SUNDIALS_DENSE or SUNDIALS_BAND */ long int d_n; /* problem dimension */ long int d_ml; /* lower bandwidth of Jacobian */ long int d_mu; /* upper bandwidth of Jacobian */ long int d_smu; /* upper bandwith of M = MIN(N-1,d_mu+d_ml) */ booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ CVDlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ CVDlsBandJacFn d_bjac; /* band Jacobian routine to be called */ void *d_J_data; /* data pointer passed to djac or bjac */ DlsMat d_M; /* M = I - gamma * df/dy */ DlsMat d_savedJ; /* savedJ = old Jacobian */ int *d_pivots; /* pivots = int pivot array for PM = LU */ long int *d_lpivots; /* lpivots = long int pivot array for PM = LU */ long int d_nstlj; /* nstlj = nst at last Jacobian eval. */ long int d_nje; /* nje = no. of calls to jac */ long int d_nfeDQ; /* no. of calls to f due to DQ Jacobian approx. */ long int d_last_flag; /* last error return flag */ } *CVDlsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ int cvDlsDenseDQJac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int cvDlsBandDQJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* * ================================================================= * PART II: B A C K W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : CVDlsMemRecB, CVDlsMemB * ----------------------------------------------------------------- * A CVDLS linear solver's specification function attaches such * a structure to the lmemB filed of CVodeBMem * ----------------------------------------------------------------- */ typedef struct CVDlsMemRecB { int d_typeB; CVDlsDenseJacFnB d_djacB; CVDlsBandJacFnB d_bjacB; } *CVDlsMemB; /* * ================================================================= * E R R O R M E S S A G E S * ================================================================= */ #define MSGD_CVMEM_NULL "Integrator memory is NULL." #define MSGD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSGD_MEM_FAIL "A memory request failed." #define MSGD_LMEM_NULL "Linear solver memory is NULL." #define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #define MSGD_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGD_BAD_WHICH "Illegal value for which." #define MSGD_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSGD_BAD_TINTERP "Bad t for interpolation." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/cvodes_bandpre.c0000600000175000017500000004067211741421150021413 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of the banded difference * quotient Jacobian-based preconditioner and solver routines for * use with the CVSPILS linear solvers. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include "cvodes_bandpre_impl.h" #include "cvodes_spils_impl.h" #include #include #include #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes of cvBandPrecSetup and cvBandPrecSolve */ static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data, N_Vector tmp); /* Prototype for cvBandPrecFree */ static void cvBandPrecFree(CVodeMem cv_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int cvBandPrecDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Redability replacements */ #define vec_tmpl (cv_mem->cv_tempv) /* * ----------------------------------------------------------------- * Initialization, Free, and Get Functions * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVBandPrecInit will * first test for a compatible N_Vector internal representation * by checking that the function N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVBandPrecInit(void *cvode_mem, long int N, long int mu, long int ml) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; long int mup, mlp, storagemu; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecInit", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the NVECTOR package is compatible with the BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInit", MSGBP_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } pdata = NULL; pdata = (CVBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */ if (pdata == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Load pointers and bandwidths into pdata block. */ pdata->cvode_mem = cvode_mem; pdata->N = N; pdata->mu = mup = MIN(N-1, MAX(0,mu)); pdata->ml = mlp = MIN(N-1, MAX(0,ml)); /* Initialize nfeBP counter */ pdata->nfeBP = 0; /* Allocate memory for saved banded Jacobian approximation. */ pdata->savedJ = NULL; pdata->savedJ = NewBandMat(N, mup, mlp, mup); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for banded preconditioner. */ storagemu = MIN(N-1, mup+mlp); pdata->savedP = NULL; pdata->savedP = NewBandMat(N, mup, mlp, storagemu); if (pdata->savedP == NULL) { DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for pivot array. */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(N); if (pdata->lpivots == NULL) { DestroyMat(pdata->savedP); DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Overwrite the P_data field in the SPILS memory */ cvspils_mem->s_P_data = pdata; /* Attach the pfree function */ cvspils_mem->s_pfree = cvBandPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, cvBandPrecSetup, cvBandPrecSolve); return(flag); } int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwBP, long int *leniwBP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; long int N, ml, mu, smu; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBandPrecData) cvspils_mem->s_P_data; N = pdata->N; mu = pdata->mu; ml = pdata->ml; smu = MIN( N-1, mu + ml); *leniwBP = pdata->N; *lenrwBP = N * ( 2*ml + smu + mu + 2 ); return(CVSPILS_SUCCESS); } int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBandPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBandPrecData) cvspils_mem->s_P_data; *nfevalsBP = pdata->nfeBP; return(CVSPILS_SUCCESS); } /* Readability Replacements */ #define N (pdata->N) #define mu (pdata->mu) #define ml (pdata->ml) #define lpivots (pdata->lpivots) #define savedJ (pdata->savedJ) #define savedP (pdata->savedP) #define nfeBP (pdata->nfeBP) /* * ----------------------------------------------------------------- * cvBandPrecSetup * ----------------------------------------------------------------- * Together cvBandPrecSetup and cvBandPrecSolve use a banded * difference quotient Jacobian to create a preconditioner. * cvBandPrecSetup calculates a new J, if necessary, then * calculates P = I - gamma*J, and does an LU factorization of P. * * The parameters of cvBandPrecSetup are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data from the * previous PrecSetup call will be reused * (with the current value of gamma). * A cvBandPrecSetup call with jok == TRUE should only * occur after a call with jok == FALSE. * * *jcurPtr is a pointer to an output integer flag which is * set by CVBandPrecond as follows: * *jcurPtr = TRUE if Jacobian data was recomputed. * *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for vectors of length N for work space. This * routine uses only tmp1 and tmp2. * * The value to be returned by the cvBandPrecSetup function is * 0 if successful, or * 1 if the band factorization failed. * ----------------------------------------------------------------- */ static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVBandPrecData pdata; CVodeMem cv_mem; int retval; long int ier; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mu, ml); } else { /* If jok = FALSE, call cvBandPrecDQJac for new J value. */ *jcurPtr = TRUE; SetToZero(savedJ); retval = cvBandPrecDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mu, ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of matrix. */ ier = BandGBTRF(savedP, lpivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * cvBandPrecSolve * ----------------------------------------------------------------- * cvBandPrecSolve solves a linear system P z = r, where P is the * matrix computed by CVBandPrecond. * * The parameters of cvBandPrecSolve used here are as follows: * * r is the right-hand side vector of the linear system. * * bp_data is a pointer to preconditoner data (set by CVBandPrecInit) * * z is the output vector computed by cvBandPrecSolve. * * The value returned by the cvBandPrecSolve function is always 0, * indicating success. * ----------------------------------------------------------------- */ static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data, N_Vector tmp) { CVBandPrecData pdata; realtype *zd; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; /* Copy r to z. */ N_VScale(ONE, r, z); /* Do band backsolve on the vector z. */ zd = N_VGetArrayPointer(z); BandGBTRS(savedP, lpivots, zd); return(0); } static void cvBandPrecFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; CVBandPrecData pdata; if (cv_mem->cv_lmem == NULL) return; cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) return; pdata = (CVBandPrecData) cvspils_mem->s_P_data; DestroyMat(savedJ); DestroyMat(savedP); DestroyArray(lpivots); free(pdata); pdata = NULL; } #define ewt (cv_mem->cv_ewt) #define uround (cv_mem->cv_uround) #define h (cv_mem->cv_h) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) /* * ----------------------------------------------------------------- * cvBandPrecDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation to * the Jacobian of f(t,y). It assumes that a band matrix of type * BandMat is stored column-wise, and that elements within each column * are contiguous. This makes it possible to get the address of a column * of J via the macro BAND_COL and to write a simple for loop to set * each of the elements of a column in succession. * ----------------------------------------------------------------- */ static int cvBandPrecDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp) { CVodeMem cv_mem; realtype fnorm, minInc, inc, inc_inv, srur; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector. */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f. */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing. */ width = ml + mu + 1; ngroups = MIN(width, N); for (group = 1; group <= ngroups; group++) { /* Increment all y_j in group. */ for(j = group-1; j < N; j += width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y. */ retval = f(t, ytemp, ftemp, user_data); nfeBP++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients. */ for (j = group-1; j < N; j += width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mu); i2 = MIN(j+ml, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVBandPrecInitB, CVBPSp*B * * Wrappers for the backward phase around the corresponding * CVODES functions */ int CVBandPrecInitB(void *cvode_mem, int which, long int nB, long int muB, long int mlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBANDPRE", "CVBandPrecInitB", MSGBP_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBANDPRE", "CVBandPrecInitB", MSGBP_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBANDPRE", "CVBandPrecInitB", MSGBP_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvB_mem->cv_pfree = NULL; cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVBandPrecInit(cvodeB_mem, nB, muB, mlB); return(flag); } sundials-2.5.0/src/cvodes/cvodes_spils_impl.h0000600000175000017500000001525711741421150022161 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:30:42 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the scaled, preconditioned * iterative linear solvers * ----------------------------------------------------------------- */ #ifndef _CVSSPILS_IMPL_H #define _CVSSPILS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "cvodes_impl.h" /* * ================================================================= * C V S P I L S I N T E R N A L C O N S T A N T S * ================================================================= */ /* Types of iterative linear solvers */ #define SPILS_SPGMR 1 #define SPILS_SPBCG 2 #define SPILS_SPTFQMR 3 /* * ================================================================= * PART I: F O R W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : CVSpilsMemRec, CVSpilsMem * ----------------------------------------------------------------- * The type CVSpilsMem is pointer to a CVSpilsMemRec. * ----------------------------------------------------------------- */ typedef struct CVSpilsMemRec { int s_type; /* type of scaled preconditioned iterative LS */ int s_pretype; /* type of preconditioning */ int s_gstype; /* type of Gram-Schmidt orthogonalization */ realtype s_sqrtN; /* sqrt(N) */ realtype s_eplifac; /* eplifac = user specified or EPLIN_DEFAULT */ realtype s_deltar; /* deltar = delt * tq4 */ realtype s_delta; /* delta = deltar * sqrtN */ int s_maxl; /* maxl = maximum dimension of the Krylov space */ long int s_nstlpre; /* value of nst at the last pset call */ long int s_npe; /* npe = total number of pset calls */ long int s_nli; /* nli = total number of linear iterations */ long int s_nps; /* nps = total number of psolve calls */ long int s_ncfl; /* ncfl = total number of convergence failures */ long int s_njtimes; /* njtimes = total number of calls to jtimes */ long int s_nfes; /* nfeSG = total number of calls to f for difference quotient Jacobian-vector products */ N_Vector s_ytemp; /* temp vector passed to jtimes and psolve */ N_Vector s_x; /* temp vector used by CVSpilsSolve */ N_Vector s_ycur; /* CVODE current y vector in Newton Iteration */ N_Vector s_fcur; /* fcur = f(tn, ycur) */ void* s_spils_mem; /* memory used by the generic solver */ /* Preconditioner computation * (a) user-provided: * - P_data == user_data * - pfree == NULL (the user dealocates memory for user_data) * (b) internal preconditioner module * - P_data == cvode_mem * - pfree == set by the prec. module and called in CVodeFree */ CVSpilsPrecSetupFn s_pset; CVSpilsPrecSolveFn s_psolve; void (*s_pfree)(CVodeMem cv_mem); void *s_P_data; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - j_data == user_data * - jtimesDQ == FALSE * (b) internal jtimes * - j_data == cvode_mem * - jtimesDQ == TRUE */ booleantype s_jtimesDQ; CVSpilsJacTimesVecFn s_jtimes; void *s_j_data; long int s_last_flag; /* last error flag returned by any function */ } *CVSpilsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ /* Atimes and PSolve routines called by generic solver */ int CVSpilsAtimes(void *cv_mem, N_Vector v, N_Vector z); int CVSpilsPSolve(void *cv_mem, N_Vector r, N_Vector z, int lr); /* Difference quotient approximation for Jac times vector */ int CVSpilsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *data, N_Vector work); /* * ================================================================= * PART II: B A C K W A R D P R O B L E M S * ================================================================= */ /* * ----------------------------------------------------------------- * Types : CVSpilsMemRecB, CVSpilsMemB * ----------------------------------------------------------------- * CVSpgmrB, CVSpbcgB, and CVSptfqmr attach such a structure to the * lmemB filed of CVodeBMem * ----------------------------------------------------------------- */ typedef struct CVSpilsMemRecB { CVSpilsJacTimesVecFnB s_jtimesB; CVSpilsPrecSetupFnB s_psetB; CVSpilsPrecSolveFnB s_psolveB; void *s_P_dataB; } *CVSpilsMemB; /* * ================================================================= * E R R O R M E S S A G E S * ================================================================= */ #define MSGS_CVMEM_NULL "Integrator memory is NULL." #define MSGS_MEM_FAIL "A memory request failed." #define MSGS_BAD_NVECTOR "A required vector operation is not implemented." #define MSGS_BAD_LSTYPE "Incompatible linear solver type." #define MSGS_BAD_PRETYPE "Illegal value for pretype. Legal values are PREC_NONE, PREC_LEFT, PREC_RIGHT, and PREC_BOTH." #define MSGS_PSOLVE_REQ "pretype != PREC_NONE, but PSOLVE = NULL is illegal." #define MSGS_LMEM_NULL "Linear solver memory is NULL." #define MSGS_BAD_GSTYPE "Illegal value for gstype. Legal values are MODIFIED_GS and CLASSICAL_GS." #define MSGS_BAD_EPLIN "eplifac < 0 illegal." #define MSGS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSGS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSGS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." #define MSGS_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGS_BAD_WHICH "Illegal value for which." #define MSGS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSGS_BAD_TINTERP "Bad t for interpolation." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/cvodes_lapack.c0000600000175000017500000005734611741421150021241 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.15 $ * $Date: 2011/03/23 22:58:46 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a dense or banded CVODES * linear solver using BLAS and LAPACK functions. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include "cvodes_direct_impl.h" #include "cvodes_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* CVSLAPACK DENSE linit, lsetup, lsolve, and lfree routines */ static int cvLapackDenseInit(CVodeMem cv_mem); static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC); static void cvLapackDenseFree(CVodeMem cv_mem); /* CVSLAPACK BAND linit, lsetup, lsolve, and lfree routines */ static int cvLapackBandInit(CVodeMem cv_mem); static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC); static void cvLapackBandFree(CVodeMem cv_mem); /* CVSLAPACK lfreeB functions */ static void cvLapackDenseFreeB(CVodeBMem cvB_mem); static void cvLapackBandFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lmm (cv_mem->cv_lmm) #define f (cv_mem->cv_f) #define uround (cv_mem->cv_uround) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define gamrat (cv_mem->cv_gamrat) #define ewt (cv_mem->cv_ewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define tempv (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define mtype (cvdls_mem->d_type) #define n (cvdls_mem->d_n) #define jacDQ (cvdls_mem->d_jacDQ) #define djac (cvdls_mem->d_djac) #define bjac (cvdls_mem->d_bjac) #define M (cvdls_mem->d_M) #define mu (cvdls_mem->d_mu) #define ml (cvdls_mem->d_ml) #define smu (cvdls_mem->d_smu) #define pivots (cvdls_mem->d_pivots) #define savedJ (cvdls_mem->d_savedJ) #define nstlj (cvdls_mem->d_nstlj) #define nje (cvdls_mem->d_nje) #define nfeDQ (cvdls_mem->d_nfeDQ) #define J_data (cvdls_mem->d_J_data) #define last_flag (cvdls_mem->d_last_flag) /* * ----------------------------------------------------------------- * CVLapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. CVLapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be cvLapackDenseInit, cvLapackDenseSetup, cvLapackDenseSolve, * and cvLapackDenseFree, respectively. It allocates memory for a * structure of type CVDlsMemRec and sets the cv_lmem field in * (*cvode_mem) to the address of this structure. It sets setupNonNull * in (*cvode_mem) to TRUE, and the d_jac field to the default * cvDlsDenseDQJac. Finally, it allocates memory for M, pivots, and * (if needed) savedJ. * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVLapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int CVLapackDense(void *cvode_mem, int N) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackDense", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the CVSLAPACK solver */ if (tempv->ops->nvgetarraypointer == NULL || tempv->ops->nvsetarraypointer == NULL) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackDense", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree !=NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvLapackDenseInit; lsetup = cvLapackDenseSetup; lsolve = cvLapackDenseSolve; lfree = cvLapackDenseFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Initialize Jacobian-related data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for M, pivot array, and (if needed) savedJ */ M = NULL; pivots = NULL; savedJ = NULL; M = NewDenseMat(n, n); if (M == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NewDenseMat(n, n); if (savedJ == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDense", MSGD_MEM_FAIL); DestroyMat(M); DestroyArray(pivots); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ----------------------------------------------------------------- * CVLapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) * to be cvLapackBandInit, cvLapackBandSetup, cvLapackBandSolve, * and cvLapackBandFree, respectively. It allocates memory for a * structure of type CVLapackBandMemRec and sets the cv_lmem field in * (*cvode_mem) to the address of this structure. It sets setupNonNull * in (*cvode_mem) to be TRUE, mu to be mupper, ml to be mlower, and * the jacE and jacI field to NULL. * Finally, it allocates memory for M, pivots, and (if needed) savedJ. * The CVLapackBand return value is CVDLS_SUCCESS = 0, * CVDLS_MEM_FAIL = -1, or CVDLS_ILL_INPUT = -2. * * NOTE: The CVSLAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, CVLapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int CVLapackBand(void *cvode_mem, int N, int mupper, int mlower) { CVodeMem cv_mem; CVDlsMem cvdls_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackBand", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (tempv->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBand", MSGD_BAD_NVECTOR); return(CVDLS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = cvLapackBandInit; lsetup = cvLapackBandSetup; lsolve = cvLapackBandSolve; lfree = cvLapackBandFree; /* Get memory for CVDlsMemRec */ cvdls_mem = NULL; cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec)); if (cvdls_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Initialize Jacobian-related data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = CVDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwiths in cvdls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBand", MSGD_BAD_SIZES); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for M, savedJ, and pivot arrays */ M = NULL; pivots = NULL; savedJ = NULL; M = NewBandMat(n, mu, ml, smu); if (M == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); DestroyMat(M); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } savedJ = NewBandMat(n, mu, ml, smu); if (savedJ == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBand", MSGD_MEM_FAIL); DestroyMat(M); DestroyArray(pivots); free(cvdls_mem); cvdls_mem = NULL; return(CVDLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdls_mem; return(CVDLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH DENSE JACOBIANS * ================================================================= */ /* * cvLapackDenseInit does remaining initializations specific to the dense * linear solver. */ static int cvLapackDenseInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { djac = cvDlsDenseDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackDenseSetup does the setup operations for the dense linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J * updates counters, and calls the dense LU factorization routine. */ static int cvLapackDenseSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVDlsMem cvdls_mem; realtype dgamma, fact; booleantype jbad, jok; int ier, retval, one = 1; int intn, lenmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; lenmat = M->ldata; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; dcopy_f77(&lenmat, savedJ->data, &one, M->data, &one); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = djac(n, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); if (retval == 0) { dcopy_f77(&lenmat, M->data, &one, savedJ->data, &one); } else if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSLAPACK", "cvLapackDenseSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } } /* Scale J by - gamma */ fact = -gamma; dscal_f77(&lenmat, &fact, M->data, &one); /* Add identity to get M = I - gamma*J*/ AddIdentity(M); /* Do LU factorization of M */ dgetrf_f77(&intn, &intn, M->data, &intn, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * cvLapackDenseSolve handles the solve operation for the dense linear solver * by calling the dense backsolve routine. */ static int cvLapackDenseSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC) { CVDlsMem cvdls_mem; realtype *bd, fact; int ier, one = 1; int intn; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; bd = N_VGetArrayPointer(b); dgetrs_f77("N", &intn, &one, M->data, &intn, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { fact = TWO/(ONE + gamrat); dscal_f77(&intn, &fact, bd, &one); } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackDenseFree frees memory specific to the dense linear solver. */ static void cvLapackDenseFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyArray(pivots); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS FOR IMPLICIT INTEGRATION WITH BAND JACOBIANS * ================================================================= */ /* * cvLapackBandInit does remaining initializations specific to the band * linear solver. */ static int cvLapackBandInit(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; nje = 0; nfeDQ = 0; nstlj = 0; /* Set Jacobian function and data, depending on jacDQ */ if (jacDQ) { bjac = cvDlsBandDQJac; J_data = cv_mem; } else { J_data = cv_mem->cv_user_data; } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackBandSetup does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix M = I - gamma*J, * updates counters, and calls the band LU factorization routine. */ static int cvLapackBandSetup(CVodeMem cv_mem, int convfail, N_Vector yP, N_Vector fctP, booleantype *jcurPtr, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVDlsMem cvdls_mem; realtype dgamma, fact; booleantype jbad, jok; int ier, retval, one = 1; int intn, iml, imu, lenmat, ldmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; lenmat = M->ldata; ldmat = M->ldim; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; dcopy_f77(&lenmat, savedJ->data, &one, M->data, &one); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = bjac(n, mu, ml, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3); if (retval == 0) { dcopy_f77(&lenmat, M->data, &one, savedJ->data, &one); } else if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSLAPACK", "cvLapackBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } } /* Scale J by - gamma */ fact = -gamma; dscal_f77(&lenmat, &fact, M->data, &one); /* Add identity to get M = I - gamma*J*/ AddIdentity(M); /* Do LU factorization of M */ dgbtrf_f77(&intn, &intn, &iml, &imu, M->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); } /* * cvLapackBandSolve handles the solve operation for the band linear solver * by calling the band backsolve routine. */ static int cvLapackBandSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector yC, N_Vector fctC) { CVDlsMem cvdls_mem; realtype *bd, fact; int ier, one = 1; int intn, iml, imu, ldmat; cvdls_mem = (CVDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = M->ldim; bd = N_VGetArrayPointer(b); dgbtrs_f77("N", &intn, &iml, &imu, &one, M->data, &ldmat, pivots, bd, &intn, &ier, 1); if (ier > 0) return(1); /* For BDF, scale the correction to account for change in gamma */ if ((lmm == CV_BDF) && (gamrat != ONE)) { fact = TWO/(ONE + gamrat); dscal_f77(&intn, &fact, bd, &one); } last_flag = CVDLS_SUCCESS; return(0); } /* * cvLapackBandFree frees memory specific to the band linear solver. */ static void cvLapackBandFree(CVodeMem cv_mem) { CVDlsMem cvdls_mem; cvdls_mem = (CVDlsMem) lmem; DestroyMat(M); DestroyArray(pivots); DestroyMat(savedJ); free(cvdls_mem); cvdls_mem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVLapackDenseB is a wraper around CVLapackDense. It attaches the * dense CVSLAPACK linear solver to the backward problem memory block. */ int CVLapackDenseB(void *cvode_mem, int which, int nB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVDlsMemB cvdlsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackDenseB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSLAPACK", "CVLapackDenseB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackDenseB", MSGCV_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVDlsMemRecB */ cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); if (cvdlsB_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackDenseB", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* set matrix type */ cvdlsB_mem->d_typeB = SUNDIALS_DENSE; /* initialize Jacobian function */ cvdlsB_mem->d_djacB = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvdlsB_mem; cvB_mem->cv_lfree = cvLapackDenseFreeB; flag = CVLapackDense(cvodeB_mem, nB); if (flag != CVDLS_SUCCESS) { free(cvdlsB_mem); cvdlsB_mem = NULL; } return(flag); } /* * cvLapackDenseFreeB frees the memory associated with the dense CVSLAPACK * linear solver for backward integration. */ static void cvLapackDenseFreeB(CVodeBMem cvB_mem) { CVDlsMemB cvdlsB_mem; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); free(cvdlsB_mem); } /* * CVLapackBandB is a wraper around CVLapackBand. It attaches the band * CVSLAPACK linear solver to the backward problem memory block. */ int CVLapackBandB(void *cvode_mem, int which, int nB, int mupperB, int mlowerB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVDlsMemB cvdlsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDLS_MEM_NULL, "CVSLAPACK", "CVLapackBandB", MSGD_CVMEM_NULL); return(CVDLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDLS_NO_ADJ, "CVSLAPACK", "CVLapackBandB", MSGD_NO_ADJ); return(CVDLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVSLAPACK", "CVLapackBandB", MSGCV_BAD_WHICH); return(CVDLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVDlsMemRecB */ cvdlsB_mem = (CVDlsMemB) malloc(sizeof(struct CVDlsMemRecB)); if (cvdlsB_mem == NULL) { cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVSLAPACK", "CVLapackBandB", MSGD_MEM_FAIL); return(CVDLS_MEM_FAIL); } /* set matrix type */ cvdlsB_mem->d_typeB = SUNDIALS_BAND; /* initialize Jacobian function */ cvdlsB_mem->d_bjacB = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvdlsB_mem; cvB_mem->cv_lfree = cvLapackBandFreeB; flag = CVLapackBand(cvodeB_mem, nB, mupperB, mlowerB); if (flag != CVDLS_SUCCESS) { free(cvdlsB_mem); cvdlsB_mem = NULL; } return(flag); } /* * cvLapackBandFreeB frees the memory associated with the band CVSLAPACK * linear solver for backward integration. */ static void cvLapackBandFreeB(CVodeBMem cvB_mem) { CVDlsMemB cvdlsB_mem; cvdlsB_mem = (CVDlsMemB) (cvB_mem->cv_lmem); free(cvdlsB_mem); } sundials-2.5.0/src/cvodes/cvodes_diag.c0000600000175000017500000003314111741421150020675 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.9 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVDIAG linear solver. * ----------------------------------------------------------------- */ #include #include #include "cvodes_diag_impl.h" #include "cvodes_impl.h" /* Other Constants */ #define FRACT RCONST(0.1) #define ONE RCONST(1.0) /* CVDIAG linit, lsetup, lsolve, and lfree routines */ static int CVDiagInit(CVodeMem cv_mem); static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static void CVDiagFree(CVodeMem cv_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) #define f (cv_mem->cv_f) #define uround (cv_mem->cv_uround) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define rl1 (cv_mem->cv_rl1) #define gamma (cv_mem->cv_gamma) #define ewt (cv_mem->cv_ewt) #define nfe (cv_mem->cv_nfe) #define zn (cv_mem->cv_zn) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define gammasv (cvdiag_mem->di_gammasv) #define M (cvdiag_mem->di_M) #define bit (cvdiag_mem->di_bit) #define bitcomp (cvdiag_mem->di_bitcomp) #define nfeDI (cvdiag_mem->di_nfeDI) #define last_flag (cvdiag_mem->di_last_flag) /* * ----------------------------------------------------------------- * CVDiag * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the diagonal linear solver module. CVDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVDiagInit, CVDiagSetup, CVDiagSolve, and CVDiagFree, * respectively. It allocates memory for a structure of type * CVDiagMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to * TRUE. Finally, it allocates memory for M, bit, and bitcomp. * The CVDiag return value is SUCCESS = 0, LMEM_FAIL = -1, or * LIN_ILL_INPUT=-2. * ----------------------------------------------------------------- */ int CVDiag(void *cvode_mem) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VCompare and N_VInvTest are present */ if(vec_tmpl->ops->nvcompare == NULL || vec_tmpl->ops->nvinvtest == NULL) { cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVDIAG", "CVDiag", MSGDG_BAD_NVECTOR); return(CVDIAG_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVDiagInit; lsetup = CVDiagSetup; lsolve = CVDiagSolve; lfree = CVDiagFree; /* Get memory for CVDiagMemRec */ cvdiag_mem = NULL; cvdiag_mem = (CVDiagMem) malloc(sizeof(CVDiagMemRec)); if (cvdiag_mem == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); return(CVDIAG_MEM_FAIL); } last_flag = CVDIAG_SUCCESS; /* Set flag setupNonNull = TRUE */ setupNonNull = TRUE; /* Allocate memory for M, bit, and bitcomp */ M = N_VClone(vec_tmpl); if (M == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bit = N_VClone(vec_tmpl); if (bit == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bitcomp = N_VClone(vec_tmpl); if (bitcomp == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); N_VDestroy(bit); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdiag_mem; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetWorkSpace * ----------------------------------------------------------------- */ int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetWorkSpace", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *lenrwLS = 3*lrw1; *leniwLS = 3*liw1; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetNumRhsEvals * ----------------------------------------------------------------- */ int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *nfevalsLS = nfeDI; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetLastFlag * ----------------------------------------------------------------- */ int CVDiagGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *flag = last_flag; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetReturnFlagName * ----------------------------------------------------------------- */ char *CVDiagGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVDIAG_SUCCESS: sprintf(name,"CVDIAG_SUCCESS"); break; case CVDIAG_MEM_NULL: sprintf(name,"CVDIAG_MEM_NULL"); break; case CVDIAG_LMEM_NULL: sprintf(name,"CVDIAG_LMEM_NULL"); break; case CVDIAG_ILL_INPUT: sprintf(name,"CVDIAG_ILL_INPUT"); break; case CVDIAG_MEM_FAIL: sprintf(name,"CVDIAG_MEM_FAIL"); break; case CVDIAG_INV_FAIL: sprintf(name,"CVDIAG_INV_FAIL"); break; case CVDIAG_RHSFUNC_UNRECVR: sprintf(name,"CVDIAG_RHSFUNC_UNRECVR"); break; case CVDIAG_RHSFUNC_RECVR: sprintf(name,"CVDIAG_RHSFUNC_RECVR"); break; case CVDIAG_NO_ADJ: sprintf(name,"CVDIAG_NO_ADJ"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * CVDiagInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the diagonal * linear solver. * ----------------------------------------------------------------- */ static int CVDiagInit(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; nfeDI = 0; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSetup * ----------------------------------------------------------------- * This routine does the setup operations for the diagonal linear * solver. It constructs a diagonal approximation to the Newton matrix * M = I - gamma*J, updates counters, and inverts M. * ----------------------------------------------------------------- */ static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype r; N_Vector ftemp, y; booleantype invOK; CVDiagMem cvdiag_mem; int retval; cvdiag_mem = (CVDiagMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = vtemp1; y = vtemp2; /* Form y with perturbation = FRACT*(func. iter. correction) */ r = FRACT * rl1; N_VLinearSum(h, fpred, -ONE, zn[1], ftemp); N_VLinearSum(r, ftemp, ONE, ypred, y); /* Evaluate f at perturbed y */ retval = f(tn, y, M, cv_mem->cv_user_data); nfeDI++; if (retval < 0) { cvProcessError(cv_mem, CVDIAG_RHSFUNC_UNRECVR, "CVDIAG", "CVDiagSetup", MSGDG_RHSFUNC_FAILED); last_flag = CVDIAG_RHSFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDIAG_RHSFUNC_RECVR; return(1); } /* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */ N_VLinearSum(ONE, M, -ONE, fpred, M); N_VLinearSum(FRACT, ftemp, -h, M, M); N_VProd(ftemp, ewt, y); /* Protect against deltay_i being at roundoff level */ N_VCompare(uround, y, bit); N_VAddConst(bit, -ONE, bitcomp); N_VProd(ftemp, bit, y); N_VLinearSum(FRACT, y, -ONE, bitcomp, y); N_VDiv(M, y, M); N_VProd(M, bit, M); N_VLinearSum(ONE, M, -ONE, bitcomp, M); /* Invert M with test for zero components */ invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return(1); } /* Set jcur = TRUE, save gamma in gammasv, and return */ *jcurPtr = TRUE; gammasv = gamma; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSolve * ----------------------------------------------------------------- * This routine performs the solve operation for the diagonal linear * solver. If necessary it first updates gamma in M = I - gamma*J. * ----------------------------------------------------------------- */ static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { booleantype invOK; realtype r; CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; /* If gamma has changed, update factor in M, and save gamma value */ if (gammasv != gamma) { r = gamma / gammasv; N_VInv(M, M); N_VAddConst(M, -ONE, M); N_VScale(r, M, M); N_VAddConst(M, ONE, M); invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return (1); } gammasv = gamma; } /* Apply M-inverse to b */ N_VProd(b, M, b); last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagFree * ----------------------------------------------------------------- * This routine frees memory specific to the diagonal linear solver. * ----------------------------------------------------------------- */ static void CVDiagFree(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; N_VDestroy(M); N_VDestroy(bit); N_VDestroy(bitcomp); free(cvdiag_mem); cv_mem->cv_lmem = NULL; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVDiagB * * Wrappers for the backward phase around the corresponding * CVODES functions */ int CVDiagB(void *cvode_mem, int which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVSDIAG", "CVDiagB", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVDIAG_NO_ADJ, "CVSDIAG", "CVDiagB", MSGDG_NO_ADJ); return(CVDIAG_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVSDIAG", "CVDiagB", MSGDG_BAD_WHICH); return(CVDIAG_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVDiag(cvodeB_mem); return(flag); } sundials-2.5.0/src/cvodes/cvodes_sptfqmr.c0000600000175000017500000004132411741421150021467 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.13 $ * $Date: 2011/03/23 22:58:47 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the CVSPTFQMR linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "cvodes_spils_impl.h" #include "cvodes_impl.h" #include #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* CVSPTFQMR linit, lsetup, lsolve, and lfree routines */ static int CVSptfqmrInit(CVodeMem cv_mem); static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow); static void CVSptfqmrFree(CVodeMem cv_mem); /* CVSPTFQMR lfreeB function */ static void CVSptfqmrFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define tq (cv_mem->cv_tq) #define nst (cv_mem->cv_nst) #define tn (cv_mem->cv_tn) #define gamma (cv_mem->cv_gamma) #define gammap (cv_mem->cv_gammap) #define f (cv_mem->cv_f) #define user_data (cv_mem->cv_user_data) #define ewt (cv_mem->cv_ewt) #define errfp (cv_mem->cv_errfp) #define mnewt (cv_mem->cv_mnewt) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define sqrtN (cvspils_mem->s_sqrtN) #define ytemp (cvspils_mem->s_ytemp) #define x (cvspils_mem->s_x) #define ycur (cvspils_mem->s_ycur) #define fcur (cvspils_mem->s_fcur) #define delta (cvspils_mem->s_delta) #define deltar (cvspils_mem->s_deltar) #define npe (cvspils_mem->s_npe) #define nli (cvspils_mem->s_nli) #define nps (cvspils_mem->s_nps) #define ncfl (cvspils_mem->s_ncfl) #define nstlpre (cvspils_mem->s_nstlpre) #define njtimes (cvspils_mem->s_njtimes) #define nfes (cvspils_mem->s_nfes) #define spils_mem (cvspils_mem->s_spils_mem) #define jtimesDQ (cvspils_mem->s_jtimesDQ) #define jtimes (cvspils_mem->s_jtimes) #define j_data (cvspils_mem->s_j_data) #define last_flag (cvspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : CVSptfqmr * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the Sptfqmr linear solver module. CVSptfqmr first * calls the existing lfree routine if this is not NULL. It then sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVSptfqmrInit, CVSptfqmrSetup, CVSptfqmrSolve, and CVSptfqmrFree, * respectively. It allocates memory for a structure of type * CVSpilsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem), * and sets various fields in the CVSpilsMemRec structure. * Finally, CVSptfqmr allocates memory for ytemp and x, and calls * SptfqmrMalloc to allocate memory for the Sptfqmr solver. * ----------------------------------------------------------------- */ int CVSptfqmr(void *cvode_mem, int pretype, int maxl) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; int mxl; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPTFQMR", "CVSptfqmr", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVSptfqmrInit; lsetup = CVSptfqmrSetup; lsolve = CVSptfqmrSolve; lfree = CVSptfqmrFree; /* Get memory for CVSpilsMemRec */ cvspils_mem = NULL; cvspils_mem = (CVSpilsMem) malloc(sizeof(struct CVSpilsMemRec)); if (cvspils_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set ILS type */ cvspils_mem->s_type = SPILS_SPTFQMR; /* Set Sptfqmr parameters that have been passed in call sequence */ cvspils_mem->s_pretype = pretype; mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; j_data = NULL; /* Set defaults for preconditioner-related fields */ cvspils_mem->s_pset = NULL; cvspils_mem->s_psolve = NULL; cvspils_mem->s_pfree = NULL; cvspils_mem->s_P_data = cv_mem->cv_user_data; /* Set default values for the rest of the Sptfqmr parameters */ cvspils_mem->s_eplifac = CVSPILS_EPLIN; cvspils_mem->s_last_flag = CVSPILS_SUCCESS; setupNonNull = FALSE; /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmr", MSGS_BAD_PRETYPE); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_ILL_INPUT); } /* Allocate memory for ytemp and x */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } x = N_VClone(vec_tmpl); if (x == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = RSqrt(N_VDotProd(ytemp, ytemp)); /* Call SptfqmrMalloc to allocate workspace for Sptfqmr */ sptfqmr_mem = NULL; sptfqmr_mem = SptfqmrMalloc(mxl, vec_tmpl); if (sptfqmr_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmr", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(x); free(cvspils_mem); cvspils_mem = NULL; return(CVSPILS_MEM_FAIL); } /* Attach SPTFQMR memory to spils memory structure */ spils_mem = (void *) sptfqmr_mem; /* Attach linear solver memory to integrator memory */ lmem = cvspils_mem; return(CVSPILS_SUCCESS); } /* Additional readability replacements */ #define pretype (cvspils_mem->s_pretype) #define eplifac (cvspils_mem->s_eplifac) #define maxl (cvspils_mem->s_maxl) #define psolve (cvspils_mem->s_psolve) #define pset (cvspils_mem->s_pset) #define P_data (cvspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : CVSptfqmrInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the Sptfqmr * linear solver. * ----------------------------------------------------------------- */ static int CVSptfqmrInit(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; cvspils_mem = (CVSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Initialize counters */ npe = nli = nps = ncfl = nstlpre = 0; njtimes = nfes = 0; /* Check for legal combination pretype - psolve */ if ((pretype != PREC_NONE) && (psolve == NULL)) { cvProcessError(cv_mem, -1, "CVSPTFQMR", "CVSptfqmrInit", MSGS_PSOLVE_REQ); last_flag = CVSPILS_ILL_INPUT; return(-1); } /* Set setupNonNull = TRUE iff there is preconditioning (pretype != PREC_NONE) and there is a preconditioning setup phase (pset != NULL) */ setupNonNull = (pretype != PREC_NONE) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = CVSpilsDQJtimes; j_data = cv_mem; } else { j_data = user_data; } /* Set maxl in the SPTFQMR memory in case it was changed by the user */ sptfqmr_mem->l_max = maxl; last_flag = CVSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the Sptfqmr linear solver. * It makes a decision as to whether or not to signal for reevaluation * of Jacobian data in the pset routine, based on various state * variables, then it calls pset. If we signal for reevaluation, * then we reset jcur = *jcurPtr to TRUE, regardless of the pset output. * In any case, if jcur == TRUE, we increment npe and save nst in nstlpre. * ----------------------------------------------------------------- */ static int CVSptfqmrSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; int retval; CVSpilsMem cvspils_mem; cvspils_mem = (CVSpilsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlpre + CVSPILS_MSBPRE) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVSPILS_DGMAX)) || (convfail == CV_FAIL_OTHER); *jcurPtr = jbad; jok = !jbad; /* Call pset routine and possibly reset jcur */ retval = pset(tn, ypred, fpred, jok, jcurPtr, gamma, P_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, SPTFQMR_PSET_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSetup", MSGS_PSET_FAILED); last_flag = SPTFQMR_PSET_FAIL_UNREC; } if (retval > 0) { last_flag = SPTFQMR_PSET_FAIL_REC; } if (jbad) *jcurPtr = TRUE; /* If jcur = TRUE, increment npe and save nst value */ if (*jcurPtr) { npe++; nstlpre = nst; } last_flag = SPTFQMR_SUCCESS; /* Return the same value that pset returned */ return(retval); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic solver SptfqmrSolve * for the solution of the linear system Ax = b with the SPTFQMR method. * The solution x is returned in the vector b. * * If the WRMS norm of b is small, we return x = b (if this is the first * Newton iteration) or x = 0 (if a later Newton iteration). * * Otherwise, we set the tolerance parameter and initial guess (x = 0), * call SptfqmrSolve, and copy the solution x into b. The x-scaling and * b-scaling arrays are both equal to weight. * * The counters nli, nps, and ncfl are incremented, and the return value * is set according to the success of SptfqmrSolve. The success flag is * returned if SptfqmrSolve converged, or if this is the first Newton * iteration and the residual norm was reduced below its initial value. * ----------------------------------------------------------------- */ static int CVSptfqmrSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { realtype bnorm, res_norm; CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; int nli_inc, nps_inc, retval; cvspils_mem = (CVSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Test norm(b); if small, return x = 0 or x = b */ deltar = eplifac * tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (mnewt > 0) N_VConst(ZERO, b); return(0); } /* Set vectors ycur and fcur for use by the Atimes and Psolve routines */ ycur = ynow; fcur = fnow; /* Set inputs delta and initial guess x = 0 to SptfqmrSolve */ delta = deltar * sqrtN; N_VConst(ZERO, x); /* Call SptfqmrSolve and copy x to b */ retval = SptfqmrSolve(sptfqmr_mem, cv_mem, x, b, pretype, delta, cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve, &res_norm, &nli_inc, &nps_inc); N_VScale(ONE, x, b); /* Increment counters nli, nps, and ncfl */ nli += nli_inc; nps += nps_inc; if (retval != SPTFQMR_SUCCESS) ncfl++; /* Interpret return value from SpgmrSolve */ last_flag = retval; switch(retval) { case SPTFQMR_SUCCESS: return(0); break; case SPTFQMR_RES_REDUCED: if (mnewt == 0) return(0); else return(1); break; case SPTFQMR_CONV_FAIL: return(1); break; case SPTFQMR_PSOLVE_FAIL_REC: return(1); break; case SPTFQMR_ATIMES_FAIL_REC: return(1); break; case SPTFQMR_MEM_NULL: return(-1); break; case SPTFQMR_ATIMES_FAIL_UNREC: cvProcessError(cv_mem, SPTFQMR_ATIMES_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPTFQMR_PSOLVE_FAIL_UNREC: cvProcessError(cv_mem, SPTFQMR_PSOLVE_FAIL_UNREC, "CVSPTFQMR", "CVSptfqmrSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : CVSptfqmrFree * ----------------------------------------------------------------- * This routine frees memory specific to the Sptfqmr linear solver. * ----------------------------------------------------------------- */ static void CVSptfqmrFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; SptfqmrMem sptfqmr_mem; cvspils_mem = (CVSpilsMem) lmem; N_VDestroy(ytemp); N_VDestroy(x); sptfqmr_mem = (SptfqmrMem) spils_mem; SptfqmrFree(sptfqmr_mem); if (cvspils_mem->s_pfree != NULL) (cvspils_mem->s_pfree)(cv_mem); free(cvspils_mem); cv_mem->cv_lmem = NULL; return; } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Additional readability replacements */ #define pset_B (cvspilsB_mem->s_psetB) #define psolve_B (cvspilsB_mem->s_psolveB) #define jtimes_B (cvspilsB_mem->s_jtimesB) #define P_data_B (cvspilsB_mem->s_P_dataB) /* * CVSptfqmrB * * Wrapper for the backward phase */ int CVSptfqmrB(void *cvode_mem, int which, int pretypeB, int maxlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVSpilsMemB cvspilsB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVSPTFQMR", "CVSptfqmrB", MSGS_CVMEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVSPTFQMR", "CVSptfqmrB", MSGS_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPTFQMR", "CVSptfqmrB", MSGS_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Get memory for CVSpilsMemRecB */ cvspilsB_mem = NULL; cvspilsB_mem = (CVSpilsMemB) malloc(sizeof(struct CVSpilsMemRecB)); if (cvspilsB_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPTFQMR", "CVSptfqmrB", MSGS_MEM_FAIL); return(CVSPILS_MEM_FAIL); } pset_B = NULL; psolve_B = NULL; P_data_B = NULL; /* initialize Jacobian function */ jtimes_B = NULL; /* attach lmemB and lfreeB */ cvB_mem->cv_lmem = cvspilsB_mem; cvB_mem->cv_lfree = CVSptfqmrFreeB; flag = CVSptfqmr(cvodeB_mem, pretypeB, maxlB); if (flag != CVSPILS_SUCCESS) { free(cvspilsB_mem); cvspilsB_mem = NULL; } return(flag); } /* * CVSptfqmrFreeB */ static void CVSptfqmrFreeB(CVodeBMem cvB_mem) { CVSpilsMemB cvspilsB_mem; cvspilsB_mem = (CVSpilsMemB) (cvB_mem->cv_lmem); free(cvspilsB_mem); } sundials-2.5.0/src/cvodes/cvodes_bandpre_impl.h0000600000175000017500000000434011741421150022431 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.10 $ * $Date: 2010/12/01 22:30:42 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the CVBANDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVSBANDPRE_IMPL_H #define _CVSBANDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include /* * ----------------------------------------------------------------- * Type: CVBandPrecData * ----------------------------------------------------------------- */ typedef struct CVBandPrecDataRec { /* Data set by user in CVBandPrecInit */ long int N; long int ml, mu; /* Data set by CVBandPrecSetup */ DlsMat savedJ; DlsMat savedP; long int *lpivots; /* Rhs calls */ long int nfeBP; /* Pointer to cvode_mem */ void *cvode_mem; } *CVBandPrecData; /* * ----------------------------------------------------------------- * CVBANDPRE error messages * ----------------------------------------------------------------- */ #define MSGBP_MEM_NULL "Integrator memory is NULL." #define MSGBP_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBP_MEM_FAIL "A memory request failed." #define MSGBP_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBP_PMEM_NULL "Band preconditioner memory is NULL. CVBandPrecInit must be called." #define MSGBP_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #define MSGBP_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." #define MSGBP_BAD_WHICH "Illegal value for parameter which." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/README0000600000175000017500000005711511741421150017151 0ustar sylvestresylvestre CVODES Release 2.7.0, March 2012 Alan C. Hindmarsh and Radu Serban Center for Applied Scientific Computing, LLNL CVODES is a solver for stiff and nonstiff ODE systems (initial value problem) given in explicit form y' = f(t,y,p) with sensitivity analysis capabilities (both forward and adjoint modes). It is written in ANSI standard C. CVODES can be used both on serial and parallel (MPI) computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel version, communication between processors is done with the MPI (Message Passage Interface) system. When used with the serial NVECTOR module, CVODES provides both direct (dense and band) and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When CVODES is used with the parallel NVECTOR module, only the Krylov linear solvers are available. (An approximate diagonal Jacobian option is available with both versions.) For the serial version, there is a banded preconditioner module called CVBANDPRE available for use with the Krylov solvers, while for the parallel version there is a preconditioner module called CVBBDPRE which provides a band-block-diagonal preconditioner. CVODES is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers [4]. This suite consists of CVODE, CVODES, IDA, IDAS, and KINSOL. The directory structure of the package supplied reflects this family relationship. The notes below provide the location of documentation, directions for the installation of the CVODES package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/cvodes/ contains PDF files for the CVODES User Guide [1] (cvs_guide.pdf) and the CVODES Examples [2] (cvs_examples.pdf) documents. B. Installation --------------- For basic installation instructions see /sundials/INSTALL_NOTES. For complete installation instructions see the "CVODES Installation Procedure" chapter in the CVODES User Guide. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.7.0," LLNL technical report UCRL-SM-208111, December 2011. [2] A. C. Hindmarsh and R. Serban, "Example Programs for CVODES v2.7.0," LLNL technical report UCRL-SM-208115, December 2011. [3] R. Serban and A. C. Hindmarsh, "CVODES: the Sensitivity-Enabled ODE solver in SUNDIALS," Proceedings of IDETC/CIE 2005, Sept. 2005, Long Beach, CA. [4] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 2.7.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - May. 2005 v. 2.2.0 - Apr. 2005 v. 2.1.2 - Mar. 2005 v. 2.1.1 - Jan. 2005 v. 2.1.0 - Dec. 2004 v. 1.0 - Jul. 2002 (first SUNDIALS release) E. Revision History ------------------- v. 2.6.0 (May 2009) ---> v. 2.7.0 (Mar. 2012) --------------------------------------------- - Bug fixes - errors in the logic for the integration of backward problems were identified and fixed. - in CVSetTqBDF, the logic was changed to avoid a divide by zero. - after the solver memory is created, it is set to zero before being filled. - in each linear solver interface function, the linear solver memory is freed on an error return, and the **Free function now includes a line setting to NULL the main memory pointer to the linear solver memory. - in rootfinding functions cvRcheck1/cvRcheck2, when an exact zero is found, the array glo at the left endpoint is adjusted instead of shifting tlo. - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. - in a minor change to the user interface, the type of the index which in CVODES was changed from long int to int. - in the installation files, we modified the treatment of the macro SUNDIALS_USE_GENERIC_MATH, so that the parameter GENERIC_MATH_LIB is either defined (with no value) or not defined. v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (May 2009) --------------------------------------------- - New features - added a new linear solver module based on Blas + Lapack for both dense and banded matrices. - added optional input to specify which direction of zero-crossing is to be monitored while performing root-finding. The root information array iroots (returned by CVodeGetRootInfo) also encodes the direction of zero-crossing. - added support for performing FSA of quadrature variables (see functions CVode**QuadSens**). - in the adjoint module, added support for integrating forward sensitivities of states and quadrature variables during the forward integration phase (e.g. for computing 2nd order sensitivity information using the "forward over adjoint" method). - in the adjoint module, added support for propagating backwards in time multiple adjoint systems, each initialized at posibly different times. - added option for reinitializing the adjoint module in order to solve a new adjoint problem (with same number of steps between check points and the same interpolation type). - Bug fixes - in the rootfinding algorithm, fixed a bug resulting in unnecessary evaluations of the root functions after reinitialization of the solver right after a return at a root. - in the initial step size calculation, restrict h based on tstop. - modified the setting and use of the tq[] array. Now tq[i] (i = 1,2,3) are defined to be the reciprocals of what they were before. This eliminates a rare crash that can occur with xistar_inv = 0. - Changes to user interface - renamed all **Malloc functions to **Init - tolerances are now specified through separate functions instead of the initialization functions CVodeInit (former CVodeMalloc) and CVodeReInit. Depending on the tolerance type, one of 3 functions must be called before the first call to CVode. - tolerances for quadratures, sensitivities, and quadrature sensitivities are specified in a manner similar to that for state variables, with the exception that toelrances for quadratures and quadrature sensitivities are required only if the corresponding variables are included in the error test. - removed function inputs from argument lists of all re-initialization functions. - all user-supplied functions now receive the same pointer to user data (instead of having different ones for the system evaluation, Jacobian information functions, etc.) - removed CV_NORMAL_TSTOP and CV_ONE_STEP_TSTOP named constants for the itask argument to CVode/CVodeF. A tstop value is now both set and activated through CVodeSetStopTime. Once tstop is reached it is also deactivated. A new value can be then specified by calling again CVodeSetStopTime. - common functionality for all direct linear solvers (dense, band, and the new Lapack solver) has been collected into the DLS (Direct Linear Solver) module, similar to the SPILS module for the iterative linear solvers. All optional input and output functions for these linear solver now have the prefix 'CVDls'. In addition, in order to include the new Lapack-based linear solver, all dimensions for these linear solvers (problem sizes, bandwidths, etc) are now of type 'int' (instead of 'long int'). - the initialization functions for the two preconditioner modules, CVBANDPRE and CVBBDPRE were renamed ***Init (from ***Alloc) and they do not return a pointer to preconditioner memory anymore. Instead, all preconditioner module-related functions are now called with the main solver memory pointer as their first argument. When using one of these two modules, there is no need to use special functions to attach one of the SPILS linear solvers (instead use one of CVSpgmr, CVSpbcg, or CVSptfqmr). Moreover, there is no need to call a memory deallocation function for the preconditioner module. - CVodeSensMalloc was replaced by CVodeSensInit and CvodeSensInit1. The sensitivity RHS function is now passed as an argument to these initialization functions. The former takes as argument fS a function of type CVSensRhsFn, while the latter takes as argument fS1 of type CVSensRhs1Fn. Removed the functions CVodeSetSensRhsFn and CVodeSetSensRhs1Fn. - changed the API for all functions in the adjoint module related to initialization, set-up, and solution of backward problems. A backward problem is always identified by its index (of type int) returned by the CvodeCreateB function. - the extraction functions CVodeGetQuad, CVodeGetSens, and CVodeGetSens1 now return the values of quadrature and sensitivity variables, respectively, at the same time as that at which CVode returned the solution (for dense output of quadrature or sensitivity variables, the user can only use CVodeGetQuadDky, CVodeGetSensDky, or CVodeGetSensDky1). Similar functions are available for the new quadrature sensitivity feature. - changed names CVSpilsSetDelt and delt to CVSpilsSetEpsLin and eplifac. - added the error return CV_RTFUNC_FAIL. v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Nov. 2006) ---------------------------------------------- - Bug fixes - fixed wrong logic in final stopping tests: now we check if tout was reached before checking if tstop was reached. - added a roundoff factor when testing whether tn was just returned (in root finding) to prevent an unnecessary return. - fixed bug in CVodeB in searching for the current check point (i.e. the check point for which interpolation data is available) - fixed bug in CVodeF to ensure that in NORMAL mode no extra step is taken (which sometimes resulted in an error from the interpolated output function). - changed address variable type in CVadjCheckPointRec structure from 'unsigned int' to 'void *' to avoid address truncation/mangling on 64-bit platforms (see CVS_P1). - Changes related to the build system - reorganized source tree: header files in ${srcdir}/include/cvodes, source files in ${srcdir}/src/cvodes,examples in ${srcdir}/examples/cvodes - exported header files are installed unde ${includedir}/cvodes - Changes to user interface - all included header files use relative paths from ${includedir} - changed the API for specifying the DQ method used to approximate the sensitivity equations: renamed CVodeSetSensRho to CVodeSetSensDQMethod. The user passes two values: DQtype (CV_CENTERED or CV_FORWARD) and DQrhomax (the cut-off value for switching between simultaneous and separate approximations of the two terms in the sensi. eqs.) v. 2.3.0 (May. 2005) ---> v. 2.4.0 (Mar. 2006) ---------------------------------------------- - New features - added CVSPBCG interface module to allow CVODES to interface with the shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. - added CVSPTFQMR interface module to allow CVODES to interface with the shared SPTFQMR (scaled preconditioned TFQMR) linear solver module. - added support for SPBCG and SPTFQMR to the CVBBDPRE and CVBANDPRE preconditioner modules. - added support for interpreting failures in user-supplied functions. - added a new variable-degree polynomial interpolation method as an an alternative to the current cubic Hermite interpolation for the adjoint module. - Changes to user interface - changed argument of CVodeFree, CVBandPrecFree, CVBBDPrecFree, and CVadjFree to be the address of the respective memory block pointer, so that its NULL value is propagated back to the calling function. - added CVSPBCG module which defines appropriate CVSpbcg* functions to allow CVODES to interface with the shared SPBCG linear solver module. - added CVBBDSpbcg function to CVBBDPRE module and CVBPSpbcg function to CVBANDPRE module to support SPBCG linear solver module. - added CVBBDSptfqmr function to CVBBDPRE module and CVBPSptfqmr function to CVBANDPRE module to support SPTFQMR linear solver module. - changed function type names (not the actual definition) to accomodate all the Scaled Preconditioned Iterative Linear Solvers now available: CVSpgmrJactimesVecFn -> CVSpilsJacTimesVecFn CVSpgmrPrecSetupFn -> CVSpilsPrecSetupFn CVSpgmrPrecSolveFn -> CVSpilsPrecSolveFn - changed function types so that all user-supplied functions return an integer flag (not all of them currently used). - changed some names for CVBBDPRE and CVBANDPRE function outputs - added option for user-supplied error handler function. - added a argument to CVadjMalloc to specify the type of interpolation (possible values are CV_HERMITE for cubic Hermite and CV_POLYNOMIAL for variable-order polynomial interpolation) - renamed all exported header files (except for cvodes.h and cvodea.h all header files have the prefix 'cvodes_') - changed naming scheme for CVODES examples - Changes related to the build system - the main CVODES header files (cvodes.h and cvodea.h) are still exported to the install include directory. However, all other CVODES header files are exported into a 'cvodes' subdirectory of the install include directory. - the CVODES library now contains all shared object files (there is no separate libsundials_shared library anymore) v. 2.2.0 (Apr. 2005) ---> v. 2.3.0 (May. 2005) ---------------------------------------------- - Bug fixes - in the adjoint module, fixed bug in storing interpolation data at a point corresponding to a check point (improperly scaled y'). - Changes to user interface - removed CVadjGetcheckPointsList from the list of user-callable functions. v. 2.1.2 (Mar. 2005) ---> v. 2.2.0 (Apr. 2005) ---------------------------------------------- - New features - added option for user-provided error weight computation function for the solution vector (of type CVEwtFn specified through CVodeSetEwtFn). - Changes to user interface - CVODES now stores tolerances through values rather than references (to resolve potential scoping issues). - CVODES now passes information back to the user through values rather than references (error weights, estimated local errors, root info, STAGGERED1 statistics, etc.) - CVodeMalloc, CVodeReInit, CVodeSetTolerances: added option itol=CV_WF to indicate user-supplied function for computing the error weights; reltol is now declared as realtype. Note that it is now illegal to call CVodeSetTolerances before CVodeMalloc. It is now legal to deallocate the absolute tolerance N_Vector right after its use. - Several optional input functions were combined into a single one (CVodeRootInit and CvodeSetGdata, CVDenseSetJacFn and CVDenseSetJacData, CVBandSetJacFn and CVBandSetJacData, CVSpgmrSetPrecSolveFn and CVSpgmrSetPrecSetFn and CVSpgmrSetPrecData, CVSpgmrSetJacTimesVecFn and CVSpgmrSetJacData). - Removed CVodeSetQuadtolerances. CVodeSetQuadErrCon now sets both the error control flag and the tolerances for quadratures. - CVodeSetQuadErrCon, CVodeSetSensTolerances: the relative tolerance must now be passed as a realtype. It is now illegal to call CVodeSetQuadErrCon before CVodeQuadMalloc or to call CVodeSetSensTolerances before CVodeSensMalloc. - CvodeSensMalloc: removed p and plist from argument list. - CVodeSensParams replaces CVodeSensPbar and sets p, pbar, and plist. NULL can be passed for any of them if it will not be needed given the current set of options. The array pbar must now contain Ns non-zero realtype values giving order of magnitude for the parameters with respect to which sensitivities will be computed. The array plist can now only have positive entries. - CVodeGetErrorWeights, CVodeGetQuadErrorWeights: the user is now responsible for allocating space for the N_Vector in which error weights will be copied. - CVodeGetEstLocalErrors: the user is now responsible for allocating space for the N_Vector in which estimated local errors will be copied. - CVodeGetRootInfo: the user is now responsible for allocating space for the int array in which root information will be copied. - CVodeGetNumStgrSensNonlinSolvIters, CVodeGetNumStgrSensNonlinSolvConvFails: the user is now responsible for allocating space for the long int arrays in which STAGGERED1 statistics will be copied. - CVodeMallocB, CVodeReInitB, CVodeSetQuadErrConB: the relative tolerance for the backward integration must now be passed as a realtype. It is now illegal to call CVodeSetQuadErrConB before CVQuadMallocB. - Passing a value of 0 for the maximum step size, the minimum step size, or for maxsteps results in the solver using the corresponding default value (infinity, 0, 500, respectively) - User-callable functions in the adjoint module were modified similarly to their corresponding counterparts for forward simulation. v. 2.1.1 (Jan. 2005) ---> v. 2.1.2 (Mar. 2005) ---------------------------------------------- - Bug fixes - fixed bug in CVode function: Initial setting of tretlast = *tret = tn removed (correcting erroneous behavior at first call to CVRcheck3). - removed redundant setting of tretlast = *tret = tn at CLOSE_ROOTS return from CVode. - fixed bug in CVCompleteStep related to quadrature and sensitivity variables (leading to wrong values at a BDF order increase) - in CVUpperBoundH0, fixed a potential, although not harmful, use of uninitialized memory - changed implicit type conversion to explicit in check_flag() routine in examples to avoid C++ compiler errors - Changes to documentation - added section with numerical values of all input and output solver constants - added more detailed notes on the type of absolute tolerances - added more details on ownership of memory for the array returned by CVodeGetRootInfo - corrected/added descriptions of error returns. - added description of --with-mpi-flags option - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.1.0 (Dec. 2004) ---> v. 2.1.1 (Jan. 2005) ---------------------------------------------- - New features - added function CVodeSensToggle to allow activation/deactivation of sensitivity calculations without memory allocation/deallocation. - Bug fixes - fixed bug in CVCompleteStep related to quadrature and sensitivity variables (leading to wrong values at a BDF order increase). - in CVUpperBoundH0, fixed a potential, although not harmful, use of uninitialized memory. - fixed logic in testing for negative values of user-supplied absolute tolerances for sensitivity variables. - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 1.0 (Jul. 2002) ---> v. 2.1.0 (Dec. 2004) -------------------------------------------- - New features - added quadrature integration capabilities. - added root finding capabilities. - added option for different user data structures for ODE r.h.s. and sensitivity r.h.s. - in adjoint module, added interface to CVBBDPRE for the backward phase. - in adjoint module, added option for using CVDIAG during backward phase. - in adjoint module, added option for ONE_STEP integration during backward phase. - in adjoint module, added option to reinitialize the backward integration phase (and perform a new backward integration using the same check points). - in adjoint module, relaxed assumption that t_final > t_0 (now accepts t_final < t_0). - Bug fixes - fixed bug in adjustment of sensitivity Nordsieck history array on an order decrease (when using BDF). - in adjoint module, fixed a potential use of memory before being set. - in adjoint module, fixed a bug related to data saved at check points. This addresses the case in which an order increase is deemed necessary at the very first step after a check-point. - Changes related to the NVECTOR module (see also the file sundials/shared/README) - removed machEnv, redefined table of vector operations (now contained in the N_Vector structure itself). - all CVODES functions create new N_Vector variables through cloning, using an N_Vector passed by the user as a template. - Changes to type names and CVODES constants - removed type 'integertype'; instead use int or long int, as appropriate. - restructured the list of return values from the various CVODES functions. - changed all CVODES constants (inputs and return values) to have the prefix 'CV_' (e.g. CV_SUCCESS). - renamed various function types to have the prefix 'CV' (e.g. CVRhsFn). - Changes to optional input/ouput - added CVodeSet* and CVodeGet* functions for optional inputs/outputs, replacing the arrays iopt and ropt. - added new optional inputs (e.g. maximum number of Newton iterations, maximum number of convergence failures, etc). - the value of the last return flag from any function within a linear solver module can be obtained as an optional output (e.g. CVDenseGetLastFlag). - Changes to user-callable functions - renamed header files to have prefix 'cv' instead of 'cvs' (e.g. cvdense.h replaces cvsdense.h). - added new function CVodeCreate which initializes the CVODES solver object and returns a pointer to the CVODES memory block. - removed N (problem size) from all functions except the initialization functions for the direct linear solvers (CVDense and CVBand). - shortened argument lists of most CVODES functions (the arguments that were dropped can now be specified through CVodeSet* functions). - removed reinitialization functions for band/dense/SPGMR linear solvers (same functionality can be obtained using CV*Set* functions). - in CVBBDPRE, added a new function, CVBBDSpgmr to initialize the SPGMR linear solver with the BBD preconditioner. - function names changed in CVBANDPRE and CVBBDPRE for uniformity. - Changes to user-supplied functions - removed N (probem dimension) from argument lists. - shortened argument lists for user dense/band/SPGMR Jacobian routines. - in CVSPGMR, shortened argument lists for user preconditioner functions. sundials-2.5.0/src/cvodes/cvodes_impl.h0000600000175000017500000013462011741421150020743 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.21 $ * $Date: 2007/11/26 16:19:59 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Implementation header file for the main CVODES integrator. * ----------------------------------------------------------------- */ #ifndef _CVODES_IMPL_H #define _CVODES_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include #include /* * ================================================================= * I N T E R N A L C V O D E S C O N S T A N T S * ================================================================= */ /* Basic CVODES constants */ #define ADAMS_Q_MAX 12 /* max value of q for lmm == ADAMS */ #define BDF_Q_MAX 5 /* max value of q for lmm == BDF */ #define Q_MAX ADAMS_Q_MAX /* max value of q for either lmm */ #define L_MAX (Q_MAX+1) /* max value of L for either lmm */ #define NUM_TESTS 5 /* number of error test quantities */ #define HMIN_DEFAULT RCONST(0.0) /* hmin default value */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MXHNIL_DEFAULT 10 /* mxhnil default value */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* * ================================================================= * F O R W A R D P O I N T E R R E F E R E N C E S * ================================================================= */ typedef struct CVadjMemRec *CVadjMem; typedef struct CkpntMemRec *CkpntMem; typedef struct DtpntMemRec *DtpntMem; typedef struct CVodeBMemRec *CVodeBMem; /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Types: struct CVodeMemRec, CVodeMem * ----------------------------------------------------------------- * The type CVodeMem is type pointer to struct CVodeMemRec. * This structure contains fields to keep track of problem state. * ----------------------------------------------------------------- */ typedef struct CVodeMemRec { realtype cv_uround; /* machine unit roundoff */ /*-------------------------- Problem Specification Data --------------------------*/ CVRhsFn cv_f; /* y' = f(t,y(t)) */ void *cv_user_data; /* user pointer passed to f */ int cv_lmm; /* lmm = ADAMS or BDF */ int cv_iter; /* iter = FUNCTIONAL or NEWTON */ int cv_itol; /* itol = CV_SS, CV_SV, or CV_WF, or CV_NN */ realtype cv_reltol; /* relative tolerance */ realtype cv_Sabstol; /* scalar absolute tolerance */ N_Vector cv_Vabstol; /* vector absolute tolerance */ booleantype cv_user_efun; /* TRUE if user sets efun */ CVEwtFn cv_efun; /* function to set ewt */ void *cv_e_data; /* user pointer passed to efun */ /*----------------------- Quadrature Related Data -----------------------*/ booleantype cv_quadr; /* TRUE if integrating quadratures */ CVQuadRhsFn cv_fQ; /* q' = fQ(t, y(t)) */ booleantype cv_errconQ; /* TRUE if quadrs. are included in error test */ int cv_itolQ; /* itolQ = CV_SS or CV_SV */ realtype cv_reltolQ; /* relative tolerance for quadratures */ realtype cv_SabstolQ; /* scalar absolute tolerance for quadratures */ N_Vector cv_VabstolQ; /* vector absolute tolerance for quadratures */ /*------------------------ Sensitivity Related Data ------------------------*/ booleantype cv_sensi; /* TRUE if computing sensitivities */ int cv_Ns; /* Number of sensitivities */ int cv_ism; /* ism = SIMULTANEOUS or STAGGERED */ CVSensRhsFn cv_fS; /* fS = (df/dy)*yS + (df/dp) */ CVSensRhs1Fn cv_fS1; /* fS1 = (df/dy)*yS_i + (df/dp) */ void *cv_fS_data; /* data pointer passed to fS */ booleantype cv_fSDQ; /* TRUE if using internal DQ functions */ int cv_ifS; /* ifS = ALLSENS or ONESENS */ realtype *cv_p; /* parameters in f(t,y,p) */ realtype *cv_pbar; /* scale factors for parameters */ int *cv_plist; /* list of sensitivities */ int cv_DQtype; /* central/forward finite differences */ realtype cv_DQrhomax; /* cut-off value for separate/simultaneous FD */ booleantype cv_errconS; /* TRUE if yS are considered in err. control */ int cv_itolS; realtype cv_reltolS; /* relative tolerance for sensitivities */ realtype *cv_SabstolS; /* scalar absolute tolerances for sensi. */ N_Vector *cv_VabstolS; /* vector absolute tolerances for sensi. */ /*----------------------------------- Quadrature Sensitivity Related Data -----------------------------------*/ booleantype cv_quadr_sensi; /* TRUE if computing sensitivties of quadrs. */ CVQuadSensRhsFn cv_fQS; /* fQS = (dfQ/dy)*yS + (dfQ/dp) */ void *cv_fQS_data; /* data pointer passed to fQS */ booleantype cv_fQSDQ; /* TRUE if using internal DQ functions */ booleantype cv_errconQS; /* TRUE if yQS are considered in err. con. */ int cv_itolQS; realtype cv_reltolQS; /* relative tolerance for yQS */ realtype *cv_SabstolQS; /* scalar absolute tolerances for yQS */ N_Vector *cv_VabstolQS; /* vector absolute tolerances for yQS */ /*----------------------- Nordsieck History Array -----------------------*/ N_Vector cv_zn[L_MAX]; /* Nordsieck array, of size N x (q+1). zn[j] is a vector of length N (j=0,...,q) zn[j] = [1/factorial(j)] * h^j * (jth derivative of the interpolating poly.) */ /*------------------- Vectors of length N -------------------*/ N_Vector cv_ewt; /* error weight vector */ N_Vector cv_y; /* y is used as temporary storage by the solver. The memory is provided by the user to CVode where the vector is named yout. */ N_Vector cv_acor; /* In the context of the solution of the nonlinear equation, acor = y_n(m) - y_n(0). On return, this vector is scaled to give the estimated local error in y. */ N_Vector cv_tempv; /* temporary storage vector */ N_Vector cv_ftemp; /* temporary storage vector */ /*-------------------------- Quadrature Related Vectors --------------------------*/ N_Vector cv_znQ[L_MAX]; /* Nordsieck arrays for quadratures */ N_Vector cv_ewtQ; /* error weight vector for quadratures */ N_Vector cv_yQ; /* Unlike y, yQ is not allocated by the user */ N_Vector cv_acorQ; /* acorQ = yQ_n(m) - yQ_n(0) */ N_Vector cv_tempvQ; /* temporary storage vector (~ tempv) */ /*--------------------------- Sensitivity Related Vectors ---------------------------*/ N_Vector *cv_znS[L_MAX]; /* Nordsieck arrays for sensitivities */ N_Vector *cv_ewtS; /* error weight vectors for sensitivities */ N_Vector *cv_yS; /* yS=yS0 (allocated by the user) */ N_Vector *cv_acorS; /* acorS = yS_n(m) - yS_n(0) */ N_Vector *cv_tempvS; /* temporary storage vector (~ tempv) */ N_Vector *cv_ftempS; /* temporary storage vector (~ ftemp) */ booleantype cv_stgr1alloc; /* Did we allocate ncfS1, ncfnS1, and nniS1? */ /*-------------------------------------- Quadrature Sensitivity Related Vectors --------------------------------------*/ N_Vector *cv_znQS[L_MAX]; /* Nordsieck arrays for quadr. sensitivities */ N_Vector *cv_ewtQS; /* error weight vectors for sensitivities */ N_Vector *cv_yQS; /* Unlike yS, yQS is not allocated by the user */ N_Vector *cv_acorQS; /* acorQS = yQS_n(m) - yQS_n(0) */ N_Vector *cv_tempvQS; /* temporary storage vector (~ tempv) */ N_Vector cv_ftempQ; /* temporary storage vector (~ ftemp) */ /*----------------- Tstop information -----------------*/ booleantype cv_tstopset; realtype cv_tstop; /*--------- Step Data ---------*/ int cv_q; /* current order */ int cv_qprime; /* order to be used on the next step * qprime = q-1, q, or q+1 */ int cv_next_q; /* order to be used on the next step */ int cv_qwait; /* number of internal steps to wait before * considering a change in q */ int cv_L; /* L = q + 1 */ realtype cv_hin; realtype cv_h; /* current step size */ realtype cv_hprime; /* step size to be used on the next step */ realtype cv_next_h; /* step size to be used on the next step */ realtype cv_eta; /* eta = hprime / h */ realtype cv_hscale; /* value of h used in zn */ realtype cv_tn; /* current internal value of t */ realtype cv_tretlast; /* last value of t returned */ realtype cv_tau[L_MAX+1]; /* array of previous q+1 successful step * sizes indexed from 1 to q+1 */ realtype cv_tq[NUM_TESTS+1]; /* array of test quantities indexed from * 1 to NUM_TESTS(=5) */ realtype cv_l[L_MAX]; /* coefficients of l(x) (degree q poly) */ realtype cv_rl1; /* the scalar 1/l[1] */ realtype cv_gamma; /* gamma = h * rl1 */ realtype cv_gammap; /* gamma at the last setup call */ realtype cv_gamrat; /* gamma / gammap */ realtype cv_crate; /* est. corrector conv. rate in Nls */ realtype cv_crateS; /* est. corrector conv. rate in NlsStgr */ realtype cv_acnrm; /* | acor | */ realtype cv_acnrmQ; /* | acorQ | */ realtype cv_acnrmS; /* | acorS | */ realtype cv_acnrmQS; /* | acorQS | */ realtype cv_nlscoef; /* coeficient in nonlinear convergence test */ int cv_mnewt; /* Newton iteration counter */ int *cv_ncfS1; /* Array of Ns local counters for conv. * failures (used in CVStep for STAGGERED1) */ /*------ Limits ------*/ int cv_qmax; /* q <= qmax */ long int cv_mxstep; /* maximum number of internal steps for one user call */ int cv_maxcor; /* maximum number of corrector iterations for the solution of the nonlinear equation */ int cv_maxcorS; int cv_mxhnil; /* max. number of warning messages issued to the user that t + h == t for the next internal step */ int cv_maxnef; /* maximum number of error test failures */ int cv_maxncf; /* maximum number of nonlinear conv. failures */ realtype cv_hmin; /* |h| >= hmin */ realtype cv_hmax_inv; /* |h| <= 1/hmax_inv */ realtype cv_etamax; /* eta <= etamax */ /*---------- Counters ----------*/ long int cv_nst; /* number of internal steps taken */ long int cv_nfe; /* number of f calls */ long int cv_nfQe; /* number of fQ calls */ long int cv_nfSe; /* number of fS calls */ long int cv_nfeS; /* number of f calls from sensi DQ */ long int cv_nfQSe; /* number of fQS calls */ long int cv_nfQeS; /* number of fQ calls from sensi DQ */ long int cv_ncfn; /* number of corrector convergence failures */ long int cv_ncfnS; /* number of total sensi. corr. conv. failures */ long int *cv_ncfnS1; /* number of sensi. corrector conv. failures */ long int cv_nni; /* number of nonlinear iterations performed */ long int cv_nniS; /* number of total sensi. nonlinear iterations */ long int *cv_nniS1; /* number of sensi. nonlinear iterations */ long int cv_netf; /* number of error test failures */ long int cv_netfQ; /* number of quadr. error test failures */ long int cv_netfS; /* number of sensi. error test failures */ long int cv_netfQS; /* number of quadr. sensi. error test failures */ long int cv_nsetups; /* number of setup calls */ long int cv_nsetupsS; /* number of setup calls due to sensitivities */ int cv_nhnil; /* number of messages issued to the user that t + h == t for the next iternal step */ /*----------------------------- Space requirements for CVODES -----------------------------*/ long int cv_lrw1; /* no. of realtype words in 1 N_Vector y */ long int cv_liw1; /* no. of integer words in 1 N_Vector y */ long int cv_lrw1Q; /* no. of realtype words in 1 N_Vector yQ */ long int cv_liw1Q; /* no. of integer words in 1 N_Vector yQ */ long int cv_lrw; /* no. of realtype words in CVODES work vectors */ long int cv_liw; /* no. of integer words in CVODES work vectors */ /*---------------- Step size ratios ----------------*/ realtype cv_etaqm1; /* ratio of new to old h for order q-1 */ realtype cv_etaq; /* ratio of new to old h for order q */ realtype cv_etaqp1; /* ratio of new to old h for order q+1 */ /*------------------ Linear Solver Data ------------------*/ /* Linear Solver functions to be called */ int (*cv_linit)(struct CVodeMemRec *cv_mem); int (*cv_lsetup)(struct CVodeMemRec *cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int (*cv_lsolve)(struct CVodeMemRec *cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); void (*cv_lfree)(struct CVodeMemRec *cv_mem); /* Linear Solver specific memory */ void *cv_lmem; /* Flag to request a call to the setup routine */ booleantype cv_forceSetup; /*------------ Saved Values ------------*/ int cv_qu; /* last successful q value used */ long int cv_nstlp; /* step number of last setup call */ realtype cv_h0u; /* actual initial stepsize */ realtype cv_hu; /* last successful h value used */ realtype cv_saved_tq5; /* saved value of tq[5] */ booleantype cv_jcur; /* is Jacobian info for linear solver current? */ realtype cv_tolsf; /* tolerance scale factor */ int cv_qmax_alloc; /* qmax used when allocating mem */ int cv_qmax_allocQ; /* qmax used when allocating quad. mem */ int cv_qmax_allocS; /* qmax used when allocating sensi. mem */ int cv_qmax_allocQS; /* qmax used when allocating quad. sensi. mem */ int cv_indx_acor; /* index of zn vector in which acor is saved */ booleantype cv_setupNonNull; /* Does setup do something? */ /*-------------------------------------------------------------------- Flags turned ON by CVodeInit, CVodeSensMalloc, and CVodeQuadMalloc and read by CVodeReInit, CVodeSensReInit, and CVodeQuadReInit --------------------------------------------------------------------*/ booleantype cv_VabstolMallocDone; booleantype cv_MallocDone; booleantype cv_VabstolQMallocDone; booleantype cv_QuadMallocDone; booleantype cv_VabstolSMallocDone; booleantype cv_SabstolSMallocDone; booleantype cv_SensMallocDone; booleantype cv_VabstolQSMallocDone; booleantype cv_SabstolQSMallocDone; booleantype cv_QuadSensMallocDone; /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ CVErrHandlerFn cv_ehfun; /* Error messages are handled by ehfun */ void *cv_eh_data; /* dats pointer passed to ehfun */ FILE *cv_errfp; /* CVODES error messages are sent to errfp */ /*------------------------- Stability Limit Detection -------------------------*/ booleantype cv_sldeton; /* Is Stability Limit Detection on? */ realtype cv_ssdat[6][4]; /* scaled data array for STALD */ int cv_nscon; /* counter for STALD method */ long int cv_nor; /* counter for number of order reductions */ /*---------------- Rootfinding Data ----------------*/ CVRootFn cv_gfun; /* Function g for roots sought */ int cv_nrtfn; /* number of components of g */ int *cv_iroots; /* array for root information */ int *cv_rootdir; /* array specifying direction of zero-crossing */ realtype cv_tlo; /* nearest endpoint of interval in root search */ realtype cv_thi; /* farthest endpoint of interval in root search */ realtype cv_trout; /* t value returned by rootfinding routine */ realtype *cv_glo; /* saved array of g values at t = tlo */ realtype *cv_ghi; /* saved array of g values at t = thi */ realtype *cv_grout; /* array of g values at t = trout */ realtype cv_toutc; /* copy of tout (if NORMAL mode) */ realtype cv_ttol; /* tolerance on root location trout */ int cv_taskc; /* copy of parameter itask */ int cv_irfnd; /* flag showing whether last step had a root */ long int cv_nge; /* counter for g evaluations */ booleantype *cv_gactive; /* array with active/inactive event functions */ int cv_mxgnull; /* number of warning messages about possible g==0 */ /*------------------------ Adjoint sensitivity data ------------------------*/ booleantype cv_adj; /* TRUE if performing ASA */ struct CVadjMemRec *cv_adj_mem; /* Pointer to adjoint memory structure */ booleantype cv_adjMallocDone; } *CVodeMem; /* * ================================================================= * A D J O I N T M O D U L E M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Types : struct CkpntMemRec, CkpntMem * ----------------------------------------------------------------- * The type CkpntMem is type pointer to struct CkpntMemRec. * This structure contains fields to store all information at a * check point that is needed to 'hot' start cvodes. * ----------------------------------------------------------------- */ struct CkpntMemRec { /* Integration limits */ realtype ck_t0; realtype ck_t1; /* Nordsieck History Array */ N_Vector ck_zn[L_MAX]; /* Do we need to carry quadratures? */ booleantype ck_quadr; /* Nordsieck History Array for quadratures */ N_Vector ck_znQ[L_MAX]; /* Do we need to carry sensitivities? */ booleantype ck_sensi; /* number of sensitivities */ int ck_Ns; /* Nordsieck History Array for sensitivities */ N_Vector *ck_znS[L_MAX]; /* Do we need to carry quadrature sensitivities? */ booleantype ck_quadr_sensi; /* Nordsieck History Array for quadrature sensitivities */ N_Vector *ck_znQS[L_MAX]; /* Was ck_zn[qmax] allocated? ck_zqm = 0 - no ck_zqm = qmax - yes */ int ck_zqm; /* Step data */ long int ck_nst; realtype ck_tretlast; int ck_q; int ck_qprime; int ck_qwait; int ck_L; realtype ck_gammap; realtype ck_h; realtype ck_hprime; realtype ck_hscale; realtype ck_eta; realtype ck_etamax; realtype ck_tau[L_MAX+1]; realtype ck_tq[NUM_TESTS+1]; realtype ck_l[L_MAX]; /* Saved values */ realtype ck_saved_tq5; /* Pointer to next structure in list */ struct CkpntMemRec *ck_next; }; /* * ----------------------------------------------------------------- * Types for functions provided by an interpolation module * ----------------------------------------------------------------- * cvaIMMallocFn: Type for a function that initializes the content * field of the structures in the dt array * cvaIMFreeFn: Type for a function that deallocates the content * field of the structures in the dt array * cvaIMGetYFn: Type for a function that returns the * interpolated forward solution. * cvaIMStorePnt: Type for a function that stores a new * point in the structure d * ----------------------------------------------------------------- */ typedef booleantype (*cvaIMMallocFn)(CVodeMem cv_mem); typedef void (*cvaIMFreeFn)(CVodeMem cv_mem); typedef int (*cvaIMGetYFn)(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); typedef int (*cvaIMStorePntFn)(CVodeMem cv_mem, DtpntMem d); /* * ----------------------------------------------------------------- * Type : struct DtpntMemRec * ----------------------------------------------------------------- * This structure contains fields to store all information at a * data point that is needed to interpolate solution of forward * simulations. Its content field depends on IMtype. * ----------------------------------------------------------------- */ struct DtpntMemRec { realtype t; /* time */ void *content; /* IMtype-dependent content */ }; /* Data for cubic Hermite interpolation */ typedef struct HermiteDataMemRec { N_Vector y; N_Vector yd; N_Vector *yS; N_Vector *ySd; } *HermiteDataMem; /* Data for polynomial interpolation */ typedef struct PolynomialDataMemRec { N_Vector y; N_Vector *yS; int order; } *PolynomialDataMem; /* * ----------------------------------------------------------------- * Type : struct CVodeBMemRec * ----------------------------------------------------------------- * The type CVodeBMem is a pointer to a structure which stores all * information for ONE backward problem. * The CVadjMem structure contains a linked list of CVodeBMem pointers * ----------------------------------------------------------------- */ struct CVodeBMemRec { /* Index of this backward problem */ int cv_index; /* Time at which the backward problem is intialized */ realtype cv_t0; /* CVODES memory for this backward problem */ CVodeMem cv_mem; /* Flags to indicate that this backward problem's RHS or quad RHS * require forward sensitivities */ booleantype cv_f_withSensi; booleantype cv_fQ_withSensi; /* Right hand side function for backward run */ CVRhsFnB cv_f; CVRhsFnBS cv_fs; /* Right hand side quadrature function for backward run */ CVQuadRhsFnB cv_fQ; CVQuadRhsFnBS cv_fQs; /* User user_data */ void *cv_user_data; /* Memory block for a linear solver's interface to CVODEA */ void *cv_lmem; /* Function to free any memory allocated by the linear solver */ void (*cv_lfree)(CVodeBMem cvB_mem); /* Memory block for a preconditioner's module interface to CVODEA */ void *cv_pmem; /* Function to free any memory allocated by the preconditioner module */ void (*cv_pfree)(CVodeBMem cvB_mem); /* Time at which to extract solution / quadratures */ realtype cv_tout; /* Workspace Nvector */ N_Vector cv_y; /* Pointer to next structure in list */ struct CVodeBMemRec *cv_next; }; /* * ----------------------------------------------------------------- * Type : struct CVadjMemRec * ----------------------------------------------------------------- * The type CVadjMem is type pointer to struct CVadjMemRec. * This structure contins fields to store all information * necessary for adjoint sensitivity analysis. * ----------------------------------------------------------------- */ struct CVadjMemRec { /* -------------------- * Forward problem data * -------------------- */ /* Integration interval */ realtype ca_tinitial, ca_tfinal; /* Flag for first call to CVodeF */ booleantype ca_firstCVodeFcall; /* Flag if CVodeF was called with TSTOP */ booleantype ca_tstopCVodeFcall; realtype ca_tstopCVodeF; /* ---------------------- * Backward problems data * ---------------------- */ /* Storage for backward problems */ struct CVodeBMemRec *cvB_mem; /* Number of backward problems */ int ca_nbckpbs; /* Address of current backward problem */ struct CVodeBMemRec *ca_bckpbCrt; /* Flag for first call to CVodeB */ booleantype ca_firstCVodeBcall; /* ---------------- * Check point data * ---------------- */ /* Storage for check point information */ struct CkpntMemRec *ck_mem; /* Number of check points */ int ca_nckpnts; /* address of the check point structure for which data is available */ struct CkpntMemRec *ca_ckpntData; /* ------------------ * Interpolation data * ------------------ */ /* Number of steps between 2 check points */ long int ca_nsteps; /* Storage for data from forward runs */ struct DtpntMemRec **dt_mem; /* Actual number of data points in dt_mem (typically np=nsteps+1) */ long int ca_np; /* Interpolation type */ int ca_IMtype; /* Functions set by the interpolation module */ cvaIMMallocFn ca_IMmalloc; cvaIMFreeFn ca_IMfree; cvaIMStorePntFn ca_IMstore; /* store a new interpolation point */ cvaIMGetYFn ca_IMget; /* interpolate forward solution */ /* Flags controlling the interpolation module */ booleantype ca_IMmallocDone; /* IM initialized? */ booleantype ca_IMnewData; /* new data available in dt_mem?*/ booleantype ca_IMstoreSensi; /* store sensitivities? */ booleantype ca_IMinterpSensi; /* interpolate sensitivities? */ /* Workspace for the interpolation module */ N_Vector ca_Y[L_MAX]; /* pointers to zn[i] */ N_Vector *ca_YS[L_MAX]; /* pointers to znS[i] */ realtype ca_T[L_MAX]; /* ------------------------------- * Workspace for wrapper functions * ------------------------------- */ N_Vector ca_ytmp; N_Vector *ca_yStmp; }; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * Communication between CVODE and a CVODE Linear Solver * ----------------------------------------------------------------- * convfail (input to cv_lsetup) * * CV_NO_FAILURES : Either this is the first cv_setup call for this * step, or the local error test failed on the * previous attempt at this step (but the Newton * iteration converged). * * CV_FAIL_BAD_J : This value is passed to cv_lsetup if * * (a) The previous Newton corrector iteration * did not converge and the linear solver's * setup routine indicated that its Jacobian- * related data is not current * or * (b) During the previous Newton corrector * iteration, the linear solver's solve routine * failed in a recoverable manner and the * linear solver's setup routine indicated that * its Jacobian-related data is not current. * * CV_FAIL_OTHER : During the current internal step try, the * previous Newton iteration failed to converge * even though the linear solver was using current * Jacobian-related data. * ----------------------------------------------------------------- */ /* Constants for convfail (input to cv_lsetup) */ #define CV_NO_FAILURES 0 #define CV_FAIL_BAD_J 1 #define CV_FAIL_OTHER 2 /* * ----------------------------------------------------------------- * int (*cv_linit)(CVodeMem cv_mem); * ----------------------------------------------------------------- * The purpose of cv_linit is to complete initializations for a * specific linear solver, such as counters and statistics. * An LInitFn should return 0 if it has successfully initialized the * CVODE linear solver and a negative value otherwise. * If an error does occur, an appropriate message should be sent to * the error handler function. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsetup)(CVodeMem cv_mem, int convfail, N_Vector ypred, * N_Vector fpred, booleantype *jcurPtr, * N_Vector vtemp1, N_Vector vtemp2, * N_Vector vtemp3); * ----------------------------------------------------------------- * The job of cv_lsetup is to prepare the linear solver for * subsequent calls to cv_lsolve. It may recompute Jacobian- * related data is it deems necessary. Its parameters are as * follows: * * cv_mem - problem memory pointer of type CVodeMem. See the * typedef earlier in this file. * * convfail - a flag to indicate any problem that occurred during * the solution of the nonlinear equation on the * current time step for which the linear solver is * being used. This flag can be used to help decide * whether the Jacobian data kept by a CVODE linear * solver needs to be updated or not. * Its possible values have been documented above. * * ypred - the predicted y vector for the current CVODE internal * step. * * fpred - f(tn, ypred). * * jcurPtr - a pointer to a boolean to be filled in by cv_lsetup. * The function should set *jcurPtr=TRUE if its Jacobian * data is current after the call and should set * *jcurPtr=FALSE if its Jacobian data is not current. * Note: If cv_lsetup calls for re-evaluation of * Jacobian data (based on convfail and CVODE state * data), it should return *jcurPtr=TRUE always; * otherwise an infinite loop can result. * * vtemp1 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * The cv_lsetup routine should return 0 if successful, a positive * value for a recoverable error, and a negative value for an * unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsolve)(CVodeMem cv_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector fcur); * ----------------------------------------------------------------- * cv_lsolve must solve the linear equation P x = b, where * P is some approximation to (I - gamma J), J = (df/dy)(tn,ycur) * and the RHS vector b is input. The N-vector ycur contains * the solver's current approximation to y(tn) and the vector * fcur contains the N_Vector f(tn,ycur). The solution is to be * returned in the vector b. cv_lsolve returns a positive value * for a recoverable error and a negative value for an * unrecoverable error. Success is indicated by a 0 return value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * void (*cv_lfree)(CVodeMem cv_mem); * ----------------------------------------------------------------- * cv_lfree should free up any memory allocated by the linear * solver. This routine is called once a problem has been * completed and the linear solver is no longer needed. * ----------------------------------------------------------------- */ /* * ================================================================= * C V O D E S I N T E R N A L F U N C T I O N S * ================================================================= */ /* Prototype of internal ewtSet function */ int cvEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void cvProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void cvErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* Prototypes for internal sensitivity rhs wrappers */ int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, N_Vector *yScur, N_Vector *fScur, N_Vector temp1, N_Vector temp2); int cvSensRhs1Wrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, int is, N_Vector yScur, N_Vector fScur, N_Vector temp1, N_Vector temp2); /* Prototypes for internal sensitivity rhs DQ functions */ int cvSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *fS_data, N_Vector tempv, N_Vector ftemp); int cvSensRhs1InternalDQ(int Ns, realtype t, N_Vector y, N_Vector ydot, int is, N_Vector yS, N_Vector ySdot, void *fS_data, N_Vector tempv, N_Vector ftemp); /* * ================================================================= * C V O D E S E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg" #define MSG_TIME_H "t = %Lg and h = %Lg" #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg" #define MSG_TIME_H "t = %lg and h = %lg" #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g" #define MSG_TIME_H "t = %g and h = %g" #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* Initialization and I/O error messages */ #define MSGCV_NO_MEM "cvode_mem = NULL illegal." #define MSGCV_CVMEM_FAIL "Allocation of cvode_mem failed." #define MSGCV_MEM_FAIL "A memory request failed." #define MSGCV_BAD_LMM "Illegal value for lmm. The legal values are CV_ADAMS and CV_BDF." #define MSGCV_BAD_ITER "Illegal value for iter. The legal values are CV_FUNCTIONAL and CV_NEWTON." #define MSGCV_NO_MALLOC "Attempt to call before CVodeInit." #define MSGCV_NEG_MAXORD "maxord <= 0 illegal." #define MSGCV_BAD_MAXORD "Illegal attempt to increase maximum method order." #define MSGCV_SET_SLDET "Attempt to use stability limit detection with the CV_ADAMS method illegal." #define MSGCV_NEG_HMIN "hmin < 0 illegal." #define MSGCV_NEG_HMAX "hmax < 0 illegal." #define MSGCV_BAD_HMIN_HMAX "Inconsistent step size limits: hmin > hmax." #define MSGCV_BAD_RELTOL "reltol < 0 illegal." #define MSGCV_BAD_ABSTOL "abstol has negative component(s) (illegal)." #define MSGCV_NULL_ABSTOL "abstol = NULL illegal." #define MSGCV_NULL_Y0 "y0 = NULL illegal." #define MSGCV_NULL_F "f = NULL illegal." #define MSGCV_NULL_G "g = NULL illegal." #define MSGCV_BAD_NVECTOR "A required vector operation is not implemented." #define MSGCV_BAD_K "Illegal value for k." #define MSGCV_NULL_DKY "dky = NULL illegal." #define MSGCV_BAD_T "Illegal value for t." MSG_TIME_INT #define MSGCV_NO_ROOT "Rootfinding was not initialized." #define MSGCV_NO_QUAD "Quadrature integration not activated." #define MSGCV_BAD_ITOLQ "Illegal value for itolQ. The legal values are CV_SS and CV_SV." #define MSGCV_NULL_ABSTOLQ "abstolQ = NULL illegal." #define MSGCV_BAD_RELTOLQ "reltolQ < 0 illegal." #define MSGCV_BAD_ABSTOLQ "abstolQ has negative component(s) (illegal)." #define MSGCV_SENSINIT_2 "Sensitivity analysis already initialized." #define MSGCV_NO_SENSI "Forward sensitivity analysis not activated." #define MSGCV_BAD_ITOLS "Illegal value for itolS. The legal values are CV_SS, CV_SV, and CV_EE." #define MSGCV_NULL_ABSTOLS "abstolS = NULL illegal." #define MSGCV_BAD_RELTOLS "reltolS < 0 illegal." #define MSGCV_BAD_ABSTOLS "abstolS has negative component(s) (illegal)." #define MSGCV_BAD_PBAR "pbar has zero component(s) (illegal)." #define MSGCV_BAD_PLIST "plist has negative component(s) (illegal)." #define MSGCV_BAD_NS "NS <= 0 illegal." #define MSGCV_NULL_YS0 "yS0 = NULL illegal." #define MSGCV_BAD_ISM "Illegal value for ism. Legal values are: CV_SIMULTANEOUS, CV_STAGGERED and CV_STAGGERED1." #define MSGCV_BAD_IFS "Illegal value for ifS. Legal values are: CV_ALLSENS and CV_ONESENS." #define MSGCV_BAD_ISM_IFS "Illegal ism = CV_STAGGERED1 for CVodeSensInit." #define MSGCV_BAD_IS "Illegal value for is." #define MSGCV_NULL_DKYA "dkyA = NULL illegal." #define MSGCV_BAD_DQTYPE "Illegal value for DQtype. Legal values are: CV_CENTERED and CV_FORWARD." #define MSGCV_BAD_DQRHO "DQrhomax < 0 illegal." #define MSGCV_BAD_ITOLQS "Illegal value for itolQS. The legal values are CV_SS, CV_SV, and CV_EE." #define MSGCV_NULL_ABSTOLQS "abstolQS = NULL illegal." #define MSGCV_BAD_RELTOLQS "reltolQS < 0 illegal." #define MSGCV_BAD_ABSTOLQS "abstolQS has negative component(s) (illegal)." #define MSGCV_NO_QUADSENSI "Forward sensitivity analysis for quadrature variables not activated." #define MSGCV_NULL_YQS0 "yQS0 = NULL illegal." /* CVode Error Messages */ #define MSGCV_NO_TOL "No integration tolerances have been specified." #define MSGCV_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSGCV_YOUT_NULL "yout = NULL illegal." #define MSGCV_TRET_NULL "tret = NULL illegal." #define MSGCV_BAD_EWT "Initial ewt has component(s) equal to zero (illegal)." #define MSGCV_EWT_NOW_BAD "At " MSG_TIME ", a component of ewt has become <= 0." #define MSGCV_BAD_ITASK "Illegal value for itask." #define MSGCV_BAD_H0 "h0 and tout - t0 inconsistent." #define MSGCV_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration" #define MSGCV_EWT_FAIL "The user-provide EwtSet function failed." #define MSGCV_EWT_NOW_FAIL "At " MSG_TIME ", the user-provide EwtSet function failed." #define MSGCV_LINIT_FAIL "The linear solver's init routine failed." #define MSGCV_HNIL_DONE "The above warning has been issued mxhnil times and will not be issued again for this problem." #define MSGCV_TOO_CLOSE "tout too close to t0 to start integration." #define MSGCV_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSGCV_TOO_MUCH_ACC "At " MSG_TIME ", too much accuracy requested." #define MSGCV_HNIL "Internal " MSG_TIME_H " are such that t + h = t on the next step. The solver will continue anyway." #define MSGCV_ERR_FAILS "At " MSG_TIME_H ", the error test failed repeatedly or with |h| = hmin." #define MSGCV_CONV_FAILS "At " MSG_TIME_H ", the corrector convergence test failed repeatedly or with |h| = hmin." #define MSGCV_SETUP_FAILED "At " MSG_TIME ", the setup routine failed in an unrecoverable manner." #define MSGCV_SOLVE_FAILED "At " MSG_TIME ", the solve routine failed in an unrecoverable manner." #define MSGCV_RHSFUNC_FAILED "At " MSG_TIME ", the right-hand side routine failed in an unrecoverable manner." #define MSGCV_RHSFUNC_UNREC "At " MSG_TIME ", the right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_RHSFUNC_REPTD "At " MSG_TIME " repeated recoverable right-hand side function errors." #define MSGCV_RHSFUNC_FIRST "The right-hand side routine failed at the first call." #define MSGCV_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSGCV_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSGCV_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME " in the direction of integration." #define MSGCV_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." #define MSGCV_NO_TOLQ "No integration tolerances for quadrature variables have been specified." #define MSGCV_BAD_EWTQ "Initial ewtQ has component(s) equal to zero (illegal)." #define MSGCV_EWTQ_NOW_BAD "At " MSG_TIME ", a component of ewtQ has become <= 0." #define MSGCV_QRHSFUNC_FAILED "At " MSG_TIME ", the quadrature right-hand side routine failed in an unrecoverable manner." #define MSGCV_QRHSFUNC_UNREC "At " MSG_TIME ", the quadrature right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_QRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature right-hand side function errors." #define MSGCV_QRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." #define MSGCV_NO_TOLS "No integration tolerances for sensitivity variables have been specified." #define MSGCV_NULL_P "p = NULL when using internal DQ for sensitivity RHS illegal." #define MSGCV_BAD_EWTS "Initial ewtS has component(s) equal to zero (illegal)." #define MSGCV_EWTS_NOW_BAD "At " MSG_TIME ", a component of ewtS has become <= 0." #define MSGCV_SRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity right-hand side routine failed in an unrecoverable manner." #define MSGCV_SRHSFUNC_UNREC "At " MSG_TIME ", the sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_SRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable sensitivity right-hand side function errors." #define MSGCV_SRHSFUNC_FIRST "The sensitivity right-hand side routine failed at the first call." #define MSGCV_NULL_FQ "CVODES is expected to use DQ to evaluate the RHS of quad. sensi., but quadratures were not initialized." #define MSGCV_NO_TOLQS "No integration tolerances for quadrature sensitivity variables have been specified." #define MSGCV_BAD_EWTQS "Initial ewtQS has component(s) equal to zero (illegal)." #define MSGCV_EWTQS_NOW_BAD "At " MSG_TIME ", a component of ewtQS has become <= 0." #define MSGCV_QSRHSFUNC_FAILED "At " MSG_TIME ", the quadrature sensitivity right-hand side routine failed in an unrecoverable manner." #define MSGCV_QSRHSFUNC_UNREC "At " MSG_TIME ", the quadrature sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_QSRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature sensitivity right-hand side function errors." #define MSGCV_QSRHSFUNC_FIRST "The quadrature sensitivity right-hand side routine failed at the first call." /* * ================================================================= * C V O D E A E R R O R M E S S A G E S * ================================================================= */ #define MSGCV_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGCV_BAD_STEPS "Steps nonpositive illegal." #define MSGCV_BAD_INTERP "Illegal value for interp." #define MSGCV_BAD_WHICH "Illegal value for which." #define MSGCV_NO_BCK "No backward problems have been defined yet." #define MSGCV_NO_FWD "Illegal attempt to call before calling CVodeF." #define MSGCV_BAD_TB0 "The initial time tB0 for problem %d is outside the interval over which the forward problem was solved." #define MSGCV_BAD_SENSI "At least one backward problem requires sensitivities, but they were not stored for interpolation." #define MSGCV_BAD_ITASKB "Illegal value for itaskB. Legal values are CV_NORMAL and CV_ONE_STEP." #define MSGCV_BAD_TBOUT "The final time tBout is outside the interval over which the forward problem was solved." #define MSGCV_BACK_ERROR "Error occured while integrating backward problem # %d" #define MSGCV_BAD_TINTERP "Bad t = %g for interpolation." #define MSGCV_WRONG_INTERP "This function cannot be called for the specified interp type." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/cvodes/cvodes_bbdpre.c0000600000175000017500000005605011741421150021233 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.14 $ * $Date: 2010/12/01 22:30:43 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with CVODE, a CVSPILS linear * solver, and the parallel implementation of NVECTOR. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include "cvodes_bbdpre_impl.h" #include "cvodes_spils_impl.h" #include #include #include #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes of functions cvBBDPrecSetup and cvBBDPrecSolve */ static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data, N_Vector tmp); /* Prototype for cvBBDPrecFree */ static void cvBBDPrecFree(CVodeMem cv_mem); /* Wrapper functions for adjoint code */ static int cvGlocWrapper(long int NlocalB, realtype t, N_Vector yB, N_Vector gB, void *cvadj_mem); static int cvCfnWrapper(long int NlocalB, realtype t, N_Vector yB, void *cvadj_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp); /* Prototype for the pfree routine */ static void CVBBDPrecFreeB(CVodeBMem cvB_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Redability replacements */ #define uround (cv_mem->cv_uround) #define vec_tmpl (cv_mem->cv_tempv) /* * ----------------------------------------------------------------- * User-Callable Functions: initialization, reinit and free * ----------------------------------------------------------------- */ int CVBBDPrecInit(void *cvode_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; long int muk, mlk, storage_mu; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the NVECTOR package is compatible with the BLOCK BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_BAD_NVECTOR); return(CVSPILS_ILL_INPUT); } /* Allocate data memory */ pdata = NULL; pdata = (CVBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set pointers to gloc and cfn; load half-bandwidths */ pdata->cvode_mem = cvode_mem; pdata->gloc = gloc; pdata->cfn = cfn; pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); muk = MIN(Nlocal-1, MAX(0,mukeep)); mlk = MIN(Nlocal-1, MAX(0,mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Allocate memory for saved Jacobian */ pdata->savedJ = NewBandMat(Nlocal, muk, mlk, muk); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for preconditioner matrix */ storage_mu = MIN(Nlocal-1, muk + mlk); pdata->savedP = NULL; pdata->savedP = NewBandMat(Nlocal, muk, mlk, storage_mu); if (pdata->savedP == NULL) { DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Allocate memory for lpivots */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(Nlocal); if (pdata->lpivots == NULL) { DestroyMat(pdata->savedP); DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); /* Store Nlocal to be used in CVBBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge */ pdata->rpwsize = Nlocal*(muk + 2*mlk + storage_mu + 2); pdata->ipwsize = Nlocal; pdata->nge = 0; /* Overwrite the P_data field in the SPILS memory */ cvspils_mem->s_P_data = pdata; /* Attach the pfree function */ cvspils_mem->s_pfree = cvBBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, cvBBDPrecSetup, cvBBDPrecSolve); return(flag); } int CVBBDPrecReInit(void *cvode_mem, long int mudq, long int mldq, realtype dqrely) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; long int Nlocal; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; /* Test if the preconditioner data is non-NULL */ if (cvspils_mem->s_P_data == NULL) { cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecReInit", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; /* Load half-bandwidths */ Nlocal = pdata->n_local; pdata->mudq = MIN(Nlocal-1, MAX(0,mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0,mldq)); /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : RSqrt(uround); /* Re-initialize nge */ pdata->nge = 0; return(CVSPILS_SUCCESS); } int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(CVSPILS_SUCCESS); } int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP) { CVodeMem cv_mem; CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVSPILS_LMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(CVSPILS_LMEM_NULL); } cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) { cvProcessError(cv_mem, CVSPILS_PMEM_NULL, "CVBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(CVSPILS_PMEM_NULL); } pdata = (CVBBDPrecData) cvspils_mem->s_P_data; *ngevalsBBDP = pdata->nge; return(CVSPILS_SUCCESS); } /* Readability Replacements */ #define Nlocal (pdata->n_local) #define mudq (pdata->mudq) #define mldq (pdata->mldq) #define mukeep (pdata->mukeep) #define mlkeep (pdata->mlkeep) #define dqrely (pdata->dqrely) #define gloc (pdata->gloc) #define cfn (pdata->cfn) #define savedJ (pdata->savedJ) #define savedP (pdata->savedP) #define lpivots (pdata->lpivots) #define nge (pdata->nge) /* * ----------------------------------------------------------------- * Function : cvBBDPrecSetup * ----------------------------------------------------------------- * cvBBDPrecSetup generates and factors a banded block of the * preconditioner matrix on each processor, via calls to the * user-supplied gloc and cfn functions. It uses difference * quotient approximations to the Jacobian elements. * * cvBBDPrecSetup calculates a new J,if necessary, then calculates * P = I - gamma*J, and does an LU factorization of P. * * The parameters of cvBBDPrecSetup used here are as follows: * * t is the current value of the independent variable. * * y is the current value of the dependent variable vector, * namely the predicted value of y(t). * * fy is the vector f(t,y). * * jok is an input flag indicating whether Jacobian-related * data needs to be recomputed, as follows: * jok == FALSE means recompute Jacobian-related data * from scratch. * jok == TRUE means that Jacobian data from the * previous CVBBDPrecon call can be reused * (with the current value of gamma). * A CVBBDPrecon call with jok == TRUE should only occur * after a call with jok == FALSE. * * jcurPtr is a pointer to an output integer flag which is * set by CVBBDPrecon as follows: * *jcurPtr = TRUE if Jacobian data was recomputed. * *jcurPtr = FALSE if Jacobian data was not recomputed, * but saved data was reused. * * gamma is the scalar appearing in the Newton matrix. * * bbd_data is a pointer to the preconditioner data set by * CVBBDPrecInit * * tmp1, tmp2, and tmp3 are pointers to memory allocated * for NVectors which are be used by cvBBDPrecSetup * as temporary storage or work space. * * Return value: * The value returned by this cvBBDPrecSetup function is the int * 0 if successful, * 1 for a recoverable error (step will be retried). * ----------------------------------------------------------------- */ static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVBBDPrecData pdata; CVodeMem cv_mem; int retval; long int ier; pdata = (CVBBDPrecData) bbd_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call cvBBDDQJac for new J value */ *jcurPtr = TRUE; SetToZero(savedJ); retval = cvBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBBDPRE", "cvBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of P in place */ ier = BandGBTRF(savedP, lpivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); } /* * ----------------------------------------------------------------- * Function : cvBBDPrecSolve * ----------------------------------------------------------------- * cvBBDPrecSolve solves a linear system P z = r, with the * band-block-diagonal preconditioner matrix P generated and * factored by cvBBDPrecSetup. * * The parameters of cvBBDPrecSolve used here are as follows: * * r is the right-hand side vector of the linear system. * * bbd_data is a pointer to the preconditioner data set by * CVBBDPrecInit. * * z is the output vector computed by cvBBDPrecSolve. * * The value returned by the cvBBDPrecSolve function is always 0, * indicating success. * ----------------------------------------------------------------- */ static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data, N_Vector tmp) { CVBBDPrecData pdata; realtype *zd; pdata = (CVBBDPrecData) bbd_data; /* Copy r to z, then do backsolve and return */ N_VScale(ONE, r, z); zd = N_VGetArrayPointer(z); BandGBTRS(savedP, lpivots, zd); return(0); } static void cvBBDPrecFree(CVodeMem cv_mem) { CVSpilsMem cvspils_mem; CVBBDPrecData pdata; if (cv_mem->cv_lmem == NULL) return; cvspils_mem = (CVSpilsMem) cv_mem->cv_lmem; if (cvspils_mem->s_P_data == NULL) return; pdata = (CVBBDPrecData) cvspils_mem->s_P_data; DestroyMat(savedJ); DestroyMat(savedP); DestroyArray(lpivots); free(pdata); pdata = NULL; } #define ewt (cv_mem->cv_ewt) #define h (cv_mem->cv_h) #define user_data (cv_mem->cv_user_data) /* * ----------------------------------------------------------------- * Function : cvBBDDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation * to the local block of the Jacobian of g(t,y). It assumes that a * band matrix of type BandMat is stored columnwise, and that elements * within each column are contiguous. All matrix elements are generated * as difference quotients, by way of calls to the user routine gloc. * By virtue of the band structure, the number of these calls is * bandwidth + 1, where bandwidth = mldq + mudq + 1. * But the band matrix kept has bandwidth = mlkeep + mukeep + 1. * This routine also assumes that the local elements of a vector are * stored contiguously. * ----------------------------------------------------------------- */ static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp) { CVodeMem cv_mem; realtype gnorm, minInc, inc, inc_inv; long int group, i, j, width, ngroups, i1, i2; realtype *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Load ytemp with y = predicted solution vector */ N_VScale(ONE, y, ytemp); /* Call cfn and gloc to get base value of g(t,y) */ if (cfn != NULL) { retval = cfn(Nlocal, t, y, user_data); if (retval != 0) return(retval); } retval = gloc(Nlocal, t, ytemp, gy, user_data); nge++; if (retval != 0) return(retval); /* Obtain pointers to the data for various vectors */ y_data = N_VGetArrayPointer(y); gy_data = N_VGetArrayPointer(gy); ewt_data = N_VGetArrayPointer(ewt); ytemp_data = N_VGetArrayPointer(ytemp); gtemp_data = N_VGetArrayPointer(gtemp); /* Set minimum increment based on uround and norm of g */ gnorm = N_VWrmsNorm(gy, ewt); minInc = (gnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < Nlocal; j+=width) { inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate g with incremented y */ retval = gloc(Nlocal, t, ytemp, gtemp, user_data); nge++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < Nlocal; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtemp_data[i] - gy_data[i]); } } return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* Additional readability replacements */ #define ytmp (ca_mem->ca_ytmp) #define yStmp (ca_mem->ca_yStmp) #define IMget (ca_mem->ca_IMget) #define gloc_B (cvbbdB_mem->glocB) #define cfn_B (cvbbdB_mem->cfnB) /* * CVBBDPrecInitB, CVBPSp*B * * Wrappers for the backward phase around the corresponding CVODES functions */ int CVBBDPrecInitB(void *cvode_mem, int which, long int NlocalB, long int mudqB, long int mldqB, long int mukeepB, long int mlkeepB, realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVBBDPrecDataB cvbbdB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Initialize the BBD preconditioner */ flag = CVBBDPrecInit(cvodeB_mem, NlocalB, mudqB, mldqB, mukeepB, mlkeepB, dqrelyB, cvGlocWrapper, cvCfnWrapper); if (flag != CV_SUCCESS) return(flag); /* Get memory for CVBBDPrecDataB to store the user-provided * functions which will be called from the wrappers */ cvbbdB_mem = NULL; cvbbdB_mem = (CVBBDPrecDataB) malloc(sizeof(* cvbbdB_mem)); if (cvbbdB_mem == NULL) { cvProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_FAIL); return(CVSPILS_MEM_FAIL); } gloc_B = glocB; cfn_B = cfnB; /* attach pmem and pfree */ cvB_mem->cv_pmem = cvbbdB_mem; cvB_mem->cv_pfree = CVBBDPrecFreeB; return(CVSPILS_SUCCESS); } int CVBBDPrecReInitB(void *cvode_mem, int which, long int mudqB, long int mldqB, realtype dqrelyB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSPILS_MEM_NULL, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_MEM_NULL); return(CVSPILS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == FALSE) { cvProcessError(cv_mem, CVSPILS_NO_ADJ, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_NO_ADJ); return(CVSPILS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVBBDPRE", "CVBBDPrecReInitB", MSGBBD_BAD_WHICH); return(CVSPILS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVBBDPrecReInit(cvodeB_mem, mudqB, mldqB, dqrelyB); return(flag); } static void CVBBDPrecFreeB(CVodeBMem cvB_mem) { free(cvB_mem->cv_pmem); cvB_mem->cv_pmem = NULL; } /* * cvGlocWrapper * * This routine interfaces to the CVLocalFnB routine * provided by the user. */ static int cvGlocWrapper(long int NlocalB, realtype t, N_Vector yB, N_Vector gB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVBBDPrecDataB cvbbdB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVBBDPRE", "cvGlocWrapper", MSGBBD_BAD_TINTERP); return(-1); } /* Call user's adjoint glocB routine */ retval = gloc_B(NlocalB, t, ytmp, yB, gB, cvB_mem->cv_user_data); return(retval); } /* * cvCfnWrapper * * This routine interfaces to the CVCommFnB routine * provided by the user. */ static int cvCfnWrapper(long int NlocalB, realtype t, N_Vector yB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVBBDPrecDataB cvbbdB_mem; int retval, flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); if (cfn_B == NULL) return(0); /* Forward solution from interpolation */ flag = IMget(cv_mem, t, ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVBBDPRE", "cvCfnWrapper", MSGBBD_BAD_TINTERP); return(-1); } /* Call user's adjoint cfnB routine */ retval = cfn_B(NlocalB, t, ytmp, yB, cvB_mem->cv_user_data); return(retval); } sundials-2.5.0/src/nvec_ser/0000755000175000017500000000000011767174700016627 5ustar sylvestresylvestresundials-2.5.0/src/nvec_ser/CMakeLists.txt0000600000175000017500000000710011741421110021333 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:48 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the serial NVECTOR library INSTALL(CODE "MESSAGE(\"\nInstall NVECTOR_SERIAL\n\")") # Add variable nvecserial_SOURCES with the sources for the NVECSERIAL lib SET(nvecserial_SOURCES nvector_serial.c) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the NVECSERIAL library SET(shared_SOURCES sundials_math.c) ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable nvecserial_HEADERS with the exported NVECSERIAL header files SET(nvecserial_HEADERS nvector_serial.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/nvector/ nvecserial_HEADERS) # Add source directory to include directories INCLUDE_DIRECTORIES(.) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Rules for building and installing the static library: # - Add the build target for the NVECSERIAL library # - Set the library name and make sure it is not deleted # - Install the NVECSERIAL library IF(BUILD_STATIC_LIBS) ADD_LIBRARY(sundials_nvecserial_static STATIC ${nvecserial_SOURCES} ${shared_SOURCES}) SET_TARGET_PROPERTIES(sundials_nvecserial_static PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) INSTALL(TARGETS sundials_nvecserial_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Rules for building and installing the shared library: # - Add the build target for the NVECSERIAL library # - Set the library name and make sure it is not deleted # - Set VERSION and SOVERSION for shared libraries # - Install the NVECSERIAL library IF(BUILD_SHARED_LIBS) ADD_LIBRARY(sundials_nvecserial_shared SHARED ${nvecserial_SOURCES} ${shared_SOURCES}) SET_TARGET_PROPERTIES(sundials_nvecserial_shared PROPERTIES OUTPUT_NAME sundials_nvecserial CLEAN_DIRECT_OUTPUT 1) SET_TARGET_PROPERTIES(sundials_nvecserial_shared PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) INSTALL(TARGETS sundials_nvecserial_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the NVECSERIAL header files INSTALL(FILES ${nvecserial_HEADERS} DESTINATION include/nvector) # If FCMIX is enabled, build and install the FNVECSERIAL library IF(FCMIX_ENABLE AND F77_FOUND) SET(fnvecserial_SOURCES fnvector_serial.c) IF(BUILD_STATIC_LIBS) ADD_LIBRARY(sundials_fnvecserial_static STATIC ${fnvecserial_SOURCES}) SET_TARGET_PROPERTIES(sundials_fnvecserial_static PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) INSTALL(TARGETS sundials_fnvecserial_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) IF(BUILD_SHARED_LIBS) ADD_LIBRARY(sundials_fnvecserial_shared ${fnvecserial_SOURCES}) SET_TARGET_PROPERTIES(sundials_fnvecserial_shared PROPERTIES OUTPUT_NAME sundials_fnvecserial CLEAN_DIRECT_OUTPUT 1) SET_TARGET_PROPERTIES(sundials_fnvecserial_shared PROPERTIES VERSION ${nveclib_VERSION} SOVERSION ${nveclib_SOVERSION}) INSTALL(TARGETS sundials_fnvecserial_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) ENDIF(FCMIX_ENABLE AND F77_FOUND) # MESSAGE(STATUS "Added NVECTOR_SERIAL module") sundials-2.5.0/src/nvec_ser/Makefile.in0000600000175000017500000001130111741421110020636 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.8 $ # $Date: 2007/01/29 17:36:28 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for serial NVECTOR module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ FCMIX_ENABLED = @FCMIX_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include LIB_REVISION = 0:2:0 NVECSER_LIB = libsundials_nvecserial.la NVECSER_LIB_FILES = nvector_serial.lo FNVECSER_LIB = libsundials_fnvecserial.la FNVECSER_LIB_FILES = fnvector_serial.lo SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_math.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs all: $(NVECSER_LIB) $(FNVECSER_LIB) $(NVECSER_LIB): shared $(NVECSER_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(NVECSER_LIB) $(NVECSER_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) $(FNVECSER_LIB): $(FNVECSER_LIB_FILES) @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION}" ; \ ${LIBTOOL} --mode=link ${CC} ${CFLAGS} -o ${FNVECSER_LIB} ${FNVECSER_LIB_FILES} ${SHARED_LIB_FILES} -rpath ${libdir} $(LDFLAGS) ${LIBS} -version-info ${LIB_REVISION} ; \ fi install: $(NVECSER_LIB) $(FNVECSER_LIB) $(mkinstalldirs) $(includedir)/nvector $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(NVECSER_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/nvector/nvector_serial.h $(includedir)/nvector/ @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir}" ; \ ${LIBTOOL} --mode=install ${INSTALL_LIB} ${FNVECSER_LIB} ${libdir} ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(NVECSER_LIB) @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB}" ; \ ${LIBTOOL} --mode=uninstall rm -f ${libdir}/${FNVECSER_LIB} ; \ fi rm -f $(includedir)/nvector/nvector_serial.h $(rminstalldirs) ${includedir}/nvector shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(NVECSER_LIB) rm -f $(NVECSER_LIB_FILES) rm -f nvector_serial.o @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB}" ; \ ${LIBTOOL} --mode=clean rm -f ${FNVECSER_LIB} ; \ echo "rm -f ${FNVECSER_LIB_FILES}" ; \ rm -f ${FNVECSER_LIB_FILES} ; \ echo "rm -f fnvector_serial.o" ; \ rm -f fnvector_serial.o ; \ fi distclean: clean rm -f Makefile nvector_serial.lo: $(srcdir)/nvector_serial.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/nvector_serial.c fnvector_serial.lo: $(srcdir)/fnvector_serial.c @if test "X${FCMIX_ENABLED}" = "Xyes"; then \ echo "${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c" ; \ ${LIBTOOL} --mode=compile ${CC} ${CPPFLAGS} $(INCLUDES) ${CFLAGS} -c ${srcdir}/fnvector_serial.c ; \ fi libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/nvec_ser/fnvector_serial.h0000600000175000017500000000520011741421110022130 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file (companion of nvector_serial.h) contains the * definitions needed for the initialization of serial * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_SERIAL_H #define _FNVECTOR_SERIAL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #if defined(SUNDIALS_F77_FUNC) #define FNV_INITS SUNDIALS_F77_FUNC(fnvinits, FNVINITS) #else #define FNV_INITS fnvinits_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITS_Q SUNDIALS_F77_FUNC_(fnvinits_q, FNVINITS_Q) #define FNV_INITS_S SUNDIALS_F77_FUNC_(fnvinits_s, FNVINITS_S) #define FNV_INITS_B SUNDIALS_F77_FUNC_(fnvinits_b, FNVINITS_B) #define FNV_INITS_QB SUNDIALS_F77_FUNC_(fnvinits_qb, FNVINITS_QB) #else #define FNV_INITS_Q fnvinits_q_ #define FNV_INITS_S fnvinits_s_ #define FNV_INITS_B fnvinits_b_ #define FNV_INITS_QB fnvinits_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; /* * Prototypes of exported functions * * FNV_INITS - initializes serial vector operations for main problem * FNV_INITS_Q - initializes serial vector operations for quadratures * FNV_INITS_S - initializes serial vector operations for sensitivities * FNV_INITS_B - initializes serial vector operations for adjoint problem * FNV_INITS_QB - initializes serial vector operations for adjoint quadratures * */ void FNV_INITS(int *code, long int *neq, int *ier); void FNV_INITS_Q(int *code, long int *Nq, int *ier); void FNV_INITS_S(int *code, int *Ns, int *ier); void FNV_INITS_B(int *code, long int *NB, int *ier); void FNV_INITS_QB(int *code, long int *NqB, int *ier); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/nvec_ser/fnvector_serial.c0000600000175000017500000000655111741421110022135 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:37 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file (companion of nvector_serial.h) contains the * implementation needed for the Fortran initialization of serial * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_serial.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; /* Fortran callable interfaces */ void FNV_INITS(int *code, long int *N, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_Serial(*N); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_Serial(*N); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_Serial(*N); if (F2C_KINSOL_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_Q(int *code, long int *Nq, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_Serial(*Nq); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_Serial(*Nq); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_B(int *code, long int *NB, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_Serial(*NB); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_Serial(*NB); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_QB(int *code, long int *NqB, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_Serial(*NqB); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_Serial(*NqB); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } sundials-2.5.0/src/nvec_ser/nvector_serial.c0000600000175000017500000005045211741421110021766 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/07/05 15:32:37 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a serial implementation * of the NVECTOR package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private function prototypes */ /* z=x */ static void VCopy_Serial(N_Vector x, N_Vector z); /* z=x+y */ static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z); /* z=-x */ static void VNeg_Serial(N_Vector x, N_Vector z); /* z=c(x+y) */ static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); /* y <- ax+y */ static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); /* x <- ax */ static void VScaleBy_Serial(realtype a, N_Vector x); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new empty serial vector */ N_Vector N_VNewEmpty_Serial(long int length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Serial content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvclone = N_VClone_Serial; ops->nvcloneempty = N_VCloneEmpty_Serial; ops->nvdestroy = N_VDestroy_Serial; ops->nvspace = N_VSpace_Serial; ops->nvgetarraypointer = N_VGetArrayPointer_Serial; ops->nvsetarraypointer = N_VSetArrayPointer_Serial; ops->nvlinearsum = N_VLinearSum_Serial; ops->nvconst = N_VConst_Serial; ops->nvprod = N_VProd_Serial; ops->nvdiv = N_VDiv_Serial; ops->nvscale = N_VScale_Serial; ops->nvabs = N_VAbs_Serial; ops->nvinv = N_VInv_Serial; ops->nvaddconst = N_VAddConst_Serial; ops->nvdotprod = N_VDotProd_Serial; ops->nvmaxnorm = N_VMaxNorm_Serial; ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; ops->nvwrmsnorm = N_VWrmsNorm_Serial; ops->nvmin = N_VMin_Serial; ops->nvwl2norm = N_VWL2Norm_Serial; ops->nvl1norm = N_VL1Norm_Serial; ops->nvcompare = N_VCompare_Serial; ops->nvinvtest = N_VInvTest_Serial; ops->nvconstrmask = N_VConstrMask_Serial; ops->nvminquotient = N_VMinQuotient_Serial; /* Create content */ content = NULL; content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = length; content->own_data = FALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Function to create a new serial vector */ N_Vector N_VNew_Serial(long int length) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_Serial(length); if (v == NULL) return(NULL); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } /* Attach data */ NV_OWN_DATA_S(v) = TRUE; NV_DATA_S(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create a serial N_Vector with user data component */ N_Vector N_VMake_Serial(long int length, realtype *v_data) { N_Vector v; v = NULL; v = N_VNewEmpty_Serial(length); if (v == NULL) return(NULL); if (length > 0) { /* Attach data */ NV_OWN_DATA_S(v) = FALSE; NV_DATA_S(v) = v_data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create an array of new serial vectors. */ N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Serial(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Serial(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to create an array of new serial vectors with NULL data array. */ N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Serial(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Serial(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Serial */ void N_VDestroyVectorArray_Serial(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Serial(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------------------- * Function to print the a serial vector */ void N_VPrint_Serial(N_Vector x) { long int i, N; realtype *xd; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%11.8Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%11.8lg\n", xd[i]); #else printf("%11.8g\n", xd[i]); #endif } printf("\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Serial(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Serial content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* Create content */ content = NULL; content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = NV_LENGTH_S(w); content->own_data = FALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VClone_Serial(N_Vector w) { N_Vector v; realtype *data; long int length; v = NULL; v = N_VCloneEmpty_Serial(w); if (v == NULL) return(NULL); length = NV_LENGTH_S(w); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } /* Attach data */ NV_OWN_DATA_S(v) = TRUE; NV_DATA_S(v) = data; } return(v); } void N_VDestroy_Serial(N_Vector v) { if (NV_OWN_DATA_S(v) == TRUE) { free(NV_DATA_S(v)); NV_DATA_S(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Serial(N_Vector v, long int *lrw, long int *liw) { *lrw = NV_LENGTH_S(v); *liw = 1; return; } realtype *N_VGetArrayPointer_Serial(N_Vector v) { return((realtype *) NV_DATA_S(v)); } void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) { if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; return; } void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { long int i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_Serial(a,x,y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_Serial(b,y,x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_Serial(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_Serial(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_Serial(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_Serial(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_Serial(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_Serial(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } void N_VConst_Serial(realtype c, N_Vector z) { long int i, N; realtype *zd; zd = NULL; N = NV_LENGTH_S(z); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c; return; } void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Serial(c, x); return; } if (c == ONE) { VCopy_Serial(x, z); } else if (c == -ONE) { VNeg_Serial(x, z); } else { N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c*xd[i]; } return; } void N_VAbs_Serial(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = ABS(xd[i]); return; } void N_VInv_Serial(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]+b; return; } realtype N_VDotProd_Serial(N_Vector x, N_Vector y) { long int i, N; realtype sum, *xd, *yd; sum = ZERO; xd = yd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); for (i = 0; i < N; i++) sum += xd[i]*yd[i]; return(sum); } realtype N_VMaxNorm_Serial(N_Vector x) { long int i, N; realtype max, *xd; max = ZERO; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i < N; i++) { if (ABS(xd[i]) > max) max = ABS(xd[i]); } return(max); } realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) { long int i, N; realtype sum, prodi, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } return(RSqrt(sum/N)); } realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) { long int i, N; realtype sum, prodi, *xd, *wd, *idd; sum = ZERO; xd = wd = idd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); idd = NV_DATA_S(id); for (i = 0; i < N; i++) { if (idd[i] > ZERO) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } } return(RSqrt(sum / N)); } realtype N_VMin_Serial(N_Vector x) { long int i, N; realtype min, *xd; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); min = xd[0]; for (i = 1; i < N; i++) { if (xd[i] < min) min = xd[i]; } return(min); } realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) { long int i, N; realtype sum, prodi, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SQR(prodi); } return(RSqrt(sum)); } realtype N_VL1Norm_Serial(N_Vector x) { long int i, N; realtype sum, *xd; sum = ZERO; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i= c) ? ONE : ZERO; } return; } booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) { if (xd[i] == ZERO) return(FALSE); zd[i] = ONE/xd[i]; } return(TRUE); } booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) { long int i, N; booleantype test; realtype *cd, *xd, *md; cd = xd = md = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); cd = NV_DATA_S(c); md = NV_DATA_S(m); test = TRUE; for (i = 0; i < N; i++) { md[i] = ZERO; if (cd[i] == ZERO) continue; if (cd[i] > ONEPT5 || cd[i] < -ONEPT5) { if ( xd[i]*cd[i] <= ZERO) { test = FALSE; md[i] = ONE; } continue; } if ( cd[i] > HALF || cd[i] < -HALF) { if (xd[i]*cd[i] < ZERO ) { test = FALSE; md[i] = ONE; } } } return(test); } realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) { booleantype notEvenOnce; long int i, N; realtype *nd, *dd, min; nd = dd = NULL; N = NV_LENGTH_S(num); nd = NV_DATA_S(num); dd = NV_DATA_S(denom); notEvenOnce = TRUE; min = BIG_REAL; for (i = 0; i < N; i++) { if (dd[i] == ZERO) continue; else { if (!notEvenOnce) min = MIN(min, nd[i]/dd[i]); else { min = nd[i]/dd[i]; notEvenOnce = FALSE; } } } return(min); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ static void VCopy_Serial(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]; return; } static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]+yd[i]; return; } static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]-yd[i]; return; } static void VNeg_Serial(N_Vector x, N_Vector z) { long int i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = -xd[i]; return; } static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c*(xd[i]+yd[i]); return; } static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c*(xd[i]-yd[i]); return; } static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+yd[i]; return; } static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z) { long int i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])-yd[i]; return; } static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y) { long int i, N; realtype *xd, *yd; xd = yd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); if (a == ONE) { for (i = 0; i < N; i++) yd[i] += xd[i]; return; } if (a == -ONE) { for (i = 0; i < N; i++) yd[i] -= xd[i]; return; } for (i = 0; i < N; i++) yd[i] += a*xd[i]; return; } static void VScaleBy_Serial(realtype a, N_Vector x) { long int i, N; realtype *xd; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i < N; i++) xd[i] *= a; return; } sundials-2.5.0/src/nvec_ser/README0000600000175000017500000001055711741421110017465 0ustar sylvestresylvestre NVECTOR_SERIAL Release 2.5.0, March 2012 Serial implementation of the NVECTOR module for SUNDIALS. NVECTOR_SERIAL defines the content field of N_Vector to be a structure containing the length of the vector, a pointer to the beginning of a contiguous data array, and a boolean flag indicating ownership of the data array. NVECTOR_SERIAL defines five macros to provide access to the content of a serial N_Vector, several constructors for variables of type N_Vector, a constructor for an array of variables of type N_Vector, and destructors for N_Vector and N_Vector array. NVECTOR_SERIAL provides implementations for all vector operations defined by the generic NVECTOR module in the table of operations. A. Documentation ---------------- The serial NVECTOR implementation is fully described in the user documentation for any of the SUNDIALS solvers [1-5]. A PDF file for the user guide for a particular solver is available in the solver's subdirectory under doc/. B. Installation --------------- For basic installation instructions see /sundials/INSTALL_NOTES. For complete installation instructions see any of the user guides. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODE v2.7.0," LLNL technical report UCRL-MA-208108, December 2011. [2] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.7.0," LLNL technical report UCRL-MA-208111, December 2011. [3] A. C. Hindmarsh and R. Serban, "User Documentation for IDA v2.7.0," LLNL technical report UCRL-MA-208112, December 2011. [4] R. Serban and C. Petra, "User Documentation for IDAS v1.1.0," LLNL technical report UCRL-SM-234051, December 2011. [5] A. M. Collier, A. C. Hindmarsh, R. Serban,and C. S. Woodward, "User Documentation for KINSOL v2.7.0," LLNL technical report UCRL-MA-208116, December 2011. D. Releases ----------- v. 2.5.0 - Mar. 2012 v. 2.4.0 - May 2009 v. 2.3.0 - Nov. 2006 v. 2.2.0 - Mar. 2006 v. 2.1.1 - May 2005 v. 2.1.0 - Apr. 2005 v. 2.0.2 - Mar. 2005 v. 2.0.1 - Jan. 2005 v. 2.0 - Dec. 2004 v. 1.0 - Jul. 2002 (first SUNDIALS release) E. Revision History ------------------- v. 2.4.0 (May 2009) ---> v. 2.5.0 (Mar. 2012) --------------------------------------------- - Bug fix: - consistently updated to using SUNDIALS_F77_FUNC in fcmix header files. v. 2.3.0 (Nov. 2006) ---> v. 2.4.0 (May 2009) --------------------------------------------- - none v. 2.2.0 (Mar. 2006) ---> v. 2.3.0 (Nov. 2006) ---------------------------------------------- - Changes related to the build system - reorganized source tree. Header files in ${srcdir}/include/nvector; sources in ${srcdir}/src/nvec_ser - exported header files in ${includedir}/sundials v. 2.1.1 (May 2005) ---> v. 2.2.0 (Mar. 2006) --------------------------------------------- - none v. 2.1.0 (Apr. 2005) ---> v. 2.1.1 (May 2005) --------------------------------------------- - Changes to data structures - added N_VCloneEmpty to global vector operations table v. 2.0.2 (Mar. 2005) ---> v. 2.1.0 (Apr. 2005) ---------------------------------------------- - none v. 2.0.1 (Jan. 2005) ---> v. 2.0.2 (Mar. 2005) ---------------------------------------------- - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.0 (Dec. 2004) ---> v. 2.0.1 (Jan. 2005) -------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 1.0 (Jul. 2002) ---> v. 2.0 (Dec. 2004) ------------------------------------------ - Revised to correspond to new generic NVECTOR module (see sundials/shared/README). - Extended the list of user-callable functions provided by NVECTOR_SERIAL outside the table of vector operations. - Revised the F/C interface to use underscore flags for name mapping and to use precision flag from configure. - Revised F/C routine NVECTOR names for uniformity. sundials-2.5.0/src/kinsol/0000755000175000017500000000000011767174700016322 5ustar sylvestresylvestresundials-2.5.0/src/kinsol/kinsol_dense.c0000600000175000017500000002336711741421272021135 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINDENSE linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_direct_impl.h" #include "kinsol_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* KINDENSE linit, lsetup, lsolve, and lfree routines */ static int kinDenseInit(KINMem kin_mem); static int kinDenseSetup(KINMem kin_mem); static int kinDenseSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm); static void kinDenseFree(KINMem kin_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define lrw1 (kin_mem->kin_lrw1) #define liw1 (kin_mem->kin_liw1) #define func (kin_mem->kin_func) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define mtype (kindls_mem->d_type) #define n (kindls_mem->d_n) #define ml (kindls_mem->d_ml) #define mu (kindls_mem->d_mu) #define smu (kindls_mem->d_smu) #define jacDQ (kindls_mem->d_jacDQ) #define djac (kindls_mem->d_djac) #define J (kindls_mem->d_J) #define lpivots (kindls_mem->d_lpivots) #define nje (kindls_mem->d_nje) #define nfeDQ (kindls_mem->d_nfeDQ) #define J_data (kindls_mem->d_J_data) #define last_flag (kindls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * KINDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the dense linear solver module. * KINDense sets the kin_linit, kin_lsetup, kin_lsolve, kin_lfree fields * in *kinmem to be kinDenseInit, kinDenseSetup, kinDenseSolve, and * kinDenseFree, respectively. * It allocates memory for a structure of type KINDlsMemRec and sets * the kin_lmem field in *kinmem to the address of this structure. * It sets setupNonNull in *kinmem to TRUE, and the djac field to the * default kinDlsDenseDQJac. * Finally, it allocates memory for J and lpivots. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, KINDense will first * test for compatible a compatible N_Vector internal * representation by checking that N_VGetArrayPointer and * N_VSetArrayPointer exist. * ----------------------------------------------------------------- */ int KINDense(void *kinmem, long int N) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDENSE", "KINDense", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINDENSE", "KINDense", MSGD_BAD_NVECTOR); return(KINDLS_ILL_INPUT); } if (lfree !=NULL) lfree(kin_mem); /* Set four main function fields in kin_mem */ linit = kinDenseInit; lsetup = kinDenseSetup; lsolve = kinDenseSolve; lfree = kinDenseFree; /* Get memory for KINDlsMemRec */ kindls_mem = NULL; kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec)); if (kindls_mem == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINDENSE", "KINDense", MSGD_MEM_FAIL); return(KINDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = KINDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = N; /* Allocate memory for J and pivot array */ J = NULL; J = NewDenseMat(N, N); if (J == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINDENSE", "KINDense", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINDENSE", "KINDense", MSGD_MEM_FAIL); DestroyMat(J); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } /* This is a direct linear solver */ inexact_ls = FALSE; /* Attach linear solver memory to integrator memory */ lmem = kindls_mem; return(KINDLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * kinDenseInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the dense * linear solver. * ----------------------------------------------------------------- */ static int kinDenseInit(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; nje = 0; nfeDQ = 0; if (jacDQ) { djac = kinDlsDenseDQJac; J_data = kin_mem; } else { J_data = kin_mem->kin_user_data; } last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinDenseSetup * ----------------------------------------------------------------- * This routine does the setup operations for the dense linear solver. * It calls the dense LU factorization routine. * ----------------------------------------------------------------- */ static int kinDenseSetup(KINMem kin_mem) { KINDlsMem kindls_mem; int retval; long int ier; kindls_mem = (KINDlsMem) lmem; nje++; SetToZero(J); retval = djac(n, uu, fval, J, J_data, vtemp1, vtemp2); if (retval != 0) { last_flag = -1; return(-1); } /* Do LU factorization of J */ ier = DenseGETRF(J, lpivots); /* Return 0 if the LU was complete; otherwise return -1 */ last_flag = ier; if (ier > 0) return(-1); return(0); } /* * ----------------------------------------------------------------- * kinDenseSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the dense linear solver * by calling the dense backsolve routine. The returned value is 0. * ----------------------------------------------------------------- */ static int kinDenseSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm) { KINDlsMem kindls_mem; realtype *xd; kindls_mem = (KINDlsMem) lmem; /* Copy the right-hand side into x */ N_VScale(ONE, b, x); xd = N_VGetArrayPointer(x); /* Back-solve and get solution in x */ DenseGETRS(J, lpivots, xd); /* Compute the terms Jpnorm and sfdotJp for use in the global strategy routines and in KINForcingTerm. Both of these terms are subsequently corrected if the step is reduced by constraints or the line search. sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p. sfdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale. */ sJpnorm = N_VWL2Norm(b,fscale); N_VProd(b, fscale, b); N_VProd(b, fscale, b); sfdotJp = N_VDotProd(fval, b); last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinDenseFree * ----------------------------------------------------------------- * This routine frees memory specific to the dense linear solver. * ----------------------------------------------------------------- */ static void kinDenseFree(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; DestroyMat(J); DestroyArray(lpivots); free(kindls_mem); kindls_mem = NULL; } sundials-2.5.0/src/kinsol/kinsol_spbcgs.c0000600000175000017500000003125311741421272021311 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2007/11/26 16:20:01 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2004, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINSOL interface to the * scaled, preconditioned Bi-CGSTAB (SPBCG) iterative linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_impl.h" #include #include "kinsol_spils_impl.h" #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ----------------------------------------------------------------- * function prototypes * ----------------------------------------------------------------- */ /* KINSpbcg linit, lsetup, lsolve, and lfree routines */ static int KINSpbcgInit(KINMem kin_mem); static int KINSpbcgSetup(KINMem kin_mem); static int KINSpbcgSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm); static void KINSpbcgFree(KINMem kin_mem); /* * ----------------------------------------------------------------- * readability replacements * ----------------------------------------------------------------- */ #define nni (kin_mem->kin_nni) #define nnilset (kin_mem->kin_nnilset) #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define eps (kin_mem->kin_eps) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define pretype (kinspils_mem->s_pretype) #define nli (kinspils_mem->s_nli) #define npe (kinspils_mem->s_npe) #define nps (kinspils_mem->s_nps) #define ncfl (kinspils_mem->s_ncfl) #define njtimes (kinspils_mem->s_njtimes) #define nfes (kinspils_mem->s_nfes) #define new_uu (kinspils_mem->s_new_uu) #define spils_mem (kinspils_mem->s_spils_mem) #define jtimesDQ (kinspils_mem->s_jtimesDQ) #define jtimes (kinspils_mem->s_jtimes) #define J_data (kinspils_mem->s_J_data) #define last_flag (kinspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : KINSpbcg * ----------------------------------------------------------------- * This routine allocates and initializes the memory record and * sets function fields specific to the SPBCG linear solver module. * KINSpbcg sets the kin_linit, kin_lsetup, kin_lsolve, and * kin_lfree fields in *kinmem to be KINSpbcgInit, KINSpbcgSetup, * KINSpbcgSolve, and KINSpbcgFree, respectively. It allocates * memory for a structure of type KINSpilsMemRec and sets the * kin_lmem field in *kinmem to the address of this structure. It * also calls SpbcgMalloc to allocate memory for the module * SPBCG. It sets setupNonNull in (*kin_mem) and sets various * fields in the KINSpilsMemRec structure. * Finally, KINSpbcg allocates memory for local vectors, and calls * SpbcgMalloc to allocate memory for the Spbcg solver. * ----------------------------------------------------------------- */ int KINSpbcg(void *kinmem, int maxl) { KINMem kin_mem; KINSpilsMem kinspils_mem; SpbcgMem spbcg_mem; int maxl1; if (kinmem == NULL){ KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpbcg", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check for required vector operations */ /* Note: do NOT need to check for N_VLinearSum, N_VProd, N_VScale, N_VDiv, or N_VWL2Norm because they are required by KINSOL */ if ((vec_tmpl->ops->nvconst == NULL) || (vec_tmpl->ops->nvdotprod == NULL) || (vec_tmpl->ops->nvl1norm == NULL)) { KINProcessError(NULL, KINSPILS_ILL_INPUT, "KINSPILS", "KINSpbcg", MSGS_BAD_NVECTOR); return(KINSPILS_ILL_INPUT); } if (lfree != NULL) lfree(kin_mem); /* set four main function fields in kin_mem */ linit = KINSpbcgInit; lsetup = KINSpbcgSetup; lsolve = KINSpbcgSolve; lfree = KINSpbcgFree; /* get memory for KINSpilsMemRec */ kinspils_mem = NULL; kinspils_mem = (KINSpilsMem) malloc(sizeof(struct KINSpilsMemRec)); if (kinspils_mem == NULL){ KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpbcg", MSGS_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* Set ILS type */ kinspils_mem->s_type = SPILS_SPBCG; /* set SPBCG parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? KINSPILS_MAXL : maxl; kinspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; J_data = NULL; /* Set defaults for preconditioner-related fields */ kinspils_mem->s_pset = NULL; kinspils_mem->s_psolve = NULL; kinspils_mem->s_pfree = NULL; kinspils_mem->s_P_data = kin_mem->kin_user_data; /* Set default values for the rest of the SPBCG parameters */ kinspils_mem->s_pretype = PREC_NONE; kinspils_mem->s_last_flag = KINSPILS_SUCCESS; /* Call SpbcgMalloc to allocate workspace for SPBCG */ /* vec_tmpl passed as template vector */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl); if (spbcg_mem == NULL) { KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpbcg", MSGS_MEM_FAIL); free(kinspils_mem); kinspils_mem = NULL; return(KINSPILS_MEM_FAIL); } /* This is an iterative linear solver */ inexact_ls = TRUE; /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *) spbcg_mem; /* attach linear solver memory to KINSOL memory */ lmem = kinspils_mem; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * additional readability replacements * ----------------------------------------------------------------- */ #define maxl (kinspils_mem->s_maxl) #define pset (kinspils_mem->s_pset) #define psolve (kinspils_mem->s_psolve) #define P_data (kinspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : KINSpbcgInit * ----------------------------------------------------------------- * This routine initializes variables associated with the SPBCG * iterative linear solver. Mmemory allocation was done previously * in KINSpbcg. * ----------------------------------------------------------------- */ static int KINSpbcgInit(KINMem kin_mem) { KINSpilsMem kinspils_mem; SpbcgMem spbcg_mem; kinspils_mem = (KINSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nfes = 0; /* set preconditioner type */ if (psolve != NULL) { pretype = PREC_RIGHT; } else { pretype = PREC_NONE; } /* set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = ((psolve != NULL) && (pset != NULL)); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = KINSpilsDQJtimes; J_data = kin_mem; } else { J_data = user_data; } /* Set maxl in the SPBCG memory in case it was changed by the user */ spbcg_mem->l_max = maxl; last_flag = KINSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : KINSpbcgSetup * ----------------------------------------------------------------- * This routine does the setup operations for the SPBCG linear * solver, that is, it is an interface to the user-supplied * routine pset. * ----------------------------------------------------------------- */ static int KINSpbcgSetup(KINMem kin_mem) { KINSpilsMem kinspils_mem; int ret; kinspils_mem = (KINSpilsMem) lmem; /* call pset routine */ ret = pset(uu, uscale, fval, fscale, P_data, vtemp1, vtemp2); last_flag = ret; npe++; nnilset = nni; /* return the same value ret that pset returned */ return(ret); } /* * ----------------------------------------------------------------- * Function : KINSpbcgSolve * ----------------------------------------------------------------- * This routine handles the call to the generic SPBCG solver routine * called SpbcgSolve for the solution of the linear system Ax = b. * * Appropriate variables are passed to SpbcgSolve and the counters * nli, nps, and ncfl are incremented, and the return value is set * according to the success of SpbcgSolve. The success flag is * returned if SpbcgSolve converged, or if the residual was reduced. * Of the other error conditions, only preconditioner solver * failure is specifically returned. Otherwise a generic flag is * returned to denote failure of this routine. * ----------------------------------------------------------------- */ static int KINSpbcgSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm) { KINSpilsMem kinspils_mem; SpbcgMem spbcg_mem; int ret, nli_inc, nps_inc; kinspils_mem = (KINSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; /* Set initial guess to xx = 0. bb is set, by the routine calling KINSpbcgSolve, to the RHS vector for the system to be solved. */ N_VConst(ZERO, xx); new_uu = TRUE; /* set flag required for user Jacobian routine */ /* call SpbcgSolve */ ret = SpbcgSolve(spbcg_mem, kin_mem, xx, bb, pretype, eps, kin_mem, fscale, fscale, KINSpilsAtimes, KINSpilsPSolve, res_norm, &nli_inc, &nps_inc); /* increment counters nli, nps, and ncfl (nni is updated in the KINSol main iteration loop) */ nli = nli + (long int) nli_inc; nps = nps + (long int) nps_inc; if (printfl > 2) KINPrintInfo(kin_mem, PRNT_NLI, "KINSPBCG", "KINSpbcgSolve", INFO_NLI, nli_inc); if (ret != 0) ncfl++; /* Compute the terms sJpnorm and sfdotJp for use in the global strategy routines and in KINForcingTerm. Both of these terms are subsequently corrected if the step is reduced by constraints or the line search. sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p. sfdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale. */ ret = KINSpilsAtimes(kin_mem, xx, bb); if (ret == 0) ret = SPBCG_SUCCESS; else if (ret > 0) ret = SPBCG_ATIMES_FAIL_REC; else if (ret < 0) ret = SPBCG_ATIMES_FAIL_UNREC; sJpnorm = N_VWL2Norm(bb,fscale); N_VProd(bb, fscale, bb); N_VProd(bb, fscale, bb); sfdotJp = N_VDotProd(fval, bb); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_EPS, "KINSPBCG", "KINSpbcgSolve", INFO_EPS, *res_norm, eps); /* Interpret return value from SpbcgSolve */ last_flag = ret; switch(ret) { case SPBCG_SUCCESS: case SPBCG_RES_REDUCED: return(0); break; case SPBCG_PSOLVE_FAIL_REC: case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_CONV_FAIL: case SPBCG_MEM_NULL: case SPBCG_ATIMES_FAIL_UNREC: case SPBCG_PSOLVE_FAIL_UNREC: return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : KINSpbcgFree * ----------------------------------------------------------------- * Frees memory specific to the SPBCG linear solver module. * ----------------------------------------------------------------- */ static void KINSpbcgFree(KINMem kin_mem) { KINSpilsMem kinspils_mem; SpbcgMem spbcg_mem; kinspils_mem = (KINSpilsMem) lmem; spbcg_mem = (SpbcgMem) spils_mem; SpbcgFree(spbcg_mem); if (kinspils_mem->s_pfree != NULL) (kinspils_mem->s_pfree)(kin_mem); free(kinspils_mem); kinspils_mem = NULL; } sundials-2.5.0/src/kinsol/kinsol.c0000600000175000017500000014735311741421272017761 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2011/07/13 22:29:01 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the main KINSol solver. * It is independent of the KINSol linear solver in use. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * Creation and allocation functions * KINCreate * KINInit * Main solver function * KINSol * Deallocation function * KINFree * * PRIVATE FUNCTIONS * ----------------- * KINCheckNvector * Memory allocation/deallocation * KINAllocVectors * KINFreeVectors * Initial setup * KINSolInit * Step functions * KINLinSolDrv * KINFullNewton * KINLineSearch * KINConstraint * Stopping tests * KINStop * KINForcingTerm * Norm functions * KINScFNorm * KINScSNorm * KINSOL Verbose output functions * KINPrintInfo * KINInfoHandler * KINSOL Error Handling functions * KINProcessError * KINErrHandler * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include #include "kinsol_impl.h" #include /* * ================================================================= * MACRO DEFINITIONS * ================================================================= */ /* Macro: loop */ #define loop for(;;) /* * ================================================================= * KINSOL PRIVATE CONSTANTS * ================================================================= */ #define HALF RCONST(0.5) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) #define TWO RCONST(2.0) #define THREE RCONST(3.0) #define FIVE RCONST(5.0) #define TWELVE RCONST(12.0) #define POINT1 RCONST(0.1) #define POINT01 RCONST(0.01) #define POINT99 RCONST(0.99) #define THOUSAND RCONST(1000.0) #define ONETHIRD RCONST(0.3333333333333333) #define TWOTHIRDS RCONST(0.6666666666666667) #define POINT9 RCONST(0.9) #define POINT0001 RCONST(0.0001) /* * ================================================================= * KINSOL ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by KINSol * ---------------------------------------------------------- * * KINStop return value requesting more iterations * RETRY_ITERATION * CONTINUE_ITERATIONS * * KINFullNewton and KINLineSearch return values: * KIN_SUCCESS * KIN_SYSFUNC_FAIL * STEP_TOO_SMALL * * KINConstraint return values: * KIN_SUCCESS * CONSTR_VIOLATED */ #define RETRY_ITERATION -998 #define CONTINUE_ITERATIONS -999 #define STEP_TOO_SMALL -997 #define CONSTR_VIOLATED -996 /* * Algorithmic constants * --------------------- * * MAX_RECVR max. no. of attempts to correct a recoverable func error */ #define MAX_RECVR 5 /* * Keys for KINPrintInfo * --------------------- */ #define PRNT_RETVAL 1 #define PRNT_NNI 2 #define PRNT_TOL 3 #define PRNT_FMAX 4 #define PRNT_PNORM 5 #define PRNT_PNORM1 6 #define PRNT_FNORM 7 #define PRNT_LAM 8 #define PRNT_ALPHA 9 #define PRNT_BETA 10 #define PRNT_ALPHABETA 11 #define PRNT_ADJ 12 /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype KINCheckNvector(N_Vector tmpl); static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl); static int KINSolInit(KINMem kin_mem, int strategy); static int KINConstraint(KINMem kin_mem ); static void KINForcingTerm(KINMem kin_mem, realtype fnormp); static void KINFreeVectors(KINMem kin_mem); static int KINFullNewton(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken); static int KINLineSearch(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken); static int KINLinSolDrv(KINMem kinmem); static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale); static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u); static int KINStop(KINMem kin_mem, int strategy, booleantype maxStepTaken, int sflag); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation and allocation functions * ----------------------------------------------------------------- */ /* * Function : KINCreate * * KINCreate creates an internal memory block for a problem to * be solved by KINSOL. If successful, KINCreate returns a pointer * to the problem memory. This pointer should be passed to * KINInit. If an initialization error occurs, KINCreate prints * an error message to standard error and returns NULL. */ void *KINCreate(void) { KINMem kin_mem; realtype uround; kin_mem = NULL; kin_mem = (KINMem) malloc(sizeof(struct KINMemRec)); if (kin_mem == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINCreate", MSG_MEM_FAIL); return(NULL); } /* Zero out kin_mem */ memset(kin_mem, 0, sizeof(struct KINMemRec)); /* set uround (unit roundoff) */ kin_mem->kin_uround = uround = UNIT_ROUNDOFF; /* set default values for solver optional inputs */ kin_mem->kin_func = NULL; kin_mem->kin_user_data = NULL; kin_mem->kin_constraints = NULL; kin_mem->kin_uscale = NULL; kin_mem->kin_fscale = NULL; kin_mem->kin_constraintsSet = FALSE; kin_mem->kin_ehfun = KINErrHandler; kin_mem->kin_eh_data = kin_mem; kin_mem->kin_errfp = stderr; kin_mem->kin_ihfun = KINInfoHandler; kin_mem->kin_ih_data = kin_mem; kin_mem->kin_infofp = stdout; kin_mem->kin_printfl = PRINTFL_DEFAULT; kin_mem->kin_mxiter = MXITER_DEFAULT; kin_mem->kin_noInitSetup = FALSE; kin_mem->kin_msbset = MSBSET_DEFAULT; kin_mem->kin_noResMon = FALSE; kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; kin_mem->kin_update_fnorm_sub = FALSE; kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; kin_mem->kin_sthrsh = TWO; kin_mem->kin_noMinEps = FALSE; kin_mem->kin_mxnewtstep = ZERO; kin_mem->kin_sqrt_relfunc = RSqrt(uround); kin_mem->kin_scsteptol = RPowerR(uround,TWOTHIRDS); kin_mem->kin_fnormtol = RPowerR(uround,ONETHIRD); kin_mem->kin_etaflag = KIN_ETACHOICE1; kin_mem->kin_eta = POINT1; /* default for KIN_ETACONSTANT */ kin_mem->kin_eta_alpha = TWO; /* default for KIN_ETACHOICE2 */ kin_mem->kin_eta_gamma = POINT9; /* default for KIN_ETACHOICE2 */ kin_mem->kin_MallocDone = FALSE; kin_mem->kin_setupNonNull = FALSE; kin_mem->kin_eval_omega = TRUE; kin_mem->kin_omega = ZERO; /* default to using min/max */ kin_mem->kin_omega_min = OMEGA_MIN; kin_mem->kin_omega_max = OMEGA_MAX; /* initialize lrw and liw */ kin_mem->kin_lrw = 17; kin_mem->kin_liw = 22; /* NOTE: needed since KINInit could be called after KINSetConstraints */ kin_mem->kin_lrw1 = 0; kin_mem->kin_liw1 = 0; return((void *) kin_mem); } #define errfp (kin_mem->kin_errfp) #define liw (kin_mem->kin_liw) #define lrw (kin_mem->kin_lrw) /* * Function : KINInit * * KINInit allocates memory for a problem or execution of KINSol. * If memory is successfully allocated, KIN_SUCCESS is returned. * Otherwise, an error message is printed and an error flag * returned. */ int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl) { long int liw1, lrw1; KINMem kin_mem; booleantype allocOK, nvectorOK; /* check kinmem */ if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINInit", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (func == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_FUNC_NULL); return(KIN_ILL_INPUT); } /* check if all required vector operations are implemented */ nvectorOK = KINCheckNvector(tmpl); if (!nvectorOK) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_BAD_NVECTOR); return(KIN_ILL_INPUT); } /* set space requirements for one N_Vector */ if (tmpl->ops->nvspace != NULL) { N_VSpace(tmpl, &lrw1, &liw1); kin_mem->kin_lrw1 = lrw1; kin_mem->kin_liw1 = liw1; } else { kin_mem->kin_lrw1 = 0; kin_mem->kin_liw1 = 0; } /* allocate necessary vectors */ allocOK = KINAllocVectors(kin_mem, tmpl); if (!allocOK) { KINProcessError(kin_mem, KIN_MEM_FAIL, "KINSOL", "KINInit", MSG_MEM_FAIL); free(kin_mem); kin_mem = NULL; return(KIN_MEM_FAIL); } /* copy the input parameter into KINSol state */ kin_mem->kin_func = func; /* set the linear solver addresses to NULL */ kin_mem->kin_linit = NULL; kin_mem->kin_lsetup = NULL; kin_mem->kin_lsolve = NULL; kin_mem->kin_lfree = NULL; kin_mem->kin_lmem = NULL; /* problem memory has been successfully allocated */ kin_mem->kin_MallocDone = TRUE; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Readability constants * ----------------------------------------------------------------- */ #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define mxiter (kin_mem->kin_mxiter) #define noInitSetup (kin_mem->kin_noInitSetup) #define retry_nni (kin_mem->kin_retry_nni) #define msbset (kin_mem->kin_msbset) #define etaflag (kin_mem->kin_etaflag) #define eta (kin_mem->kin_eta) #define ealpha (kin_mem->kin_eta_alpha) #define egamma (kin_mem->kin_eta_gamma) #define noMinEps (kin_mem->kin_noMinEps) #define mxnewtstep (kin_mem->kin_mxnewtstep) #define mxnbcf (kin_mem->kin_mxnbcf) #define relfunc (kin_mem->kin_sqrt_relfunc) #define fnormtol (kin_mem->kin_fnormtol) #define scsteptol (kin_mem->kin_scsteptol) #define constraints (kin_mem->kin_constraints) #define uround (kin_mem->kin_uround) #define nni (kin_mem->kin_nni) #define nfe (kin_mem->kin_nfe) #define nbcf (kin_mem->kin_nbcf) #define nbktrk (kin_mem->kin_nbktrk) #define ncscmx (kin_mem->kin_ncscmx) #define stepl (kin_mem->kin_stepl) #define stepmul (kin_mem->kin_stepmul) #define sthrsh (kin_mem->kin_sthrsh) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define constraintsSet (kin_mem->kin_constraintsSet) #define jacCurrent (kin_mem->kin_jacCurrent) #define nnilset (kin_mem->kin_nnilset) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define setupNonNull (kin_mem->kin_setupNonNull) #define fval (kin_mem->kin_fval) #define fnorm (kin_mem->kin_fnorm) #define f1norm (kin_mem->kin_f1norm) #define etaflag (kin_mem->kin_etaflag) #define callForcingTerm (kin_mem->kin_callForcingTerm) #define uu (kin_mem->kin_uu) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define unew (kin_mem->kin_unew) #define pp (kin_mem->kin_pp) #define vtemp1 (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define eps (kin_mem->kin_eps) #define res_norm (kin_mem->kin_res_norm) #define liw1 (kin_mem->kin_liw1) #define lrw1 (kin_mem->kin_lrw1) #define noResMon (kin_mem->kin_noResMon) #define fnorm_sub (kin_mem->kin_fnorm_sub) #define msbset_sub (kin_mem->kin_msbset_sub) #define nnilset_sub (kin_mem->kin_nnilset_sub) #define update_fnorm_sub (kin_mem->kin_update_fnorm_sub) #define eval_omega (kin_mem->kin_eval_omega) #define omega (kin_mem->kin_omega) #define omega_min (kin_mem->kin_omega_min) #define omega_max (kin_mem->kin_omega_max) /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * Function : KINSol * * KINSol (main KINSOL driver routine) manages the computational * process of computing an approximate solution of the nonlinear * system F(uu) = 0. The KINSol routine calls the following * subroutines: * * KINSolInit checks if initial guess satisfies user-supplied * constraints and initializes linear solver * * KINLinSolDrv interfaces with linear solver to find a * solution of the system J(uu)*x = b (calculate * Newton step) * * KINFullNewton/KINLineSearch implement the global strategy * * KINForcingTerm computes the forcing term (eta) * * KINStop determines if an approximate solution has been found */ int KINSol(void *kinmem, N_Vector u, int strategy, N_Vector u_scale, N_Vector f_scale) { realtype fnormp, f1normp, epsmin; KINMem kin_mem; int ret, sflag; booleantype maxStepTaken; /* intialize to avoid compiler warning messages */ maxStepTaken = FALSE; f1normp = fnormp = -ONE; /* initialize epsmin to avoid compiler warning message */ epsmin = ZERO; /* check for kinmem non-NULL */ if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if(kin_mem->kin_MallocDone == FALSE) { KINProcessError(NULL, KIN_NO_MALLOC, "KINSOL", "KINSol", MSG_NO_MALLOC); return(KIN_NO_MALLOC); } /* load input arguments */ uu = u; uscale = u_scale; fscale = f_scale; /* initialize solver */ ret = KINSolInit(kin_mem, strategy); if (ret != KIN_SUCCESS) return(ret); ncscmx = 0; /* Note: The following logic allows the choice of whether or not to force a call to the linear solver setup upon a given call to KINSol */ if (noInitSetup) sthrsh = ONE; else sthrsh = TWO; /* if eps is to be bounded from below, set the bound */ if (inexact_ls && !noMinEps) epsmin = POINT01 * fnormtol; /* if omega is zero at this point, make sure it will be evaluated at each iteration based on the provided min/max bounds and the current function norm. */ if (omega == ZERO) eval_omega = TRUE; else eval_omega = FALSE; loop{ retry_nni = FALSE; nni++; /* calculate the epsilon (stopping criteria for iterative linear solver) for this iteration based on eta from the routine KINForcingTerm */ if (inexact_ls) { eps = (eta + uround) * fnorm; if(!noMinEps) eps = MAX(epsmin, eps); } repeat_nni: /* call KINLinSolDrv to calculate the (approximate) Newton step, pp */ ret = KINLinSolDrv(kin_mem); if (ret != KIN_SUCCESS) break; /* call the appropriate routine to calculate an acceptable step pp */ sflag = 0; if (strategy == KIN_NONE) { /* Full Newton Step*/ sflag = KINFullNewton(kin_mem, &fnormp, &f1normp, &maxStepTaken); /* if sysfunc failed unrecoverably, stop */ if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { ret = sflag; break; } } else if (strategy == KIN_LINESEARCH) { /* Line Search */ sflag = KINLineSearch(kin_mem, &fnormp, &f1normp, &maxStepTaken); /* if sysfunc failed unrecoverably, stop */ if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { ret = sflag; break; } /* if too many beta condition failures, then stop iteration */ if (nbcf > mxnbcf) { ret = KIN_LINESEARCH_BCFAIL; break; } } /* evaluate eta by calling the forcing term routine */ if (callForcingTerm) KINForcingTerm(kin_mem, fnormp); fnorm = fnormp; /* call KINStop to check if tolerances where met by this iteration */ ret = KINStop(kin_mem, strategy, maxStepTaken, sflag); if (ret == RETRY_ITERATION) { retry_nni = TRUE; goto repeat_nni; } /* update uu after the iteration */ N_VScale(ONE, unew, uu); f1norm = f1normp; /* print the current nni, fnorm, and nfe values if printfl > 0 */ if (printfl>0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSol", INFO_NNI, nni, nfe, fnorm); if (ret != CONTINUE_ITERATIONS) break; fflush(errfp); } /* end of loop; return */ if (printfl > 0) KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINSol", INFO_RETVAL, ret); switch(ret) { case KIN_SYSFUNC_FAIL: KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSol", MSG_SYSFUNC_FAILED); break; case KIN_REPTD_SYSFUNC_ERR: KINProcessError(kin_mem, KIN_REPTD_SYSFUNC_ERR, "KINSOL", "KINSol", MSG_SYSFUNC_REPTD); break; case KIN_LSETUP_FAIL: KINProcessError(kin_mem, KIN_LSETUP_FAIL, "KINSOL", "KINSol", MSG_LSETUP_FAILED); break; case KIN_LSOLVE_FAIL: KINProcessError(kin_mem, KIN_LSOLVE_FAIL, "KINSOL", "KINSol", MSG_LSOLVE_FAILED); break; case KIN_LINSOLV_NO_RECOVERY: KINProcessError(kin_mem, KIN_LINSOLV_NO_RECOVERY, "KINSOL", "KINSol", MSG_LINSOLV_NO_RECOVERY); break; case KIN_LINESEARCH_NONCONV: KINProcessError(kin_mem, KIN_LINESEARCH_NONCONV, "KINSOL", "KINSol", MSG_LINESEARCH_NONCONV); break; case KIN_LINESEARCH_BCFAIL: KINProcessError(kin_mem, KIN_LINESEARCH_BCFAIL, "KINSOL", "KINSol", MSG_LINESEARCH_BCFAIL); break; case KIN_MAXITER_REACHED: KINProcessError(kin_mem, KIN_MAXITER_REACHED, "KINSOL", "KINSol", MSG_MAXITER_REACHED); break; case KIN_MXNEWT_5X_EXCEEDED: KINProcessError(kin_mem, KIN_MXNEWT_5X_EXCEEDED, "KINSOL", "KINSol", MSG_MXNEWT_5X_EXCEEDED); break; } return(ret); } /* * ----------------------------------------------------------------- * Deallocation function * ----------------------------------------------------------------- */ /* * Function : KINFree * * This routine frees the problem memory allocated by KINInit. * Such memory includes all the vectors allocated by * KINAllocVectors, and the memory lmem for the linear solver * (deallocated by a call to lfree). */ void KINFree(void **kinmem) { KINMem kin_mem; if (*kinmem == NULL) return; kin_mem = (KINMem) (*kinmem); KINFreeVectors(kin_mem); /* call lfree if non-NULL */ if (lfree != NULL) lfree(kin_mem); free(*kinmem); *kinmem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * Function : KINCheckNvector * * This routine checks if all required vector operations are * implemented (excluding those required by KINConstraint). If all * necessary operations are present, then KINCheckNvector returns * TRUE. Otherwise, FALSE is returned. */ static booleantype KINCheckNvector(N_Vector tmpl) { if ((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvdiv == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvmaxnorm == NULL) || (tmpl->ops->nvmin == NULL) || (tmpl->ops->nvwl2norm == NULL)) return(FALSE); else return(TRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * Function : KINAllocVectors * * This routine allocates the KINSol vectors. If all memory * allocations are successful, KINAllocVectors returns TRUE. * Otherwise all allocated memory is freed and KINAllocVectors * returns FALSE. */ static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl) { /* allocate unew, fval, pp, vtemp1 and vtemp2 */ unew = N_VClone(tmpl); if (unew == NULL) return(FALSE); fval = N_VClone(tmpl); if (fval == NULL) { N_VDestroy(unew); return(FALSE); } pp = N_VClone(tmpl); if (pp == NULL) { N_VDestroy(unew); N_VDestroy(fval); return(FALSE); } vtemp1 = N_VClone(tmpl); if (vtemp1 == NULL) { N_VDestroy(unew); N_VDestroy(fval); N_VDestroy(pp); return(FALSE); } vtemp2 = N_VClone(tmpl); if (vtemp2 == NULL) { N_VDestroy(unew); N_VDestroy(fval); N_VDestroy(pp); N_VDestroy(vtemp1); return(FALSE); } /* update solver workspace lengths */ liw += 5*liw1; lrw += 5*lrw1; return(TRUE); } /* * KINFreeVectors * * This routine frees the KINSol vectors allocated by * KINAllocVectors. */ static void KINFreeVectors(KINMem kin_mem) { if (unew != NULL) N_VDestroy(unew); if (fval != NULL) N_VDestroy(fval); if (pp != NULL) N_VDestroy(pp); if (vtemp1 != NULL) N_VDestroy(vtemp1); if (vtemp2 != NULL) N_VDestroy(vtemp2); lrw -= 5*lrw1; liw -= 5*liw1; if (kin_mem->kin_constraintsSet) { if (constraints != NULL) N_VDestroy(constraints); lrw -= lrw1; liw -= liw1; } return; } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * KINSolInit * * KINSolInit initializes the problem for the specific input * received in this call to KINSol (which calls KINSolInit). All * problem specification inputs are checked for errors. If any error * occurs during initialization, it is reported to the file whose * file pointer is errfp. * * The possible return values for KINSolInit are: * KIN_SUCCESS : indicates a normal initialization * * KINS_ILL_INPUT : indicates that an input error has been found * * KIN_INITIAL_GUESS_OK : indicates that the guess uu * satisfied the system func(uu) = 0 * within the tolerances specified */ static int KINSolInit(KINMem kin_mem, int strategy) { int retval; realtype fmax; /* check for illegal input parameters */ if (uu == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_UU_NULL); return(KIN_ILL_INPUT); } if ((strategy != KIN_NONE) && (strategy != KIN_LINESEARCH)) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_GLSTRAT); return(KIN_ILL_INPUT); } if (uscale == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_USCALE); return(KIN_ILL_INPUT); } if (N_VMin(uscale) <= ZERO){ KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_USCALE_NONPOSITIVE); return(KIN_ILL_INPUT); } if (fscale == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_FSCALE); return(KIN_ILL_INPUT); } if (N_VMin(fscale) <= ZERO){ KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_FSCALE_NONPOSITIVE); return(KIN_ILL_INPUT); } /* set the constraints flag */ if (constraints == NULL) constraintsSet = FALSE; else { constraintsSet = TRUE; if ((constraints->ops->nvconstrmask == NULL) || (constraints->ops->nvminquotient == NULL)) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_NVECTOR); return(KIN_ILL_INPUT); } } /* check the initial guess uu against the constraints */ if (constraintsSet) { if (!N_VConstrMask(constraints, uu, vtemp1)) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_INITIAL_CNSTRNT); return(KIN_ILL_INPUT); } } /* all error checking is complete at this point */ if (printfl > 0) KINPrintInfo(kin_mem, PRNT_TOL, "KINSOL", "KINSolInit", INFO_TOL, scsteptol, fnormtol); /* calculate the default value for mxnewtstep (maximum Newton step) */ if (mxnewtstep == ZERO) mxnewtstep = THOUSAND * N_VWL2Norm(uu, uscale); if (mxnewtstep < ONE) mxnewtstep = ONE; /* additional set-up for inexact linear solvers */ if (inexact_ls) { /* set up the coefficients for the eta calculation */ callForcingTerm = (etaflag != KIN_ETACONSTANT); /* this value is always used for choice #1 */ if (etaflag == KIN_ETACHOICE1) ealpha = (ONE + RSqrt(FIVE)) * HALF; /* initial value for eta set to 0.5 for other than the KIN_ETACONSTANT option */ if (etaflag != KIN_ETACONSTANT) eta = HALF; /* disable residual monitoring if using an inexact linear solver */ noResMon = TRUE; } else { callForcingTerm = FALSE; } /* initialize counters */ nfe = nnilset = nnilset_sub = nni = nbcf = nbktrk = 0; /* see if the system func(uu) = 0 is satisfied by the initial guess uu */ retval = func(uu, fval, user_data); nfe++; if (retval < 0) { KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSolInit", MSG_SYSFUNC_FAILED); return(KIN_SYSFUNC_FAIL); } else if (retval > 0) { KINProcessError(kin_mem, KIN_FIRST_SYSFUNC_ERR, "KINSOL", "KINSolInit", MSG_SYSFUNC_FIRST); return(KIN_FIRST_SYSFUNC_ERR); } fmax = KINScFNorm(kin_mem, fval, fscale); if (printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINSolInit", INFO_FMAX, fmax); if (fmax <= (POINT01 * fnormtol)) return(KIN_INITIAL_GUESS_OK); /* initialize the linear solver if linit != NULL */ if (linit != NULL) { retval = linit(kin_mem); if (retval != 0) { KINProcessError(kin_mem, KIN_LINIT_FAIL, "KINSOL", "KINSolInit", MSG_LINIT_FAIL); return(KIN_LINIT_FAIL); } } /* initialize the L2 (Euclidean) norms of f for the linear iteration steps */ fnorm = N_VWL2Norm(fval, fscale); f1norm = HALF * fnorm * fnorm; fnorm_sub = fnorm; if (printfl > 0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSolInit", INFO_NNI, nni, nfe, fnorm); /* problem has now been successfully initialized */ return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Step functions * ----------------------------------------------------------------- */ /* * KINLinSolDrv * * This routine handles the process of solving for the approximate * solution of the Newton equations in the Newton iteration. * Subsequent routines handle the nonlinear aspects of its * application. */ static int KINLinSolDrv(KINMem kin_mem) { N_Vector x, b; int retval; if ((nni - nnilset) >= msbset) { sthrsh = TWO; update_fnorm_sub = TRUE; } loop{ jacCurrent = FALSE; if ((sthrsh > ONEPT5) && setupNonNull) { retval = lsetup(kin_mem); jacCurrent = TRUE; nnilset = nni; nnilset_sub = nni; if (retval != 0) return(KIN_LSETUP_FAIL); } /* rename vectors for readability */ b = unew; x = pp; /* load b with the current value of -fval */ N_VScale(-ONE, fval, b); /* call the generic 'lsolve' routine to solve the system Jx = b */ retval = lsolve(kin_mem, x, b, &res_norm); if (retval == 0) return(KIN_SUCCESS); else if (retval < 0) return(KIN_LSOLVE_FAIL); else if ((!setupNonNull) || (jacCurrent)) return(KIN_LINSOLV_NO_RECOVERY); /* loop back only if the linear solver setup is in use and Jacobian information is not current */ sthrsh = TWO; } } /* * KINFullNewton * * This routine is the main driver for the Full Newton * algorithm. Its purpose is to compute unew = uu + pp in the * direction pp from uu, taking the full Newton step. The * step may be constrained if the constraint conditions are * violated, or if the norm of pp is greater than mxnewtstep. */ static int KINFullNewton(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken) { realtype pnorm, ratio; booleantype fOK; int ircvr, retval; *maxStepTaken = FALSE; pnorm = N_VWL2Norm(pp, uscale); ratio = ONE; if (pnorm > mxnewtstep) { ratio = mxnewtstep / pnorm; N_VScale(ratio, pp, pp); pnorm = mxnewtstep; } if (printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); /* If constraints are active, then constrain the step accordingly */ stepl = pnorm; stepmul = ONE; if (constraintsSet) { retval = KINConstraint(kin_mem); if (retval == CONSTR_VIOLATED) { /* Apply stepmul set in KINConstraint */ ratio *= stepmul; N_VScale(stepmul, pp, pp); pnorm *= stepmul; stepl = pnorm; if (printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); if (pnorm <= scsteptol) { N_VLinearSum(ONE, uu, ONE, pp, unew); return(STEP_TOO_SMALL);} } } /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ fOK = FALSE; for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { /* compute the iterate unew = uu + pp */ N_VLinearSum(ONE, uu, ONE, pp, unew); /* evaluate func(unew) and its norm, and return */ retval = func(unew, fval, user_data); nfe++; /* if func was successful, accept pp */ if (retval == 0) {fOK = TRUE; break;} /* if func failed unrecoverably, give up */ else if (retval < 0) return(KIN_SYSFUNC_FAIL); /* func failed recoverably; cut step in half and try again */ ratio *= HALF; N_VScale(HALF, pp, pp); pnorm *= HALF; stepl = pnorm; } /* If func() failed recoverably MAX_RECVR times, give up */ if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); /* Evaluate function norms */ *fnormp = N_VWL2Norm(fval,fscale); *f1normp = HALF * (*fnormp) * (*fnormp); /* scale sfdotJp and sJpnorm by ratio for later use in KINForcingTerm */ sfdotJp *= ratio; sJpnorm *= ratio; if (printfl > 1) KINPrintInfo(kin_mem, PRNT_FNORM, "KINSOL", "KINFullNewton", INFO_FNORM, *fnormp); if (pnorm > (POINT99 * mxnewtstep)) *maxStepTaken = TRUE; return(KIN_SUCCESS); } /* * KINLineSearch * * The routine KINLineSearch implements the LineSearch algorithm. * Its purpose is to find unew = uu + rl * pp in the direction pp * from uu so that: * t * func(unew) <= func(uu) + alpha * g (unew - uu) (alpha = 1.e-4) * * and * t * func(unew) >= func(uu) + beta * g (unew - uu) (beta = 0.9) * * where 0 < rlmin <= rl <= rlmax. * * Note: * mxnewtstep * rlmax = ---------------- if uu+pp is feasible * ||uscale*pp||_L2 * * rlmax = 1 otherwise * * and * * scsteptol * rlmin = -------------------------- * || pp || * || -------------------- ||_L-infinity * || (1/uscale + ABS(uu)) || * * * If the system function fails unrecoverably at any time, KINLineSearch * returns KIN_SYSFUNC_FAIL which will halt the solver. * * We attempt to corect recoverable system function failures only before * the alpha-condition loop; i.e. when the solution is updated with the * full Newton step (possibly reduced due to constraint violations). * Once we find a feasible pp, we assume that any update up to pp is * feasible. * * If the step size is limited due to constraint violations and/or * recoverable system function failures, we set rlmax=1 to ensure * that the update remains feasible during the attempts to enforce * the beta-condition (this is not an isse while enforcing the alpha * condition, as rl can only decrease from 1 at that stage) */ static int KINLineSearch(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken) { realtype pnorm, ratio, slpi, rlmin, rlength, rl, rlmax, rldiff; realtype rltmp, rlprev, pt1trl, f1nprv, rllo, rlinc, alpha, beta; realtype alpha_cond, beta_cond, rl_a, tmp1, rl_b, tmp2, disc; int ircvr, nbktrk_l, retval; booleantype firstBacktrack, fOK; /* Initializations */ nbktrk_l = 0; /* local backtracking counter */ ratio = ONE; /* step change ratio */ alpha = POINT0001; beta = POINT9; firstBacktrack = TRUE; *maxStepTaken = FALSE; rlprev = f1nprv = ZERO; /* Compute length of Newton step */ pnorm = N_VWL2Norm(pp, uscale); rlmax = mxnewtstep / pnorm; stepl = pnorm; /* If the full Newton step is too large, set it to the maximum allowable value */ if(pnorm > mxnewtstep ) { ratio = mxnewtstep / pnorm; N_VScale(ratio, pp, pp); pnorm = mxnewtstep; rlmax = ONE; stepl = pnorm; } /* If constraint checking is activated, check and correct violations */ stepmul = ONE; if(constraintsSet){ retval = KINConstraint(kin_mem); if(retval == CONSTR_VIOLATED){ /* Apply stepmul set in KINConstraint */ N_VScale(stepmul, pp, pp); ratio *= stepmul; pnorm *= stepmul; rlmax = ONE; stepl = pnorm; if (printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM1, "KINSOL", "KINLineSearch", INFO_PNORM1, pnorm); if (pnorm <= scsteptol) { N_VLinearSum(ONE, uu, ONE, pp, unew); return(STEP_TOO_SMALL);} } } /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ fOK = FALSE; for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { /* compute the iterate unew = uu + pp */ N_VLinearSum(ONE, uu, ONE, pp, unew); /* evaluate func(unew) and its norm, and return */ retval = func(unew, fval, user_data); nfe++; /* if func was successful, accept pp */ if (retval == 0) {fOK = TRUE; break;} /* if func failed unrecoverably, give up */ else if (retval < 0) return(KIN_SYSFUNC_FAIL); /* func failed recoverably; cut step in half and try again */ N_VScale(HALF, pp, pp); ratio *= HALF; pnorm *= HALF; rlmax = ONE; stepl = pnorm; } /* If func() failed recoverably MAX_RECVR times, give up */ if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); /* Evaluate function norms */ *fnormp = N_VWL2Norm(fval, fscale); *f1normp = HALF * (*fnormp) * (*fnormp) ; /* Estimate the line search value rl (lambda) to satisfy both ALPHA and BETA conditions */ slpi = sfdotJp * ratio; rlength = KINScSNorm(kin_mem, pp, uu); rlmin = scsteptol / rlength; rl = ONE; if (printfl > 2) KINPrintInfo(kin_mem, PRNT_LAM, "KINSOL", "KINLineSearch", INFO_LAM, rlmin, f1norm, pnorm); /* Loop until the ALPHA condition is satisfied. Terminate if rl becomes too small */ loop { /* Evaluate test quantity */ alpha_cond = f1norm + (alpha * slpi * rl); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_ALPHA, "KINSOL", "KINLinesearch", INFO_ALPHA, *fnormp, *f1normp, alpha_cond, rl); /* If ALPHA condition is satisfied, break out from loop */ if ((*f1normp) <= alpha_cond) break; /* Backtracking. Use quadratic fit the first time and cubic fit afterwards. */ if (firstBacktrack) { rltmp = -slpi / (TWO * ((*f1normp) - f1norm - slpi)); firstBacktrack = FALSE; } else { tmp1 = (*f1normp) - f1norm - (rl * slpi); tmp2 = f1nprv - f1norm - (rlprev * slpi); rl_a = ((ONE / (rl * rl)) * tmp1) - ((ONE / (rlprev * rlprev)) * tmp2); rl_b = ((-rlprev / (rl * rl)) * tmp1) + ((rl / (rlprev * rlprev)) * tmp2); tmp1 = ONE / (rl - rlprev); rl_a *= tmp1; rl_b *= tmp1; disc = (rl_b * rl_b) - (THREE * rl_a * slpi); if (ABS(rl_a) < uround) { /* cubic is actually just a quadratic (rl_a ~ 0) */ rltmp = -slpi / (TWO * rl_b); } else { /* real cubic */ rltmp = (-rl_b + RSqrt(disc)) / (THREE * rl_a); } } if (rltmp > (HALF * rl)) rltmp = HALF * rl; /* Set new rl (do not allow a reduction by a factor larger than 10) */ rlprev = rl; f1nprv = (*f1normp); pt1trl = POINT1 * rl; rl = MAX(pt1trl, rltmp); nbktrk_l++; /* Update unew and re-evaluate function */ N_VLinearSum(ONE, uu, rl, pp, unew); retval = func(unew, fval, user_data); nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(fval, fscale); *f1normp = HALF * (*fnormp) * (*fnormp) ; /* Check if rl (lambda) is too small */ if (rl < rlmin) { /* unew sufficiently distinct from uu cannot be found. copy uu into unew (step remains unchanged) and return STEP_TOO_SMALL */ N_VScale(ONE, uu, unew); return(STEP_TOO_SMALL); } } /* end ALPHA condition loop */ /* ALPHA condition is satisfied. Now check the BETA condition */ beta_cond = f1norm + (beta * slpi * rl); if ((*f1normp) < beta_cond) { /* BETA condition not satisfied */ if ((rl == ONE) && (pnorm < mxnewtstep)) { do { rlprev = rl; f1nprv = *f1normp; rl = MIN((TWO * rl), rlmax); nbktrk_l++; N_VLinearSum(ONE, uu, rl, pp, unew); retval = func(unew, fval, user_data); nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(fval, fscale); *f1normp = HALF * (*fnormp) * (*fnormp); alpha_cond = f1norm + (alpha * slpi * rl); beta_cond = f1norm + (beta * slpi * rl); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_BETA, "KINSOL", "KINLineSearch", INFO_BETA, *f1normp, beta_cond, rl); } while (((*f1normp) <= alpha_cond) && ((*f1normp) < beta_cond) && (rl < rlmax)); } /* enf if (rl == ONE) block */ if ((rl < ONE) || ((rl > ONE) && (*f1normp > alpha_cond))) { rllo = MIN(rl, rlprev); rldiff = ABS(rlprev - rl); do { rlinc = HALF * rldiff; rl = rllo + rlinc; nbktrk_l++; N_VLinearSum(ONE, uu, rl, pp, unew); retval = func(unew, fval, user_data); nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(fval, fscale); *f1normp = HALF * (*fnormp) * (*fnormp); alpha_cond = f1norm + (alpha * slpi * rl); beta_cond = f1norm + (beta * slpi * rl); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_ALPHABETA, "KINSOL", "KINLineSearch", INFO_ALPHABETA, *f1normp, alpha_cond, beta_cond, rl); if ((*f1normp) > alpha_cond) rldiff = rlinc; else if (*f1normp < beta_cond) { rllo = rl; rldiff = rldiff - rlinc; } } while ((*f1normp > alpha_cond) || ((*f1normp < beta_cond) && (rldiff >= rlmin))); if ((*f1normp) < beta_cond) { /* beta condition could not be satisfied so set unew to last u value that satisfied the alpha condition and continue */ N_VLinearSum(ONE, uu, rllo, pp, unew); retval = func(unew, fval, user_data); nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(fval, fscale); *f1normp = HALF * (*fnormp) * (*fnormp); /* increment beta-condition failures counter */ nbcf++; } } /* end of if (rl < ONE) block */ } /* end of if (f1normp < beta_cond) block */ /* Update number of backtracking operations */ nbktrk += nbktrk_l; if (printfl > 1) KINPrintInfo(kin_mem, PRNT_ADJ, "KINSOL", "KINLineSearch", INFO_ADJ, nbktrk_l); /* scale sfdotJp and sJpnorm by rl * ratio for later use in KINForcingTerm */ sfdotJp = sfdotJp * rl * ratio; sJpnorm = sJpnorm * rl * ratio; if ((rl * pnorm) > (POINT99 * mxnewtstep)) *maxStepTaken = TRUE; return(KIN_SUCCESS); } /* * Function : KINConstraint * * This routine checks if the proposed solution vector uu + pp * violates any constraints. If a constraint is violated, then the * scalar stepmul is determined such that uu + stepmul * pp does * not violate any constraints. * * Note: This routine is called by the functions * KINLineSearch and KINFullNewton. */ static int KINConstraint(KINMem kin_mem) { N_VLinearSum(ONE, uu, ONE, pp, vtemp1); /* if vtemp1[i] violates constraint[i] then vtemp2[i] = 1 else vtemp2[i] = 0 (vtemp2 is the mask vector) */ if(N_VConstrMask(constraints, vtemp1, vtemp2)) return(KIN_SUCCESS); /* vtemp1[i] = ABS(pp[i]) */ N_VAbs(pp, vtemp1); /* consider vtemp1[i] only if vtemp2[i] = 1 (constraint violated) */ N_VProd(vtemp2, vtemp1, vtemp1); N_VAbs(uu, vtemp2); stepmul = POINT9 * N_VMinQuotient(vtemp2, vtemp1); return(CONSTR_VIOLATED); } /* * ----------------------------------------------------------------- * Stopping tests * ----------------------------------------------------------------- */ /* * KINStop * * This routine checks the current iterate unew to see if the * system func(unew) = 0 is satisfied by a variety of tests. * * strategy is one of KIN_NONE or KIN_LINESEARCH * sflag is one of KIN_SUCCESS, STEP_TOO_SMALL */ static int KINStop(KINMem kin_mem, int strategy, booleantype maxStepTaken, int sflag) { realtype fmax, rlength, omexp; N_Vector delta; /* Check for too small a step */ if (sflag == STEP_TOO_SMALL) { if (setupNonNull && !jacCurrent) { /* If the Jacobian is out of date, update it and retry */ sthrsh = TWO; return(CONTINUE_ITERATIONS); } else { /* Give up */ if (strategy == KIN_NONE) return(KIN_STEP_LT_STPTOL); else return(KIN_LINESEARCH_NONCONV); } } /* Check tolerance on scaled function norm at the current iterate */ fmax = KINScFNorm(kin_mem, fval, fscale); if (printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINStop", INFO_FMAX, fmax); if (fmax <= fnormtol) return(KIN_SUCCESS); /* Check if the scaled distance between the last two steps is too small */ /* NOTE: pp used as work space to store this distance */ delta = pp; N_VLinearSum(ONE, unew, -ONE, uu, delta); rlength = KINScSNorm(kin_mem, delta, unew); if (rlength <= scsteptol) { if (setupNonNull && !jacCurrent) { /* If the Jacobian is out of date, update it and retry */ sthrsh = TWO; return(CONTINUE_ITERATIONS); } else { /* give up */ return(KIN_STEP_LT_STPTOL); } } /* Check if the maximum number of iterations is reached */ if (nni >= mxiter) return(KIN_MAXITER_REACHED); /* Check for consecutive number of steps taken of size mxnewtstep and if not maxStepTaken, then set ncscmx to 0 */ if (maxStepTaken) ncscmx++; else ncscmx = 0; if (ncscmx == 5) return(KIN_MXNEWT_5X_EXCEEDED); /* Proceed according to the type of linear solver used */ if (inexact_ls) { /* We're doing inexact Newton. Load threshold for reevaluating the Jacobian. */ sthrsh = rlength; } else if (!noResMon) { /* We're doing modified Newton and the user did not disable residual monitoring. Check if it is time to monitor residual. */ if ((nni - nnilset_sub) >= msbset_sub) { /* Residual monitoring needed */ nnilset_sub = nni; /* If indicated, estimate new OMEGA value */ if (eval_omega) { omexp = MAX(ZERO,(fnorm/fnormtol)-ONE); omega = (omexp > TWELVE)? omega_max : MIN(omega_min*EXP(omexp), omega_max); } /* Check if making satisfactory progress */ if (fnorm > omega*fnorm_sub) { /* Insuficient progress */ if (setupNonNull && !jacCurrent) { /* If the Jacobian is out of date, update it and retry */ sthrsh = TWO; return(RETRY_ITERATION); } else { /* Otherwise, we cannot do anything, so just return. */ } } else { /* Sufficient progress */ fnorm_sub = fnorm; sthrsh = ONE; } } else { /* Residual monitoring not needed */ /* Reset sthrsh */ if (retry_nni || update_fnorm_sub) fnorm_sub = fnorm; if (update_fnorm_sub) update_fnorm_sub = FALSE; sthrsh = ONE; } } /* if made it to here, then the iteration process is not finished so return CONTINUE_ITERATIONS flag */ return(CONTINUE_ITERATIONS); } /* * KINForcingTerm * * This routine computes eta, the scaling factor in the linear * convergence stopping tolerance eps when choice #1 or choice #2 * forcing terms are used. Eta is computed here for all but the * first iterative step, which is set to the default in routine * KINSolInit. * * This routine was written by Homer Walker of Utah State * University with subsequent modifications by Allan Taylor @ LLNL. * * It is based on the concepts of the paper 'Choosing the forcing * terms in an inexact Newton method', SIAM J Sci Comput, 17 * (1996), pp 16 - 32, or Utah State University Research Report * 6/94/75 of the same title. */ static void KINForcingTerm(KINMem kin_mem, realtype fnormp) { realtype eta_max, eta_min, eta_safe, linmodel_norm; eta_max = POINT9; eta_min = POINT0001; eta_safe = HALF; /* choice #1 forcing term */ if (etaflag == KIN_ETACHOICE1) { /* compute the norm of f + Jp , scaled L2 norm */ linmodel_norm = RSqrt((fnorm * fnorm) + (TWO * sfdotJp) + (sJpnorm * sJpnorm)); /* form the safeguarded for choice #1 */ eta_safe = RPowerR(eta, ealpha); eta = ABS(fnormp - linmodel_norm) / fnorm; } /* choice #2 forcing term */ if (etaflag == KIN_ETACHOICE2) { eta_safe = egamma * RPowerR(eta, ealpha); eta = egamma * RPowerR((fnormp / fnorm), ealpha); } /* apply safeguards */ if(eta_safe < POINT1) eta_safe = ZERO; eta = MAX(eta, eta_safe); eta = MAX(eta, eta_min); eta = MIN(eta, eta_max); return; } /* * ----------------------------------------------------------------- * Norm functions * ----------------------------------------------------------------- */ /* * Function : KINScFNorm * * This routine computes the max norm for scaled vectors. The * scaling vector is scale, and the vector of which the norm is to * be determined is vv. The returned value, fnormval, is the * resulting scaled vector norm. This routine uses N_Vector * functions from the vector module. */ static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale) { N_VProd(scale, v, vtemp1); return(N_VMaxNorm(vtemp1)); } /* * Function : KINScSNorm * * This routine computes the max norm of the scaled steplength, ss. * Here ucur is the current step and usc is the u scale factor. */ static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u) { realtype length; N_VInv(uscale, vtemp1); N_VAbs(u, vtemp2); N_VLinearSum(ONE, vtemp1, ONE, vtemp2, vtemp1); N_VDiv(v, vtemp1, vtemp1); length = N_VMaxNorm(vtemp1); return(length); } /* * ================================================================= * KINSOL Verbose output functions * ================================================================= */ /* * KINPrintInfo * * KINPrintInfo is a high level error handling function * Based on the value info_code, it composes the info message and * passes it to the info handler function. */ #define ihfun (kin_mem->kin_ihfun) #define ih_data (kin_mem->kin_ih_data) void KINPrintInfo(KINMem kin_mem, int info_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256], msg1[40]; char retstr[30]; int ret; /* Initialize argument processing (msgfrmt is the last required argument) */ va_start(ap, msgfmt); if (info_code == PRNT_RETVAL) { /* If info_code = PRNT_RETVAL, decode the numeric value */ ret = va_arg(ap, int); switch(ret) { case KIN_SUCCESS: sprintf(retstr, "KIN_SUCCESS"); break; case KIN_SYSFUNC_FAIL: sprintf(retstr, "KIN_SYSFUNC_FAIL"); break; case KIN_STEP_LT_STPTOL: sprintf(retstr, "KIN_STEP_LT_STPTOL"); break; case KIN_LINESEARCH_NONCONV: sprintf(retstr, "KIN_LINESEARCH_NONCONV"); break; case KIN_LINESEARCH_BCFAIL: sprintf(retstr, "KIN_LINESEARCH_BCFAIL"); break; case KIN_MAXITER_REACHED: sprintf(retstr, "KIN_MAXITER_REACHED"); break; case KIN_MXNEWT_5X_EXCEEDED: sprintf(retstr, "KIN_MXNEWT_5X_EXCEEDED"); break; case KIN_LINSOLV_NO_RECOVERY: sprintf(retstr, "KIN_LINSOLV_NO_RECOVERY"); break; case KIN_LSETUP_FAIL: sprintf(retstr, "KIN_PRECONDSET_FAILURE"); break; case KIN_LSOLVE_FAIL: sprintf(retstr, "KIN_PRECONDSOLVE_FAILURE"); break; } /* Compose the message */ sprintf(msg1, msgfmt, ret); sprintf(msg,"%s (%s)",msg1,retstr); } else { /* Compose the message */ vsprintf(msg, msgfmt, ap); } /* call the info message handler */ ihfun(module, fname, msg, ih_data); /* finalize argument processing */ va_end(ap); return; } /* * KINInfoHandler * * This is the default KINSOL info handling function. * It sends the info message to the stream pointed to by kin_infofp */ #define infofp (kin_mem->kin_infofp) void KINInfoHandler(const char *module, const char *function, char *msg, void *data) { KINMem kin_mem; /* data points to kin_mem here */ kin_mem = (KINMem) data; #ifndef NO_FPRINTF_OUTPUT if (infofp != NULL) { fprintf(infofp,"\n[%s] %s\n",module, function); fprintf(infofp," %s\n",msg); } #endif } /* * ================================================================= * KINSOL Error Handling functions * ================================================================= */ /* * KINProcessError * * Thi is a high level error handling function * - if cv_mem==NULL it prints the error message to stderr * - otherwise, it sets-up and calls the error hadling function * pointed to by cv_ehfun */ #define ehfun (kin_mem->kin_ehfun) #define eh_data (kin_mem->kin_eh_data) void KINProcessError(KINMem kin_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to KINProcessError) */ va_start(ap, msgfmt); if (kin_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, msgfmt); fprintf(stderr, "\n\n"); #endif } else { /* We can call ehfun */ /* Compose the message */ vsprintf(msg, msgfmt, ap); /* Call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* * KINErrHandler * * This is the default error handling function. * It sends the error message to the stream pointed to by kin_errfp */ #define errfp (kin_mem->kin_errfp) void KINErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { KINMem kin_mem; char err_type[10]; /* data points to kin_mem here */ kin_mem = (KINMem) data; if (error_code == KIN_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (errfp != NULL) { fprintf(errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(errfp," %s\n\n",msg); } #endif return; } sundials-2.5.0/src/kinsol/kinsol_band.c0000600000175000017500000002472011741421272020735 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2011/03/23 23:37:59 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINBAND linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_direct_impl.h" #include "kinsol_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* KINBAND linit, lsetup, lsolve, and lfree routines */ static int kinBandInit(KINMem kin_mem); static int kinBandSetup(KINMem kin_mem); static int kinBandsolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm); static void kinBandFree(KINMem kin_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define lrw1 (kin_mem->kin_lrw1) #define liw1 (kin_mem->kin_liw1) #define func (kin_mem->kin_func) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define mtype (kindls_mem->d_type) #define n (kindls_mem->d_n) #define ml (kindls_mem->d_ml) #define mu (kindls_mem->d_mu) #define smu (kindls_mem->d_smu) #define jacDQ (kindls_mem->d_jacDQ) #define bjac (kindls_mem->d_bjac) #define J (kindls_mem->d_J) #define lpivots (kindls_mem->d_lpivots) #define nje (kindls_mem->d_nje) #define nfeDQ (kindls_mem->d_nfeDQ) #define J_data (kindls_mem->d_J_data) #define last_flag (kindls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * KINBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. KINBand first calls * the existing lfree routine if this is not NULL. It then sets the * cv_linit, cv_lsetup, cv_lsolve, and cv_lfree fields in (*cvode_mem) * to be kinBandInit, kinBandSetup, kinBandsolve, and kinBandFree, * respectively. It allocates memory for a structure of type * KINDlsMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to be * TRUE, b_mu to be mupper, b_ml to be mlower, and the bjac field to be * kinDlsBandDQJac. * Finally, it allocates memory for M, savedJ, and pivot. * * NOTE: The band linear solver assumes a serial implementation * of the NVECTOR package. Therefore, KINBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int KINBand(void *kinmem, long int N, long int mupper, long int mlower) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINBAND", "KINBand", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL) { KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINBAND", "KINBand", MSGD_BAD_NVECTOR); return(KINDLS_ILL_INPUT); } if (lfree != NULL) lfree(kin_mem); /* Set four main function fields in kin_mem */ linit = kinBandInit; lsetup = kinBandSetup; lsolve = kinBandsolve; lfree = kinBandFree; /* Get memory for KINDlsMemRec */ kindls_mem = NULL; kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec)); if (kindls_mem == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINBAND", "KINBand", MSGD_MEM_FAIL); return(KINDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = KINDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = N; /* Load half-bandwiths in kindls_mem */ ml = mlower; mu = mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= N) || (mu >= N)) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINBAND", "KINBand", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(N-1, mu + ml); /* Allocate memory for J and pivot array */ J = NULL; J = NewBandMat(N, mu, ml, smu); if (J == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINBAND", "KINBand", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(N); if (lpivots == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINBAND", "KINBand", MSGD_MEM_FAIL); DestroyMat(J); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } /* This is a direct linear solver */ inexact_ls = FALSE; /* Attach linear solver memory to integrator memory */ lmem = kindls_mem; return(KINDLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * kinBandInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the band * linear solver. * ----------------------------------------------------------------- */ static int kinBandInit(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; nje = 0; nfeDQ = 0; if (jacDQ) { bjac = kinDlsBandDQJac; J_data = kin_mem; } else { J_data = kin_mem->kin_user_data; } last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinBandSetup * ----------------------------------------------------------------- * This routine does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the band LU * factorization routine. * ----------------------------------------------------------------- */ static int kinBandSetup(KINMem kin_mem) { KINDlsMem kindls_mem; int retval; long int ier; kindls_mem = (KINDlsMem) lmem; nje++; SetToZero(J); retval = bjac(n, mu, ml, uu, fval, J, J_data, vtemp1, vtemp2); if (retval != 0) { last_flag = -1; return(-1); } /* Do LU factorization of J */ ier = BandGBTRF(J, lpivots); /* Return 0 if the LU was complete; otherwise return -1 */ last_flag = ier; if (ier > 0) return(-1); return(0); } /* * ----------------------------------------------------------------- * kinBandsolve * ----------------------------------------------------------------- * This routine handles the solve operation for the band linear solver * by calling the band backsolve routine. The return value is 0. * ----------------------------------------------------------------- */ static int kinBandsolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm) { KINDlsMem kindls_mem; realtype *xd; kindls_mem = (KINDlsMem) lmem; /* Copy the right-hand side into x */ N_VScale(ONE, b, x); xd = N_VGetArrayPointer(x); /* Back-solve and get solution in x */ BandGBTRS(J, lpivots, xd); /* Compute the terms Jpnorm and sfdotJp for use in the global strategy routines and in KINForcingTerm. Both of these terms are subsequently corrected if the step is reduced by constraints or the line search. sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p. sfdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale. */ sJpnorm = N_VWL2Norm(b,fscale); N_VProd(b, fscale, b); N_VProd(b, fscale, b); sfdotJp = N_VDotProd(fval, b); last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinBandFree * ----------------------------------------------------------------- * This routine frees memory specific to the band linear solver. * ----------------------------------------------------------------- */ static void kinBandFree(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; DestroyMat(J); DestroyArray(lpivots); free(kindls_mem); kindls_mem = NULL; } sundials-2.5.0/src/kinsol/CMakeLists.txt0000600000175000017500000000720511741421272021045 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:48 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the KINSOL library INSTALL(CODE "MESSAGE(\"\nInstall KINSOL\n\")") # Add variable kinsol_SOURCES with the sources for the KINSOL library SET(kinsol_SOURCES kinsol.c kinsol_io.c kinsol_direct.c kinsol_band.c kinsol_dense.c kinsol_spils.c kinsol_spbcgs.c kinsol_spgmr.c kinsol_sptfqmr.c kinsol_bbdpre.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the KINSOL library SET(shared_SOURCES sundials_nvector.c sundials_math.c sundials_direct.c sundials_band.c sundials_dense.c sundials_iterative.c sundials_spbcgs.c sundials_spgmr.c sundials_sptfqmr.c ) # Add prefix with complete path to the common SUNDIALS sources ADD_PREFIX(${sundials_SOURCE_DIR}/src/sundials/ shared_SOURCES) # Add variable kinsol_HEADERS with the exported KINSOL header files SET(kinsol_HEADERS kinsol_band.h kinsol_bbdpre.h kinsol_dense.h kinsol_direct.h kinsol.h kinsol_spbcgs.h kinsol_spgmr.h kinsol_spils.h kinsol_sptfqmr.h ) # Add prefix with complete path to the KINSOL header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/kinsol/ kinsol_HEADERS) # If Blas/Lapack support was enabled, set-up additional file lists IF(LAPACK_FOUND) SET(kinsol_BL_SOURCES kinsol_lapack.c) SET(kinsol_BL_HEADERS kinsol_lapack.h) ADD_PREFIX(${sundials_SOURCE_DIR}/include/kinsol/ kinsol_BL_HEADERS) ELSE(LAPACK_FOUND) SET(kinsol_BL_SOURCES "") SET(kinsol_BL_HEADERS "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static KINSOL library ADD_LIBRARY(sundials_kinsol_static STATIC ${kinsol_SOURCES} ${kinsol_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_kinsol_static PROPERTIES OUTPUT_NAME sundials_kinsol CLEAN_DIRECT_OUTPUT 1) # Install the KINSOL library INSTALL(TARGETS sundials_kinsol_static DESTINATION lib) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the KINSOL library ADD_LIBRARY(sundials_kinsol_shared SHARED ${kinsol_SOURCES} ${kinsol_BL_SOURCES} ${shared_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_kinsol_shared PROPERTIES OUTPUT_NAME sundials_kinsol CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_kinsol_shared PROPERTIES VERSION ${kinsollib_VERSION} SOVERSION ${kinsollib_SOVERSION}) # Install the KINSOL library INSTALL(TARGETS sundials_kinsol_shared DESTINATION lib) ENDIF(BUILD_SHARED_LIBS) # Install the KINSOL header files INSTALL(FILES ${kinsol_HEADERS} ${kinsol_BL_HEADERS} DESTINATION include/kinsol) # Install the KINSOL implementation header file INSTALL(FILES kinsol_impl.h DESTINATION include/kinsol) # MESSAGE(STATUS "Added KINSOL module") sundials-2.5.0/src/kinsol/Makefile.in0000600000175000017500000001561711741421272020360 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for KINSOL module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ @SET_MAKE@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../.. INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include LIB_REVISION = 1:0:0 KINSOL_LIB = libsundials_kinsol.la KINSOL_SRC_FILES = kinsol.c kinsol_io.c kinsol_direct.c kinsol_dense.c kinsol_band.c kinsol_spils.c kinsol_spgmr.c kinsol_spbcgs.c kinsol_sptfqmr.c kinsol_bbdpre.c KINSOL_BL_SRC_FILES = kinsol_lapack.c KINSOL_OBJ_FILES = $(KINSOL_SRC_FILES:.c=.o) KINSOL_BL_OBJ_FILES = $(KINSOL_BL_SRC_FILES:.c=.o) KINSOL_LIB_FILES = $(KINSOL_SRC_FILES:.c=.lo) KINSOL_BL_LIB_FILES = $(KINSOL_BL_SRC_FILES:.c=.lo) SHARED_LIB_FILES = $(top_builddir)/src/sundials/sundials_band.lo \ $(top_builddir)/src/sundials/sundials_dense.lo \ $(top_builddir)/src/sundials/sundials_direct.lo \ $(top_builddir)/src/sundials/sundials_iterative.lo \ $(top_builddir)/src/sundials/sundials_spgmr.lo \ $(top_builddir)/src/sundials/sundials_spbcgs.lo \ $(top_builddir)/src/sundials/sundials_sptfqmr.lo \ $(top_builddir)/src/sundials/sundials_math.lo \ $(top_builddir)/src/sundials/sundials_nvector.lo mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(KINSOL_LIB) $(KINSOL_LIB): shared $(KINSOL_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: shared $(KINSOL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(KINSOL_LIB) $(KINSOL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) lib_with_bl: shared $(KINSOL_LIB_FILES) $(KINSOL_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(KINSOL_LIB) $(KINSOL_LIB_FILES) $(KINSOL_BL_LIB_FILES) $(SHARED_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -version-info $(LIB_REVISION) install: $(KINSOL_LIB) $(mkinstalldirs) $(includedir)/kinsol $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(KINSOL_LIB) $(libdir) $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_direct.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_dense.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_band.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_spgmr.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_spbcgs.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_sptfqmr.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_bbdpre.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_spils.h $(includedir)/kinsol/ $(INSTALL_HEADER) $(top_srcdir)/src/kinsol/kinsol_impl.h $(includedir)/kinsol/ @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ $(INSTALL_HEADER) $(top_srcdir)/include/kinsol/kinsol_lapack.h $(includedir)/kinsol/ ; \ fi uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(KINSOL_LIB) rm -f $(includedir)/kinsol/kinsol.h rm -f $(includedir)/kinsol/kinsol_direct.h rm -f $(includedir)/kinsol/kinsol_dense.h rm -f $(includedir)/kinsol/kinsol_band.h rm -f $(includedir)/kinsol/kinsol_lapack.h rm -f $(includedir)/kinsol/kinsol_spgmr.h rm -f $(includedir)/kinsol/kinsol_spbcgs.h rm -f $(includedir)/kinsol/kinsol_sptfqmr.h rm -f $(includedir)/kinsol/kinsol_bbdpre.h rm -f $(includedir)/kinsol/kinsol_spils.h rm -f $(includedir)/kinsol/kinsol_impl.h $(rminstalldirs) ${includedir}/kinsol shared: @cd ${top_builddir}/src/sundials ; \ ${MAKE} ; \ cd ${abs_builddir} clean: $(LIBTOOL) --mode=clean rm -f $(KINSOL_LIB) rm -f $(KINSOL_LIB_FILES) rm -f $(KINSOL_BL_LIB_FILES) rm -f $(KINSOL_OBJ_FILES) rm -f $(KINSOL_BL_OBJ_FILES) distclean: clean rm -f Makefile kinsol.lo: $(srcdir)/kinsol.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol.c kinsol_io.lo: $(srcdir)/kinsol_io.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_io.c kinsol_direct.lo: $(srcdir)/kinsol_direct.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_direct.c kinsol_dense.lo: $(srcdir)/kinsol_dense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_dense.c kinsol_band.lo: $(srcdir)/kinsol_band.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_band.c kinsol_lapack.lo: $(srcdir)/kinsol_lapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_lapack.c kinsol_spils.lo: $(srcdir)/kinsol_spils.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_spils.c kinsol_spgmr.lo: $(srcdir)/kinsol_spgmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_spgmr.c kinsol_spbcgs.lo: $(srcdir)/kinsol_spbcgs.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_spbcgs.c kinsol_sptfqmr.lo: $(srcdir)/kinsol_sptfqmr.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_sptfqmr.c kinsol_bbdpre.lo: $(srcdir)/kinsol_bbdpre.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/kinsol_bbdpre.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/kinsol/kinsol_bbdpre_impl.h0000600000175000017500000000467611741421272022325 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * KINBBDPRE module header file (private version) * ----------------------------------------------------------------- */ #ifndef _KINBBDPRE_IMPL_H #define _KINBBDPRE_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include #include "kinsol_impl.h" /* * ----------------------------------------------------------------- * Definition of KBBDData * ----------------------------------------------------------------- */ typedef struct KBBDPrecDataRec { /* passed by user to KINBBDPrecAlloc, used by pset/psolve functions */ long int mudq, mldq, mukeep, mlkeep; KINLocalFn gloc; KINCommFn gcomm; /* relative error for the Jacobian DQ routine */ realtype rel_uu; /* allocated for use by KINBBDPrecSetup */ N_Vector vtemp3; /* set by KINBBDPrecSetup and used by KINBBDPrecSolve */ DlsMat PP; long int *lpivots; /* set by KINBBDPrecAlloc and used by KINBBDPrecSetup */ long int n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to KINSol memory */ void *kin_mem; } *KBBDPrecData; /* *----------------------------------------------------------------- * KINBBDPRE error messages *----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "KINSOL Memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/kinsol_impl.h0000600000175000017500000005245611741421272021006 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2009/03/29 23:28:01 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * KINSOL solver module header file (private version) * ----------------------------------------------------------------- */ #ifndef _KINSOL_IMPL_H #define _KINSOL_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include /* * ================================================================= * M A I N S O L V E R M E M O R Y B L O C K * ================================================================= */ /* KINSOL default constants */ #define PRINTFL_DEFAULT 0 #define MXITER_DEFAULT 200 #define MXNBCF_DEFAULT 10 #define MSBSET_DEFAULT 10 #define MSBSET_SUB_DEFAULT 5 #define OMEGA_MIN RCONST(0.00001) #define OMEGA_MAX RCONST(0.9) /* * ----------------------------------------------------------------- * Types : struct KINMemRec and struct *KINMem * ----------------------------------------------------------------- * A variable declaration of type struct *KINMem denotes a * pointer to a data structure of type struct KINMemRec. The * KINMemRec structure contains numerous fields that must be * accessible by KINSOL solver module routines. * ----------------------------------------------------------------- */ typedef struct KINMemRec { realtype kin_uround; /* machine epsilon (or unit roundoff error) (defined in sundials_types.h) */ /* problem specification data */ KINSysFn kin_func; /* nonlinear system function implementation */ void *kin_user_data; /* work space available to func routine */ realtype kin_fnormtol; /* stopping tolerance on L2-norm of function value */ realtype kin_scsteptol; /* scaled step length tolerance */ int kin_globalstrategy; /* choices are KIN_NONE and KIN_LINESEARCH */ int kin_printfl; /* level of verbosity of output */ long int kin_mxiter; /* maximum number of nonlinear iterations */ long int kin_msbset; /* maximum number of nonlinear iterations that may be performed between calls to the linear solver setup routine (lsetup) */ long int kin_msbset_sub; /* subinterval length for residual monitoring */ long int kin_mxnbcf; /* maximum number of beta condition failures */ int kin_etaflag; /* choices are KIN_ETACONSTANT, KIN_ETACHOICE1 and KIN_ETACHOICE2 */ booleantype kin_noMinEps; /* flag controlling whether or not the value of eps is bounded below */ booleantype kin_setupNonNull; /* flag indicating if linear solver setup routine is non-null and if setup is used */ booleantype kin_constraintsSet; /* flag indicating if constraints are being used */ booleantype kin_jacCurrent; /* flag indicating if the Jacobian info. used by the linear solver is current */ booleantype kin_callForcingTerm; /* flag set if using either KIN_ETACHOICE1 or KIN_ETACHOICE2 */ booleantype kin_noResMon; /* flag indicating if the nonlinear residual monitoring scheme should be used */ booleantype kin_retry_nni; /* flag indicating if nonlinear iteration should be retried (set by residual monitoring algorithm) */ booleantype kin_update_fnorm_sub; /* flag indicating if the fnorm associated with the subinterval needs to be updated (set by residual monitoring algorithm) */ realtype kin_mxnewtstep; /* maximum allowable scaled step length */ realtype kin_sqrt_relfunc; /* relative error bound for func(u) */ realtype kin_stepl; /* scaled length of current step */ realtype kin_stepmul; /* step scaling factor */ realtype kin_eps; /* current value of eps */ realtype kin_eta; /* current value of eta */ realtype kin_eta_gamma; /* gamma value used in eta calculation (choice #2) */ realtype kin_eta_alpha; /* alpha value used in eta calculation (choice #2) */ booleantype kin_noInitSetup; /* flag controlling whether or not the KINSol routine makes an initial call to the linear solver setup routine (lsetup) */ realtype kin_sthrsh; /* threshold value for calling the linear solver setup routine */ /* counters */ long int kin_nni; /* number of nonlinear iterations */ long int kin_nfe; /* number of calls made to func routine */ long int kin_nnilset; /* value of nni counter when the linear solver setup was last called */ long int kin_nnilset_sub; /* value of nni counter when the linear solver setup was last called (subinterval) */ long int kin_nbcf; /* number of times the beta-condition could not be met in KINLineSearch */ long int kin_nbktrk; /* number of backtracks performed by KINLineSearch */ long int kin_ncscmx; /* number of consecutive steps of size mxnewtstep taken */ /* vectors */ N_Vector kin_uu; /* solution vector/current iterate (initially contains initial guess, but holds approximate solution upon completion if no errors occurred) */ N_Vector kin_unew; /* next iterate (unew = uu+pp) */ N_Vector kin_fval; /* vector containing result of nonlinear system function evaluated at a given iterate (fval = func(uu)) */ N_Vector kin_uscale; /* iterate scaling vector */ N_Vector kin_fscale; /* fval scaling vector */ N_Vector kin_pp; /* incremental change vector (pp = unew-uu) */ N_Vector kin_constraints; /* constraints vector */ N_Vector kin_vtemp1; /* scratch vector #1 */ N_Vector kin_vtemp2; /* scratch vector #2 */ /* space requirements for vector storage */ long int kin_lrw1; /* number of realtype-sized memory blocks needed for a single N_Vector */ long int kin_liw1; /* number of int-sized memory blocks needed for a single N_Vecotr */ long int kin_lrw; /* total number of realtype-sized memory blocks needed for all KINSOL work vectors */ long int kin_liw; /* total number of int-sized memory blocks needed for all KINSOL work vectors */ /* linear solver data */ /* function prototypes (pointers) */ int (*kin_linit)(struct KINMemRec *kin_mem); int (*kin_lsetup)(struct KINMemRec *kin_mem); int (*kin_lsolve)(struct KINMemRec *kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm ); void (*kin_lfree)(struct KINMemRec *kin_mem); booleantype kin_inexact_ls; /* flag set by the linear solver module (in linit) indicating whether this is an iterative linear solver (TRUE), or a direct linear solver (FALSE) */ void *kin_lmem; /* pointer to linear solver memory block */ realtype kin_fnorm; /* value of L2-norm of fscale*fval */ realtype kin_f1norm; /* f1norm = 0.5*(fnorm)^2 */ realtype kin_res_norm; /* value of L2-norm of residual (set by the linear solver) */ realtype kin_sfdotJp; /* value of scaled func(u) vector (fscale*fval) dotted with scaled J(u)*pp vector */ realtype kin_sJpnorm; /* value of L2-norm of fscale*(J(u)*pp) */ realtype kin_fnorm_sub; /* value of L2-norm of fscale*fval (subinterval) */ booleantype kin_eval_omega; /* flag indicating that omega must be evaluated. */ realtype kin_omega; /* constant value for real scalar used in test to determine if reduction of norm of nonlinear residual is sufficient. Unless a valid constant value is specified by the user, omega is estimated from omega_min and omega_max at each iteration. */ realtype kin_omega_min; /* lower bound on omega */ realtype kin_omega_max; /* upper bound on omega */ /* * ----------------------------------------------------------------- * Note: The KINLineSearch subroutine scales the values of the * variables sfdotJp and sJpnorm by a factor rl (lambda) that is * chosen by the line search algorithm such that the sclaed Newton * step satisfies the following conditions: * * F(u_k+1) <= F(u_k) + alpha*(F(u_k)^T * J(u_k))*p*rl * * F(u_k+1) >= F(u_k) + beta*(F(u_k)^T * J(u_k))*p*rl * * where alpha = 1.0e-4, beta = 0.9, u_k+1 = u_k + rl*p, * 0 < rl <= 1, J denotes the system Jacobian, and F represents * the nonliner system function. * ----------------------------------------------------------------- */ booleantype kin_MallocDone; /* flag indicating if KINMalloc has been called yet */ /* message files */ /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ KINErrHandlerFn kin_ehfun; /* Error messages are handled by ehfun */ void *kin_eh_data; /* dats pointer passed to ehfun */ FILE *kin_errfp; /* KINSOL error messages are sent to errfp */ KINInfoHandlerFn kin_ihfun; /* Info messages are handled by ihfun */ void *kin_ih_data; /* dats pointer passed to ihfun */ FILE *kin_infofp; /* where KINSol info messages are sent */ } *KINMem; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R * ================================================================= */ /* * ----------------------------------------------------------------- * Function : int (*kin_linit)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_linit initializes solver-specific data structures (including * variables used as counters or for storing statistical information), * but system memory allocation should be done by the subroutine * that actually initializes the environment for liner solver * package. If the linear system is to be preconditioned, then the * variable setupNonNull (type booleantype) should be set to TRUE * (predefined constant) and the kin_lsetup routine should be * appropriately defined. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * If the necessary variables have been successfully initialized, * then the kin_linit function should return 0 (zero). Otherwise, * the subroutine should indicate a failure has occurred by * returning a non-zero integer value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : int (*kin_lsetup)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_lsetup interfaces with the user-supplied pset subroutine (the * preconditioner setup routine), and updates relevant variable * values (see KINSpgmrSetup/KINSpbcgSetup). Simply stated, the * kin_lsetup routine prepares the linear solver for a subsequent * call to the user-supplied kin_lsolve function. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * If successful, the kin_lsetup routine should return 0 (zero). * Otherwise it should return a non-zero value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : int (*kin_lsolve)(KINMem kin_mem, N_Vector xx, * N_Vector bb, realtype *res_norm) * ----------------------------------------------------------------- * kin_lsolve interfaces with the subroutine implementing the * numerical method to be used to solve the linear system J*xx = bb, * and must increment the relevant counter variable values in * addition to computing certain values used by the global strategy * and forcing term routines (see KINInexactNewton, KINLineSearch, * KINForcingTerm, and KINSpgmrSolve/KINSpbcgSolve). * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * xx vector (type N_Vector) set to initial guess by kin_lsolve * routine prior to calling the linear solver, but which upon * return contains an approximate solution of the linear * system J*xx = bb, where J denotes the system Jacobian * * bb vector (type N_Vector) set to -func(u) (negative of the * value of the system function evaluated at the current * iterate) by KINLinSolDrv before kin_lsolve is called * * res_norm holds the value of the L2-norm (Euclidean norm) of * the residual vector upon return * * If successful, the kin_lsolve routine should return 0 (zero). * Otherwise it should return a positive value if a re-evaluation * of the lsetup function could recover, or a negative value if * no such recovery is possible. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : void (*kin_lfree)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_lfree is called by KINFree and should free (deallocate) all * system memory resources allocated for the linear solver module * (see KINSpgmrFree/KINSpbcgFree). * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * ----------------------------------------------------------------- */ /* * ================================================================= * K I N S O L I N T E R N A L F U N C T I O N S * ================================================================= */ /* High level error handler */ void KINProcessError(KINMem kin_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void KINErrHandler(int error_code, const char *module, const char *function, char *msg, void *user_data); /* High level info handler */ void KINPrintInfo(KINMem kin_mem, int info_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal infoHandler function */ void KINInfoHandler(const char *module, const char *function, char *msg, void *user_data); /* * ================================================================= * K I N S O L E R R O R M E S S A G E S * ================================================================= */ #define MSG_MEM_FAIL "A memory request failed." #define MSG_NO_MEM "kinsol_mem = NULL illegal." #define MSG_BAD_NVECTOR "A required vector operation is not implemented." #define MSG_FUNC_NULL "func = NULL illegal." #define MSG_NO_MALLOC "Attempt to call before KINMalloc illegal." #define MSG_BAD_PRINTFL "Illegal value for printfl." #define MSG_BAD_MXITER "Illegal value for mxiter." #define MSG_BAD_MSBSET "Illegal msbset < 0." #define MSG_BAD_MSBSETSUB "Illegal msbsetsub < 0." #define MSG_BAD_ETACHOICE "Illegal value for etachoice." #define MSG_BAD_ETACONST "eta out of range." #define MSG_BAD_GAMMA "gamma out of range." #define MSG_BAD_ALPHA "alpha out of range." #define MSG_BAD_MXNEWTSTEP "Illegal mxnewtstep < 0." #define MSG_BAD_RELFUNC "relfunc < 0 illegal." #define MSG_BAD_FNORMTOL "fnormtol < 0 illegal." #define MSG_BAD_SCSTEPTOL "scsteptol < 0 illegal." #define MSG_BAD_MXNBCF "mxbcf < 0 illegal." #define MSG_BAD_CONSTRAINTS "Illegal values in constraints vector." #define MSG_BAD_OMEGA "scalars < 0 illegal." #define MSG_LSOLV_NO_MEM "The linear solver memory pointer is NULL." #define MSG_UU_NULL "uu = NULL illegal." #define MSG_BAD_GLSTRAT "Illegal value for global strategy." #define MSG_BAD_USCALE "uscale = NULL illegal." #define MSG_USCALE_NONPOSITIVE "uscale has nonpositive elements." #define MSG_BAD_FSCALE "fscale = NULL illegal." #define MSG_FSCALE_NONPOSITIVE "fscale has nonpositive elements." #define MSG_INITIAL_CNSTRNT "Initial guess does NOT meet constraints." #define MSG_LINIT_FAIL "The linear solver's init routine failed." #define MSG_SYSFUNC_FAILED "The system function failed in an unrecoverable manner." #define MSG_SYSFUNC_FIRST "The system function failed at the first call." #define MSG_LSETUP_FAILED "The linear solver's setup function failed in an unrecoverable manner." #define MSG_LSOLVE_FAILED "The linear solver's solve function failed in an unrecoverable manner." #define MSG_LINSOLV_NO_RECOVERY "The linear solver's solve function failed recoverably, but the Jacobian data is already current." #define MSG_LINESEARCH_NONCONV "The line search algorithm was unable to find an iterate sufficiently distinct from the current iterate." #define MSG_LINESEARCH_BCFAIL "The line search algorithm was unable to satisfy the beta-condition for nbcfails iterations." #define MSG_MAXITER_REACHED "The maximum number of iterations was reached before convergence." #define MSG_MXNEWT_5X_EXCEEDED "Five consecutive steps have been taken that satisfy a scaled step length test." #define MSG_SYSFUNC_REPTD "Unable to correct repeated recoverable system function errors." /* * ================================================================= * K I N S O L I N F O M E S S A G E S * ================================================================= */ #define INFO_RETVAL "Return value: %d" #define INFO_ADJ "no. of lambda adjustments = %ld" #if defined(SUNDIALS_EXTENDED_PRECISION) #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16Lg" #define INFO_TOL "scsteptol = %12.3Lg fnormtol = %12.3Lg" #define INFO_FMAX "scaled f norm (for stopping) = %12.3Lg" #define INFO_PNORM "pnorm = %12.4Le" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4Le" #define INFO_FNORM "fnorm(L2) = %20.8Le" #define INFO_LAM "min_lam = %11.4Le f1norm = %11.4Le pnorm = %11.4Le" #define INFO_ALPHA "fnorm = %15.8Le f1norm = %15.8Le alpha_cond = %15.8Le lam = %15.8Le" #define INFO_BETA "f1norm = %15.8Le beta_cond = %15.8Le lam = %15.8Le" #define INFO_ALPHABETA "f1norm = %15.8Le alpha_cond = %15.8Le beta_cond = %15.8Le lam = %15.8Le" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16lg" #define INFO_TOL "scsteptol = %12.3lg fnormtol = %12.3lg" #define INFO_FMAX "scaled f norm (for stopping) = %12.3lg" #define INFO_PNORM "pnorm = %12.4le" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4le" #define INFO_FNORM "fnorm(L2) = %20.8le" #define INFO_LAM "min_lam = %11.4le f1norm = %11.4le pnorm = %11.4le" #define INFO_ALPHA "fnorm = %15.8le f1norm = %15.8le alpha_cond = %15.8le lam = %15.8le" #define INFO_BETA "f1norm = %15.8le beta_cond = %15.8le lam = %15.8le" #define INFO_ALPHABETA "f1norm = %15.8le alpha_cond = %15.8le beta_cond = %15.8le lam = %15.8le" #else #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16g" #define INFO_TOL "scsteptol = %12.3g fnormtol = %12.3g" #define INFO_FMAX "scaled f norm (for stopping) = %12.3g" #define INFO_PNORM "pnorm = %12.4e" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4e" #define INFO_FNORM "fnorm(L2) = %20.8e" #define INFO_LAM "min_lam = %11.4e f1norm = %11.4e pnorm = %11.4e" #define INFO_ALPHA "fnorm = %15.8e f1norm = %15.8e alpha_cond = %15.8e lam = %15.8e" #define INFO_BETA "f1norm = %15.8e beta_cond = %15.8e lam = %15.8e" #define INFO_ALPHABETA "f1norm = %15.8e alpha_cond = %15.8e beta_cond = %15.8e lam = %15.8e" #endif #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/kinsol_spgmr.c0000600000175000017500000003130211741421272021153 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2007/11/26 16:20:01 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINSOL scaled, * preconditioned GMRES linear solver, KINSpgmr. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_impl.h" #include #include "kinsol_spils_impl.h" #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ----------------------------------------------------------------- * function prototypes * ----------------------------------------------------------------- */ /* KINSpgmr linit, lsetup, lsolve, and lfree routines */ static int KINSpgmrInit(KINMem kin_mem); static int KINSpgmrSetup(KINMem kin_mem); static int KINSpgmrSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm); static void KINSpgmrFree(KINMem kin_mem); /* * ----------------------------------------------------------------- * readability replacements * ----------------------------------------------------------------- */ #define nni (kin_mem->kin_nni) #define nnilset (kin_mem->kin_nnilset) #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define jacCurrent (kin_mem->kin_jacCurrent) #define eps (kin_mem->kin_eps) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define pretype (kinspils_mem->s_pretype) #define gstype (kinspils_mem->s_gstype) #define nli (kinspils_mem->s_nli) #define npe (kinspils_mem->s_npe) #define nps (kinspils_mem->s_nps) #define ncfl (kinspils_mem->s_ncfl) #define njtimes (kinspils_mem->s_njtimes) #define nfes (kinspils_mem->s_nfes) #define new_uu (kinspils_mem->s_new_uu) #define spils_mem (kinspils_mem->s_spils_mem) #define jtimesDQ (kinspils_mem->s_jtimesDQ) #define jtimes (kinspils_mem->s_jtimes) #define J_data (kinspils_mem->s_J_data) #define last_flag (kinspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : KINSpgmr * ----------------------------------------------------------------- * This routine allocates and initializes the memory record and * sets function fields specific to the SPGMR linear solver module. * KINSpgmr sets the kin_linit, kin_lsetup, kin_lsolve, and * kin_lfree fields in *kinmem to be KINSpgmrInit, KINSpgmrSetup, * KINSpgmrSolve, and KINSpgmrFree, respectively. It allocates * memory for a structure of type KINSpilsMemRec and sets the * kin_lmem field in *kinmem to the address of this structure. It * also calls SpgmrMalloc to allocate memory for the module * SPGMR. In summary, KINSpgmr sets various fields in the * KINSpilsMemRec structure. * ----------------------------------------------------------------- */ int KINSpgmr(void *kinmem, int maxl) { KINMem kin_mem; KINSpilsMem kinspils_mem; SpgmrMem spgmr_mem; int maxl1; if (kinmem == NULL){ KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpgmr", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check for required vector operations */ /* Note: do NOT need to check for N_VLinearSum, N_VProd, N_VScale, N_VDiv, or N_VWL2Norm because they are required by KINSOL */ if ((vec_tmpl->ops->nvconst == NULL) || (vec_tmpl->ops->nvdotprod == NULL) || (vec_tmpl->ops->nvl1norm == NULL)) { KINProcessError(NULL, KINSPILS_ILL_INPUT, "KINSPILS", "KINSpgmr", MSGS_BAD_NVECTOR); return(KINSPILS_ILL_INPUT); } if (lfree != NULL) lfree(kin_mem); /* set four main function fields in kin_mem */ linit = KINSpgmrInit; lsetup = KINSpgmrSetup; lsolve = KINSpgmrSolve; lfree = KINSpgmrFree; /* get memory for KINSpilsMemRec */ kinspils_mem = NULL; kinspils_mem = (KINSpilsMem) malloc(sizeof(struct KINSpilsMemRec)); if (kinspils_mem == NULL){ KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpgmr", MSGS_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* Set ILS type */ kinspils_mem->s_type = SPILS_SPGMR; /* set SPGMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? KINSPILS_MAXL : maxl; kinspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; J_data = NULL; /* Set defaults for preconditioner-related fields */ kinspils_mem->s_pset = NULL; kinspils_mem->s_psolve = NULL; kinspils_mem->s_pfree = NULL; kinspils_mem->s_P_data = kin_mem->kin_user_data; /* Set default values for the rest of the SPGMR parameters */ kinspils_mem->s_pretype = PREC_NONE; kinspils_mem->s_gstype = MODIFIED_GS; kinspils_mem->s_maxlrst = 0; kinspils_mem->s_last_flag = KINSPILS_SUCCESS; /* Call SpgmrMalloc to allocate workspace for SPGMR */ /* vec_tmpl passed as template vector */ spgmr_mem = NULL; spgmr_mem = SpgmrMalloc(maxl1, vec_tmpl); if (spgmr_mem == NULL) { KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpgmr", MSGS_MEM_FAIL); free(kinspils_mem); kinspils_mem = NULL; return(KINSPILS_MEM_FAIL); } /* This is an iterative linear solver */ inexact_ls = TRUE; /* Attach SPGMR memory to spils memory structure */ spils_mem = (void *) spgmr_mem; /* attach linear solver memory to KINSOL memory */ lmem = kinspils_mem; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * additional readability replacements * ----------------------------------------------------------------- */ #define maxl (kinspils_mem->s_maxl) #define maxlrst (kinspils_mem->s_maxlrst) #define pset (kinspils_mem->s_pset) #define psolve (kinspils_mem->s_psolve) #define P_data (kinspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : KINSpgmrInit * ----------------------------------------------------------------- * This routine initializes variables associated with the GMRES * linear solver. Memory allocation was done previously in * KINSpgmr. * ----------------------------------------------------------------- */ static int KINSpgmrInit(KINMem kin_mem) { KINSpilsMem kinspils_mem; kinspils_mem = (KINSpilsMem) lmem; /* initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nfes = 0; /* set preconditioner type */ if (psolve != NULL) { pretype = PREC_RIGHT; } else { pretype = PREC_NONE; } /* set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = (psolve != NULL) && (pset != NULL); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = KINSpilsDQJtimes; J_data = kin_mem; } else { J_data = user_data; } last_flag = KINSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : KINSpgmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the SPGMR linear * solver, that is, it is an interface to the user-supplied * routine pset. * ----------------------------------------------------------------- */ static int KINSpgmrSetup(KINMem kin_mem) { KINSpilsMem kinspils_mem; int ret; kinspils_mem = (KINSpilsMem) lmem; /* call pset routine */ ret = pset(uu, uscale, fval, fscale, P_data, vtemp1, vtemp2); last_flag = ret; npe++; nnilset = nni; /* return the same value ret that pset returned */ return(ret); } /* * ----------------------------------------------------------------- * Function : KINSpgmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic SPGMR solver * SpgmrSolve for the solution of the linear system Ax = b. * * Appropriate variables are passed to SpgmrSolve and the counters * nli, nps, and ncfl are incremented, and the return value is set * according to the success of SpgmrSolve. The success flag is * returned if SpgmrSolve converged, or if the residual was reduced. * Of the other error conditions, only preconditioner solver * failure is specifically returned. Otherwise a generic flag is * returned to denote failure of this routine. * ----------------------------------------------------------------- */ static int KINSpgmrSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm) { KINSpilsMem kinspils_mem; SpgmrMem spgmr_mem; int ret, nli_inc, nps_inc; kinspils_mem = (KINSpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; /* Set initial guess to xx = 0. bb is set, by the routine calling KINSpgmrSolve, to the RHS vector for the system to be solved. */ N_VConst(ZERO, xx); new_uu = TRUE; /* set flag required for user Jacobian routine */ /* call SpgmrSolve */ ret = SpgmrSolve(spgmr_mem, kin_mem, xx, bb, pretype, gstype, eps, maxlrst, kin_mem, fscale, fscale, KINSpilsAtimes, KINSpilsPSolve, res_norm, &nli_inc, &nps_inc); /* increment counters nli, nps, and ncfl (nni is updated in the KINSol main iteration loop) */ nli = nli + (long int) nli_inc; nps = nps + (long int) nps_inc; if (printfl > 2) KINPrintInfo(kin_mem, PRNT_NLI, "KINSPGMR", "KINSpgmrSolve", INFO_NLI, nli_inc); if (ret != 0) ncfl++; /* Compute the terms sJpnorm and sfdotJp for use in the global strategy routines and in KINForcingTerm. Both of these terms are subsequently corrected if the step is reduced by constraints or the line search. sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p. sfdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale. */ ret = KINSpilsAtimes(kin_mem, xx, bb); if (ret == 0) ret = SPGMR_SUCCESS; else if (ret > 0) ret = SPGMR_ATIMES_FAIL_REC; else if (ret < 0) ret = SPGMR_ATIMES_FAIL_UNREC; sJpnorm = N_VWL2Norm(bb,fscale); N_VProd(bb, fscale, bb); N_VProd(bb, fscale, bb); sfdotJp = N_VDotProd(fval, bb); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_EPS, "KINSPGMR", "KINSpgmrSolve", INFO_EPS, *res_norm, eps); /* Interpret return value from SpgmrSolve */ last_flag = ret; switch(ret) { case SPGMR_SUCCESS: case SPGMR_RES_REDUCED: return(0); break; case SPGMR_PSOLVE_FAIL_REC: case SPGMR_ATIMES_FAIL_REC: return(1); break; case SPGMR_CONV_FAIL: case SPGMR_QRFACT_FAIL: case SPGMR_MEM_NULL: case SPGMR_GS_FAIL: case SPGMR_QRSOL_FAIL: case SPGMR_ATIMES_FAIL_UNREC: case SPGMR_PSOLVE_FAIL_UNREC: return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : KINSpgmrFree * ----------------------------------------------------------------- * This routine frees memory specific to the SPGMR linear solver. * ----------------------------------------------------------------- */ static void KINSpgmrFree(KINMem kin_mem) { KINSpilsMem kinspils_mem; SpgmrMem spgmr_mem; kinspils_mem = (KINSpilsMem) lmem; spgmr_mem = (SpgmrMem) spils_mem; SpgmrFree(spgmr_mem); if (kinspils_mem->s_pfree != NULL) (kinspils_mem->s_pfree)(kin_mem); free(kinspils_mem); kinspils_mem = NULL; } sundials-2.5.0/src/kinsol/kinsol_sptfqmr.c0000600000175000017500000003155511741421272021531 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2007/11/26 16:20:01 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier and Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINSOL interface to the * scaled, preconditioned TFQMR (SPTFQMR) iterative linear solver. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_impl.h" #include #include "kinsol_spils_impl.h" #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ----------------------------------------------------------------- * function prototypes * ----------------------------------------------------------------- */ /* KINSptfqmr linit, lsetup, lsolve, and lfree routines */ static int KINSptfqmrInit(KINMem kin_mem); static int KINSptfqmrSetup(KINMem kin_mem); static int KINSptfqmrSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm); static void KINSptfqmrFree(KINMem kin_mem); /* * ----------------------------------------------------------------- * readability replacements * ----------------------------------------------------------------- */ #define nni (kin_mem->kin_nni) #define nnilset (kin_mem->kin_nnilset) #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define eps (kin_mem->kin_eps) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define pretype (kinspils_mem->s_pretype) #define nli (kinspils_mem->s_nli) #define npe (kinspils_mem->s_npe) #define nps (kinspils_mem->s_nps) #define ncfl (kinspils_mem->s_ncfl) #define njtimes (kinspils_mem->s_njtimes) #define nfes (kinspils_mem->s_nfes) #define new_uu (kinspils_mem->s_new_uu) #define spils_mem (kinspils_mem->s_spils_mem) #define jtimesDQ (kinspils_mem->s_jtimesDQ) #define jtimes (kinspils_mem->s_jtimes) #define J_data (kinspils_mem->s_J_data) #define last_flag (kinspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : KINSptfqmr * ----------------------------------------------------------------- * This routine allocates and initializes the memory record and * sets function fields specific to the SPTFQMR linear solver module. * KINSptfqmr sets the kin_linit, kin_lsetup, kin_lsolve, and * kin_lfree fields in *kinmem to be KINSptfqmrInit, KINSptfqmrSetup, * KINSptfqmrSolve, and KINSptfqmrFree, respectively. It allocates * memory for a structure of type KINSpilsMemRec and sets the * kin_lmem field in *kinmem to the address of this structure. It * also calls SptfqmrMalloc to allocate memory for the module * SPTFQMR. It sets setupNonNull in (*kin_mem), * and sets various fields in the KINSpilsMemRec structure. * Finally, KINSptfqmr allocates memory for local vectors, and calls * SptfqmrMalloc to allocate memory for the Sptfqmr solver. * ----------------------------------------------------------------- */ int KINSptfqmr(void *kinmem, int maxl) { KINMem kin_mem; KINSpilsMem kinspils_mem; SptfqmrMem sptfqmr_mem; int maxl1; if (kinmem == NULL){ KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSptfqmr", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check for required vector operations */ /* Note: do NOT need to check for N_VLinearSum, N_VProd, N_VScale, N_VDiv, or N_VWL2Norm because they are required by KINSOL */ if ((vec_tmpl->ops->nvconst == NULL) || (vec_tmpl->ops->nvdotprod == NULL) || (vec_tmpl->ops->nvl1norm == NULL)) { KINProcessError(NULL, KINSPILS_ILL_INPUT, "KINSPILS", "KINSptfqmr", MSGS_BAD_NVECTOR); return(KINSPILS_ILL_INPUT); } if (lfree != NULL) lfree(kin_mem); /* set four main function fields in kin_mem */ linit = KINSptfqmrInit; lsetup = KINSptfqmrSetup; lsolve = KINSptfqmrSolve; lfree = KINSptfqmrFree; /* get memory for KINSpilsMemRec */ kinspils_mem = NULL; kinspils_mem = (KINSpilsMem) malloc(sizeof(struct KINSpilsMemRec)); if (kinspils_mem == NULL){ KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSptfqmr", MSGS_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* Set ILS type */ kinspils_mem->s_type = SPILS_SPTFQMR; /* set SPTFQMR parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? KINSPILS_MAXL : maxl; kinspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; J_data = NULL; /* Set defaults for preconditioner-related fields */ kinspils_mem->s_pset = NULL; kinspils_mem->s_psolve = NULL; kinspils_mem->s_pfree = NULL; kinspils_mem->s_P_data = kin_mem->kin_user_data; /* Set default values for the rest of the SPTFQMR parameters */ kinspils_mem->s_pretype = PREC_NONE; kinspils_mem->s_last_flag = KINSPILS_SUCCESS; /* Call SptfqmrMalloc to allocate workspace for SPTFQMR */ /* vec_tmpl passed as template vector */ sptfqmr_mem = NULL; sptfqmr_mem = SptfqmrMalloc(maxl1, vec_tmpl); if (sptfqmr_mem == NULL) { KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSptfqmr", MSGS_MEM_FAIL); free(kinspils_mem); kinspils_mem = NULL; return(KINSPILS_MEM_FAIL); } /* this is an iterative linear solver */ inexact_ls = TRUE; /* Attach SPTFQMR memory to spils memory structure */ spils_mem = (void *) sptfqmr_mem; /* attach linear solver memory to KINSOL memory */ lmem = kinspils_mem; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * additional readability replacements * ----------------------------------------------------------------- */ #define maxl (kinspils_mem->s_maxl) #define pset (kinspils_mem->s_pset) #define psolve (kinspils_mem->s_psolve) #define P_data (kinspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : KINSptfqmrInit * ----------------------------------------------------------------- * This routine initializes variables associated with the SPTFQMR * iterative linear solver. Memory allocation was done previously * in KINSptfqmr. * ----------------------------------------------------------------- */ static int KINSptfqmrInit(KINMem kin_mem) { KINSpilsMem kinspils_mem; SptfqmrMem sptfqmr_mem; kinspils_mem = (KINSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* initialize counters */ npe = nli = nps = ncfl = 0; njtimes = nfes = 0; /* set preconditioner type */ if (psolve != NULL) { pretype = PREC_RIGHT; } else { pretype = PREC_NONE; } /* set setupNonNull to TRUE iff there is preconditioning with setup */ setupNonNull = ((psolve != NULL) && (pset != NULL)); /* Set Jacobian-related fields, based on jtimesDQ */ if (jtimesDQ) { jtimes = KINSpilsDQJtimes; J_data = kin_mem; } else { J_data = user_data; } /* Set maxl in the SPTFQMR memory in case it was changed by the user */ sptfqmr_mem->l_max = maxl; last_flag = KINSPILS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * Function : KINSptfqmrSetup * ----------------------------------------------------------------- * This routine does the setup operations for the SPTFQMR linear * solver, that is, it is an interface to the user-supplied * routine pset. * ----------------------------------------------------------------- */ static int KINSptfqmrSetup(KINMem kin_mem) { KINSpilsMem kinspils_mem; int ret; kinspils_mem = (KINSpilsMem) lmem; /* call pset routine */ ret = pset(uu, uscale, fval, fscale, P_data, vtemp1, vtemp2); last_flag = ret; npe++; nnilset = nni; /* return the same value ret that pset returned */ return(ret); } /* * ----------------------------------------------------------------- * Function : KINSptfqmrSolve * ----------------------------------------------------------------- * This routine handles the call to the generic SPTFQMR solver routine * called SptfqmrSolve for the solution of the linear system Ax = b. * * Appropriate variables are passed to SptfqmrSolve and the counters * nli, nps, and ncfl are incremented, and the return value is set * according to the success of SptfqmrSolve. The success flag is * returned if SptfqmrSolve converged, or if the residual was reduced. * Of the other error conditions, only preconditioner solver * failure is specifically returned. Otherwise a generic flag is * returned to denote failure of this routine. * ----------------------------------------------------------------- */ static int KINSptfqmrSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *res_norm) { KINSpilsMem kinspils_mem; SptfqmrMem sptfqmr_mem; int ret, nli_inc, nps_inc; kinspils_mem = (KINSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; /* Set initial guess to xx = 0. bb is set, by the routine calling KINSptfqmrSolve, to the RHS vector for the system to be solved. */ N_VConst(ZERO, xx); new_uu = TRUE; /* set flag required for user Jacobian routine */ /* call SptfqmrSolve */ ret = SptfqmrSolve(sptfqmr_mem, kin_mem, xx, bb, pretype, eps, kin_mem, fscale, fscale, KINSpilsAtimes, KINSpilsPSolve, res_norm, &nli_inc, &nps_inc); /* increment counters nli, nps, and ncfl (nni is updated in the KINSol main iteration loop) */ nli = nli + (long int) nli_inc; nps = nps + (long int) nps_inc; if (printfl > 2) KINPrintInfo(kin_mem, PRNT_NLI, "KINSPTFQMR", "KINSptfqmrSolve", INFO_NLI, nli_inc); if (ret != 0) ncfl++; /* Compute the terms sJpnorm and sfdotJp for use in the global strategy routines and in KINForcingTerm. Both of these terms are subsequently corrected if the step is reduced by constraints or the line search. sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p. sfdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale. */ ret = KINSpilsAtimes(kin_mem, xx, bb); if (ret == 0) ret = SPTFQMR_SUCCESS; else if (ret > 0) ret = SPTFQMR_ATIMES_FAIL_REC; else if (ret < 0) ret = SPTFQMR_ATIMES_FAIL_UNREC; sJpnorm = N_VWL2Norm(bb,fscale); N_VProd(bb, fscale, bb); N_VProd(bb, fscale, bb); sfdotJp = N_VDotProd(fval, bb); if (printfl > 2) KINPrintInfo(kin_mem, PRNT_EPS, "KINSPTFQMR", "KINSptfqmrSolve", INFO_EPS, *res_norm, eps); /* Interpret return value from SptfqmrSolve */ last_flag = ret; switch(ret) { case SPTFQMR_SUCCESS: case SPTFQMR_RES_REDUCED: return(0); break; case SPTFQMR_PSOLVE_FAIL_REC: return(1); break; case SPTFQMR_ATIMES_FAIL_REC: return(1); break; case SPTFQMR_CONV_FAIL: case SPTFQMR_MEM_NULL: case SPTFQMR_ATIMES_FAIL_UNREC: case SPTFQMR_PSOLVE_FAIL_UNREC: return(-1); break; } return(0); } /* * ----------------------------------------------------------------- * Function : KINSptfqmrFree * ----------------------------------------------------------------- * Frees memory specific to the SPTFQMR linear solver module. * ----------------------------------------------------------------- */ static void KINSptfqmrFree(KINMem kin_mem) { KINSpilsMem kinspils_mem; SptfqmrMem sptfqmr_mem; kinspils_mem = (KINSpilsMem) lmem; sptfqmr_mem = (SptfqmrMem) spils_mem; SptfqmrFree(sptfqmr_mem); if (kinspils_mem->s_pfree != NULL) (kinspils_mem->s_pfree)(kin_mem); free(kinspils_mem); kinspils_mem = NULL; } sundials-2.5.0/src/kinsol/kinsol_lapack.c0000600000175000017500000004504011741421272021262 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.11 $ * $Date: 2011/02/16 22:43:28 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for a KINSOL dense linear solver * using BLAS and LAPACK functions. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include "kinsol_direct_impl.h" #include "kinsol_impl.h" #include /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * PROTOTYPES FOR PRIVATE FUNCTIONS * ================================================================= */ /* KINLAPACK DENSE linit, lsetup, lsolve, and lfree routines */ static int kinLapackDenseInit(KINMem kin_mem); static int kinLapackDenseSetup(KINMem kin_mem); static int kinLapackDenseSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm); static void kinLapackDenseFree(KINMem kin_mem); /* KINLAPACK BAND linit, lsetup, lsolve, and lfree routines */ static int kinLapackBandInit(KINMem kin_mem); static int kinLapackBandSetup(KINMem kin_mem); static int kinLapackBandSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm); static void kinLapackBandFree(KINMem kin_mem); /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define lrw1 (kin_mem->kin_lrw1) #define liw1 (kin_mem->kin_liw1) #define func (kin_mem->kin_func) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define mtype (kindls_mem->d_type) #define n (kindls_mem->d_n) #define ml (kindls_mem->d_ml) #define mu (kindls_mem->d_mu) #define smu (kindls_mem->d_smu) #define jacDQ (kindls_mem->d_jacDQ) #define djac (kindls_mem->d_djac) #define bjac (kindls_mem->d_bjac) #define J (kindls_mem->d_J) #define pivots (kindls_mem->d_pivots) #define nje (kindls_mem->d_nje) #define nfeDQ (kindls_mem->d_nfeDQ) #define J_data (kindls_mem->d_J_data) #define last_flag (kindls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * KINLapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. KINLapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the kin_linit, kin_lsetup, kin_lsolve, kin_lfree fields in (*kinmem) * to be kinLapackDenseInit, kinLapackDenseSetup, kinLapackDenseSolve, * and kinLapackDenseFree, respectively. It allocates memory for a * structure of type KINDlsMemRec and sets the kin_lmem field in * (*kinmem) to the address of this structure. It sets lsetup_exists * in (*kinmem) to TRUE, and the djac field to the default * kinLapackDenseDQJac. Finally, it allocates memory for M, pivots, and * (if needed) savedJ. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, KINLapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int KINLapackDense(void *kinmem, int N) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINLAPACK", "KINLapackDense", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINLAPACK", "KINLapackDense", MSGD_BAD_NVECTOR); return(KINDLS_ILL_INPUT); } if (lfree !=NULL) lfree(kin_mem); /* Set four main function fields in kin_mem */ linit = kinLapackDenseInit; lsetup = kinLapackDenseSetup; lsolve = kinLapackDenseSolve; lfree = kinLapackDenseFree; /* Get memory for KINDlsMemRec */ kindls_mem = NULL; kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec)); if (kindls_mem == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL); return(KINDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = KINDLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for J and pivot array */ J = NULL; J = NewDenseMat(n, n); if (J == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } pivots = NULL; pivots = NewIntArray(N); if (pivots == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackDense", MSGD_MEM_FAIL); DestroyMat(J); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } /* This is a direct linear solver */ inexact_ls = FALSE; /* Attach linear solver memory to integrator memory */ lmem = kindls_mem; return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINLapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * kin_linit, kin_lsetup, kin_lsolve, and kin_lfree fields in (*kinmem) * to be kinLapackBandInit, kinLapackBandSetup, kinLapackBandSolve, * and kinLapackBandFree, respectively. It allocates memory for a * structure of type KINLapackBandMemRec and sets the kin_lmem field in * (*kinmem) to the address of this structure. It sets lsetup_exists * in (*kinmem) to be TRUE, mu to be mupper, ml to be mlower, and * the bjac field to kinDlsBandDQJac * Finally, it allocates memory for M, pivots, and (if needed) savedJ. * The KINLapackBand return value is KINDLS_SUCCESS = 0, * KINDLS_MEM_FAIL = -1, or KINDLS_ILL_INPUT = -2. * * NOTE: The KINLAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, KINLapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int KINLapackBand(void *kinmem, int N, int mupper, int mlower) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINLAPACK", "KINLapackBand", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL) { KINProcessError(kin_mem, KINDLS_ILL_INPUT, "KINLAPACK", "KINLapackBand", MSGD_BAD_NVECTOR); return(KINDLS_ILL_INPUT); } if (lfree != NULL) lfree(kin_mem); /* Set four main function fields in kin_mem */ linit = kinLapackBandInit; lsetup = kinLapackBandSetup; lsolve = kinLapackBandSolve; lfree = kinLapackBandFree; /* Get memory for KINDlsMemRec */ kindls_mem = NULL; kindls_mem = (KINDlsMem) malloc(sizeof(struct KINDlsMemRec)); if (kindls_mem == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL); return(KINDLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = KINDLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwidths in kindls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for J and pivot array */ J = NULL; J = NewBandMat(n, mu, ml, smu); if (J == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } pivots = NULL; pivots = NewIntArray(N); if (pivots == NULL) { KINProcessError(kin_mem, KINDLS_MEM_FAIL, "KINLAPACK", "KINLapackBand", MSGD_MEM_FAIL); DestroyMat(J); free(kindls_mem); kindls_mem = NULL; return(KINDLS_MEM_FAIL); } /* This is a direct linear solver */ inexact_ls = FALSE; /* Attach linear solver memory to integrator memory */ lmem = kindls_mem; return(KINDLS_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS FOR SOLUTION WITH DENSE JACOBIANS * ================================================================= */ /* * ----------------------------------------------------------------- * kinLapackDenseInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the dense * linear solver. * ----------------------------------------------------------------- */ static int kinLapackDenseInit(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; nje = 0; nfeDQ = 0; if (jacDQ) { djac = kinDlsDenseDQJac; J_data = kin_mem; } else { J_data = kin_mem->kin_user_data; } last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinLapackDenseSetup * ----------------------------------------------------------------- * This routine does the setup operations for the dense linear solver. * It calls the dense LU factorization routine. * ----------------------------------------------------------------- */ static int kinLapackDenseSetup(KINMem kin_mem) { KINDlsMem kindls_mem; int ier, retval; int intn; kindls_mem = (KINDlsMem) lmem; intn = (int) n; nje++; SetToZero(J); retval = djac(n, uu, fval, J, J_data, vtemp1, vtemp2); if (retval != 0) { last_flag = -1; return(-1); } /* Do LU factorization of J */ dgetrf_f77(&intn, &intn, J->data, &intn, pivots, &ier); /* Return 0 if the LU was complete; otherwise return -1 */ last_flag = (long int) ier; if (ier > 0) return(-1); return(0); } /* * ----------------------------------------------------------------- * kinLapackDenseSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the dense linear solver * by calling the dense backsolve routine. The returned value is 0. * ----------------------------------------------------------------- */ static int kinLapackDenseSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm) { KINDlsMem kindls_mem; realtype *xd; int ier, one = 1; int intn; kindls_mem = (KINDlsMem) lmem; intn = (int) n; /* Copy the right-hand side into x */ N_VScale(ONE, b, x); xd = N_VGetArrayPointer(x); /* Back-solve and get solution in x */ dgetrs_f77("N", &intn, &one, J->data, &intn, pivots, xd, &intn, &ier, 1); if (ier > 0) return(-1); /* Compute the terms Jpnorm and sfdotJp for use in the global strategy * routines and in KINForcingTerm. Both of these terms are subsequently * corrected if the step is reduced by constraints or the line search. * * sJpnorm is the norm of the scaled product (scaled by fscale) of * the current Jacobian matrix J and the step vector p. * * sfdotJp is the dot product of the scaled f vector and the scaled * vector J*p, where the scaling uses fscale. */ sJpnorm = N_VWL2Norm(b,fscale); N_VProd(b, fscale, b); N_VProd(b, fscale, b); sfdotJp = N_VDotProd(fval, b); last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinLapackDenseFree * ----------------------------------------------------------------- * This routine frees memory specific to the dense linear solver. * ----------------------------------------------------------------- */ static void kinLapackDenseFree(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; DestroyMat(J); DestroyArray(pivots); free(kindls_mem); kindls_mem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS FOR SOLUTION WITH BANDED JACOBIANS * ================================================================= */ /* * ----------------------------------------------------------------- * kinLapackBandInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the band * linear solver. * ----------------------------------------------------------------- */ static int kinLapackBandInit(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; nje = 0; nfeDQ = 0; if (jacDQ) { bjac = kinDlsBandDQJac; J_data = kin_mem; } else { J_data = kin_mem->kin_user_data; } last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinLapackBandSetup * ----------------------------------------------------------------- * This routine does the setup operations for the band linear solver. * It makes a decision whether or not to call the Jacobian evaluation * routine based on various state variables, and if not it uses the * saved copy. In any case, it constructs the Newton matrix * M = I - gamma*J, updates counters, and calls the band LU * factorization routine. * ----------------------------------------------------------------- */ static int kinLapackBandSetup(KINMem kin_mem) { KINDlsMem kindls_mem; int ier, retval; int intn, iml, imu, ldmat; kindls_mem = (KINDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = J->ldim; nje++; SetToZero(J); retval = bjac(n, mu, ml, uu, fval, J, J_data, vtemp1, vtemp2); if (retval != 0) { last_flag = -1; return(-1); } /* Do LU factorization of J */ dgbtrf_f77(&intn, &intn, &iml, &imu, J->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return -1 */ last_flag = (long int) ier; if (ier > 0) return(-1); return(0); } /* * ----------------------------------------------------------------- * kinLapackBandSolve * ----------------------------------------------------------------- * This routine handles the solve operation for the band linear solver * by calling the band backsolve routine. The return value is 0. * ----------------------------------------------------------------- */ static int kinLapackBandSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *res_norm) { KINDlsMem kindls_mem; realtype *xd; int ier, one = 1; int intn, iml, imu, ldmat; kindls_mem = (KINDlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = J->ldim; /* Copy the right-hand side into x */ N_VScale(ONE, b, x); xd = N_VGetArrayPointer(x); /* Back-solve and get solution in x */ dgbtrs_f77("N", &intn, &iml, &imu, &one, J->data, &ldmat, pivots, xd, &intn, &ier, 1); if (ier > 0) return(-1); /* Compute the terms Jpnorm and sfdotJp for use in the global strategy * routines and in KINForcingTerm. Both of these terms are subsequently * corrected if the step is reduced by constraints or the line search. * * sJpnorm is the norm of the scaled product (scaled by fscale) of * the current Jacobian matrix J and the step vector p. * * sfdotJp is the dot product of the scaled f vector and the scaled * vector J*p, where the scaling uses fscale. */ sJpnorm = N_VWL2Norm(b,fscale); N_VProd(b, fscale, b); N_VProd(b, fscale, b); sfdotJp = N_VDotProd(fval, b); last_flag = KINDLS_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * kinLapackBandFree * ----------------------------------------------------------------- * This routine frees memory specific to the band linear solver. * ----------------------------------------------------------------- */ static void kinLapackBandFree(KINMem kin_mem) { KINDlsMem kindls_mem; kindls_mem = (KINDlsMem) lmem; DestroyMat(J); DestroyArray(pivots); free(kindls_mem); kindls_mem = NULL; } sundials-2.5.0/src/kinsol/LICENSE0000600000175000017500000000551511741421272017314 0ustar sylvestresylvestreCopyright (c) 2002, The Regents of the University of California. Produced at the Lawrence Livermore National Laboratory. Written by Alan Hindmarsh, Allan Taylor, Radu Serban. UCRL-CODE-155953 All rights reserved. This file is part of KINSOL. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the disclaimer below. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the disclaimer (as noted below) in the documentation and/or other materials provided with the distribution. 3. Neither the name of the UC/LLNL nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OF THE UNIVERSITY OF CALIFORNIA, THE U.S. DEPARTMENT OF ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Additional BSD Notice --------------------- 1. This notice is required to be provided under our contract with the U.S. Department of Energy (DOE). This work was produced at the University of California, Lawrence Livermore National Laboratory under Contract No. W-7405-ENG-48 with the DOE. 2. Neither the United States Government nor the University of California nor any of their employees, makes any warranty, express or implied, or assumes any liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately-owned rights. 3. Also, reference herein to any specific commercial products, process, or services by trade name, trademark, manufacturer or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or the University of California. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or the University of California, and shall not be used for advertising or product endorsement purposes. sundials-2.5.0/src/kinsol/kinsol_io.c0000600000175000017500000005674511741421272020454 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the KINSOL solver. * ----------------------------------------------------------------- */ #include #include #include "kinsol_impl.h" #include #include #define ZERO RCONST(0.0) #define POINT1 RCONST(0.1) #define ONETHIRD RCONST(0.3333333333333333) #define HALF RCONST(0.5) #define TWOTHIRDS RCONST(0.6666666666666667) #define POINT9 RCONST(0.9) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define TWOPT5 RCONST(2.5) #define liw (kin_mem->kin_liw) #define lrw (kin_mem->kin_lrw) #define liw1 (kin_mem->kin_liw1) #define lrw1 (kin_mem->kin_lrw1) /* * ================================================================= * KINSOL optional input functions * ================================================================= */ /* * ----------------------------------------------------------------- * KINSetErrHandlerFn * ----------------------------------------------------------------- */ int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrHandlerFn", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_ehfun = ehfun; kin_mem->kin_eh_data = eh_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetErrFile * ----------------------------------------------------------------- */ int KINSetErrFile(void *kinmem, FILE *errfp) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrFile", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_errfp = errfp; return(KIN_SUCCESS); } #define errfp (kin_mem->kin_errfp) /* * ----------------------------------------------------------------- * Function : KINSetPrintLevel * ----------------------------------------------------------------- */ int KINSetPrintLevel(void *kinmem, int printfl) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetPrintLevel", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((printfl < 0) || (printfl > 3)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetPrintLevel", MSG_BAD_PRINTFL); return(KIN_ILL_INPUT); } kin_mem->kin_printfl = printfl; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * KINSetInfoHandlerFn * ----------------------------------------------------------------- */ int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoHandlerFn", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_ihfun = ihfun; kin_mem->kin_ih_data = ih_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetInfoFile * ----------------------------------------------------------------- */ int KINSetInfoFile(void *kinmem, FILE *infofp) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoFile", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_infofp = infofp; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetUserData * ----------------------------------------------------------------- */ int KINSetUserData(void *kinmem, void *user_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetUserData", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_user_data = user_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNumMaxIters * ----------------------------------------------------------------- */ int KINSetNumMaxIters(void *kinmem, long int mxiter) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNumMaxIters", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxiter < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetNumMaxIters", MSG_BAD_MXITER); return(KIN_ILL_INPUT); } if (mxiter == 0) kin_mem->kin_mxiter = MXITER_DEFAULT; else kin_mem->kin_mxiter = mxiter; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoInitSetup * ----------------------------------------------------------------- */ int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoInitSetup", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noInitSetup = noInitSetup; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoResMon * ----------------------------------------------------------------- */ int KINSetNoResMon(void *kinmem, booleantype noResMon) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoResMon", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noResMon = noResMon; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxSetupCalls * ----------------------------------------------------------------- */ int KINSetMaxSetupCalls(void *kinmem, long int msbset) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSetupCalls", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (msbset < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSetupCalls", MSG_BAD_MSBSET); return(KIN_ILL_INPUT); } if (msbset == 0) kin_mem->kin_msbset = MSBSET_DEFAULT; else kin_mem->kin_msbset = msbset; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxSubSetupCalls * ----------------------------------------------------------------- */ int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSubSetupCalls", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (msbsetsub < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSubSetupCalls", MSG_BAD_MSBSETSUB); return(KIN_ILL_INPUT); } if (msbsetsub == 0) kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; else kin_mem->kin_msbset_sub = msbsetsub; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaForm * ----------------------------------------------------------------- */ int KINSetEtaForm(void *kinmem, int etachoice) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaForm", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((etachoice != KIN_ETACONSTANT) && (etachoice != KIN_ETACHOICE1) && (etachoice != KIN_ETACHOICE2)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaForm", MSG_BAD_ETACHOICE); return(KIN_ILL_INPUT); } kin_mem->kin_etaflag = etachoice; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaConstValue * ----------------------------------------------------------------- */ int KINSetEtaConstValue(void *kinmem, realtype eta) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaConstValue", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((eta < ZERO) || (eta > ONE)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaConstValue", MSG_BAD_ETACONST); return(KIN_ILL_INPUT); } if (eta == ZERO) kin_mem->kin_eta = POINT1; else kin_mem->kin_eta = eta; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaParams * ----------------------------------------------------------------- */ int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaParams", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((ealpha <= ONE) || (ealpha > TWO)) if (ealpha != ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_ALPHA); return(KIN_ILL_INPUT); } if (ealpha == ZERO) kin_mem->kin_eta_alpha = TWO; else kin_mem->kin_eta_alpha = ealpha; if ((egamma <= ZERO) || (egamma > ONE)) if (egamma != ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_GAMMA); return(KIN_ILL_INPUT); } if (egamma == ZERO) kin_mem->kin_eta_gamma = POINT9; else kin_mem->kin_eta_gamma = egamma; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetResMonParams * ----------------------------------------------------------------- */ int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonParams", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check omegamin */ if (omegamin < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } if (omegamin == ZERO) kin_mem->kin_omega_min = OMEGA_MIN; else kin_mem->kin_omega_min = omegamin; /* check omegamax */ if (omegamax < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } if (omegamax == ZERO) { if (kin_mem->kin_omega_min > OMEGA_MAX) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } else kin_mem->kin_omega_max = OMEGA_MAX; } else { if (kin_mem->kin_omega_min > omegamax) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } else kin_mem->kin_omega_max = omegamax; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetResMonConstValue * ----------------------------------------------------------------- */ int KINSetResMonConstValue(void *kinmem, realtype omegaconst) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonConstValue", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check omegaconst */ if (omegaconst < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonConstValue", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } /* Load omega value. A value of 0 will force using omega_min and omega_max */ kin_mem->kin_omega = omegaconst; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoMinEps * ----------------------------------------------------------------- */ int KINSetNoMinEps(void *kinmem, booleantype noMinEps) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoMinEps", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noMinEps = noMinEps; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxNewtonStep * ----------------------------------------------------------------- */ int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxNewtonStep", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxnewtstep < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxNewtonStep", MSG_BAD_MXNEWTSTEP); return(KIN_ILL_INPUT); } /* Note: passing a value of 0.0 will use the default value (computed in KINSolinit) */ kin_mem->kin_mxnewtstep = mxnewtstep; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxBetaFails * ----------------------------------------------------------------- */ int KINSetMaxBetaFails(void *kinmem, long int mxnbcf) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxBetaFails", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxnbcf < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxBetaFails", MSG_BAD_MXNBCF); return(KIN_ILL_INPUT); } if (mxnbcf == 0) kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; else kin_mem->kin_mxnbcf = mxnbcf; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetRelErrFunc * ----------------------------------------------------------------- */ int KINSetRelErrFunc(void *kinmem, realtype relfunc) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetRelErrFunc", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (relfunc < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetRelErrFunc", MSG_BAD_RELFUNC); return(KIN_ILL_INPUT); } if (relfunc == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_sqrt_relfunc = RSqrt(uround); } else { kin_mem->kin_sqrt_relfunc = RSqrt(relfunc); } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetFuncNormTol * ----------------------------------------------------------------- */ int KINSetFuncNormTol(void *kinmem, realtype fnormtol) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetFuncNormTol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (fnormtol < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetFuncNormTol", MSG_BAD_FNORMTOL); return(KIN_ILL_INPUT); } if (fnormtol == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_fnormtol = RPowerR(uround,ONETHIRD); } else { kin_mem->kin_fnormtol = fnormtol; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetScaledStepTol * ----------------------------------------------------------------- */ int KINSetScaledStepTol(void *kinmem, realtype scsteptol) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetScaledStepTol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (scsteptol < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetScaledStepTol", MSG_BAD_SCSTEPTOL); return(KIN_ILL_INPUT); } if (scsteptol == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_scsteptol = RPowerR(uround,TWOTHIRDS); } else { kin_mem->kin_scsteptol = scsteptol; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetConstraints * ----------------------------------------------------------------- */ int KINSetConstraints(void *kinmem, N_Vector constraints) { KINMem kin_mem; realtype temptest; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetConstraints", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (constraints == NULL) { if (kin_mem->kin_constraintsSet) { N_VDestroy(kin_mem->kin_constraints); lrw -= lrw1; liw -= liw1; } kin_mem->kin_constraintsSet = FALSE; return(KIN_SUCCESS); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if (temptest > TWOPT5){ KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetConstraints", MSG_BAD_CONSTRAINTS); return(KIN_ILL_INPUT); } if (!kin_mem->kin_constraintsSet) { kin_mem->kin_constraints = N_VClone(constraints); lrw += lrw1; liw += liw1; kin_mem->kin_constraintsSet = TRUE; } /* Load the constraint vector */ N_VScale(ONE, constraints, kin_mem->kin_constraints); return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetSysFunc * ----------------------------------------------------------------- */ int KINSetSysFunc(void *kinmem, KINSysFn func) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetSysFunc", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (func == NULL) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetSysFunc", MSG_FUNC_NULL); return(KIN_ILL_INPUT); } kin_mem->kin_func = func; return(KIN_SUCCESS); } /* * ================================================================= * Readability constants * ================================================================= */ #define nni (kin_mem->kin_nni) #define nfe (kin_mem->kin_nfe) #define nbcf (kin_mem->kin_nbcf) #define nbktrk (kin_mem->kin_nbktrk) #define stepl (kin_mem->kin_stepl) #define fnorm (kin_mem->kin_fnorm) #define liw (kin_mem->kin_liw) #define lrw (kin_mem->kin_lrw) /* * ================================================================= * KINSOL optional input functions * ================================================================= */ /* * ----------------------------------------------------------------- * Function : KINGetWorkSpace * ----------------------------------------------------------------- */ int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetWorkSpace", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *lenrw = lrw; *leniw = liw; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumNonlinSolvIters * ----------------------------------------------------------------- */ int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumNonlinSolvIters", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nniters = nni; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumFuncEvals * ----------------------------------------------------------------- */ int KINGetNumFuncEvals(void *kinmem, long int *nfevals) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumFuncEvals", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nfevals = nfe; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumBetaCondFails * ----------------------------------------------------------------- */ int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBetaCondFails", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nbcfails = nbcf; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumBacktrackOps * ----------------------------------------------------------------- */ int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBacktrackOps", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nbacktr = nbktrk; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetFuncNorm * ----------------------------------------------------------------- */ int KINGetFuncNorm(void *kinmem, realtype *funcnorm) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetFuncNorm", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *funcnorm = fnorm; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetStepLength * ----------------------------------------------------------------- */ int KINGetStepLength(void *kinmem, realtype *steplength) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetStepLength", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *steplength = stepl; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetReturnFlagName * ----------------------------------------------------------------- */ char *KINGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(24*sizeof(char)); switch(flag) { case KIN_SUCCESS: sprintf(name, "KIN_SUCCESS"); break; case KIN_INITIAL_GUESS_OK: sprintf(name, "KIN_INITIAL_GUESS_OK"); break; case KIN_STEP_LT_STPTOL: sprintf(name, "KIN_STEP_LT_STPTOL"); break; case KIN_WARNING: sprintf(name, "KIN_WARNING"); break; case KIN_MEM_NULL: sprintf(name, "KIN_MEM_NULL"); break; case KIN_ILL_INPUT: sprintf(name, "KIN_ILL_INPUT"); break; case KIN_NO_MALLOC: sprintf(name, "KIN_NO_MALLOC"); break; case KIN_MEM_FAIL: sprintf(name, "KIN_MEM_FAIL"); break; case KIN_LINESEARCH_NONCONV: sprintf(name, "KIN_LINESEARCH_NONCONV"); break; case KIN_MAXITER_REACHED: sprintf(name, "KIN_MAXITER_REACHED"); break; case KIN_MXNEWT_5X_EXCEEDED: sprintf(name, "KIN_MXNEWT_5X_EXCEEDED"); break; case KIN_LINESEARCH_BCFAIL: sprintf(name, "KIN_LINESEARCH_BCFAIL"); break; case KIN_LINSOLV_NO_RECOVERY: sprintf(name, "KIN_LINSOLV_NO_RECOVERY"); break; case KIN_LINIT_FAIL: sprintf(name, "KIN_LINIT_FAIL"); break; case KIN_LSETUP_FAIL: sprintf(name, "KIN_LSETUP_FAIL"); break; case KIN_LSOLVE_FAIL: sprintf(name, "KIN_LSOLVE_FAIL"); break; default: sprintf(name, "NONE"); } return(name); } sundials-2.5.0/src/kinsol/kinsol_spils.c0000600000175000017500000004232311741421272021162 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2011/06/23 00:36:18 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINSPILS linear solvers. * ----------------------------------------------------------------- */ #include #include #include #include "kinsol_impl.h" #include "kinsol_spils_impl.h" #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ----------------------------------------------------------------- * readability replacements * ----------------------------------------------------------------- */ #define lrw1 (kin_mem->kin_lrw1) #define liw1 (kin_mem->kin_liw1) #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define lmem (kin_mem->kin_lmem) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define eps (kin_mem->kin_eps) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define ils_type (kinspils_mem->s_type) #define pretype (kinspils_mem->s_pretype) #define gstype (kinspils_mem->s_gstype) #define nli (kinspils_mem->s_nli) #define npe (kinspils_mem->s_npe) #define nps (kinspils_mem->s_nps) #define ncfl (kinspils_mem->s_ncfl) #define njtimes (kinspils_mem->s_njtimes) #define nfes (kinspils_mem->s_nfes) #define new_uu (kinspils_mem->s_new_uu) #define jtimesDQ (kinspils_mem->s_jtimesDQ) #define jtimes (kinspils_mem->s_jtimes) #define J_data (kinspils_mem->s_J_data) #define last_flag (kinspils_mem->s_last_flag) /* * ----------------------------------------------------------------- * Function : KINSpilsSetMaxRestarts * ----------------------------------------------------------------- */ int KINSpilsSetMaxRestarts(void *kinmem, int maxrs) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsSetMaxRestarts", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsSetMaxRestarts", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; /* check for legal maxrs */ if (maxrs < 0) { KINProcessError(kin_mem, KINSPILS_ILL_INPUT, "KINSPILS", "KINSpilsSetMaxRestarts", MSGS_NEG_MAXRS); return(KINSPILS_ILL_INPUT); } kinspils_mem->s_maxlrst = maxrs; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsSetPreconditioner * ----------------------------------------------------------------- */ int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn pset, KINSpilsPrecSolveFn psolve) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsSetPreconditioner", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsSetPreconditioner", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; kinspils_mem->s_pset = pset; kinspils_mem->s_psolve = psolve; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsSetJacTimesVecFn * ----------------------------------------------------------------- */ int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsSetJacTimesVecFn", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsSetJacTimesVecFn", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; if (jtv != NULL) { jtimesDQ = FALSE; jtimes = jtv; } else { jtimesDQ = TRUE; } return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetWorkSpace * ----------------------------------------------------------------- */ int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwSG, long int *leniwSG) { KINMem kin_mem; KINSpilsMem kinspils_mem; int maxl; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetWorkSpace", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetWorkSpace", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; maxl = kinspils_mem->s_maxl; switch(ils_type) { case SPILS_SPGMR: *lenrwSG = lrw1 * (maxl + 3) + (maxl * (maxl + 4)) + 1; *leniwSG = liw1 * (maxl + 3); break; case SPILS_SPBCG: *lenrwSG = lrw1 * 7; *leniwSG = liw1 * 7; break; case SPILS_SPTFQMR: *lenrwSG = lrw1 * 11; *leniwSG = liw1 * 11; break; } return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumPrecEvals * ----------------------------------------------------------------- */ int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumPrecEvals", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumPrecEvals", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *npevals = npe; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumPrecSolves * ----------------------------------------------------------------- */ int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumPrecSolves", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumPrecSolves", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *npsolves = nps; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumLinIters * ----------------------------------------------------------------- */ int KINSpilsGetNumLinIters(void *kinmem, long int *nliters) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumLinIters", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumLinIters", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *nliters = nli; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumConvFails * ----------------------------------------------------------------- */ int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumConvFails", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumConvFails", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *nlcfails = ncfl; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumJtimesEvals * ----------------------------------------------------------------- */ int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumJtimesEvals", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumJtimesEvals", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *njvevals = njtimes; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetNumFuncEvals * ----------------------------------------------------------------- */ int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevalsS) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetNumFuncEvals", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetNumFuncEvals", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *nfevalsS = nfes; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetLastFlag * ----------------------------------------------------------------- */ int KINSpilsGetLastFlag(void *kinmem, long int *flag) { KINMem kin_mem; KINSpilsMem kinspils_mem; /* return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpilsGetLastFlag", MSGS_KINMEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINSPILS", "KINSpilsGetLastFlag", MSGS_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) lmem; *flag = last_flag; return(KINSPILS_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSpilsGetReturnFlagName * ----------------------------------------------------------------- */ char *KINSpilsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case KINSPILS_SUCCESS: sprintf(name, "KINSPILS_SUCCESS"); break; case KINSPILS_MEM_NULL: sprintf(name, "KINSPILS_MEM_NULL"); break; case KINSPILS_LMEM_NULL: sprintf(name, "KINSPILS_LMEM_NULL"); break; case KINSPILS_ILL_INPUT: sprintf(name, "KINSPILS_ILL_INPUT"); break; case KINSPILS_MEM_FAIL: sprintf(name, "KINSPILS_MEM_FAIL"); break; case KINSPILS_PMEM_NULL: sprintf(name, "KINSPILS_PMEM_NULL"); break; default: sprintf(name, "NONE"); } return(name); } /* * ----------------------------------------------------------------- * additional readability replacements * ----------------------------------------------------------------- */ #define maxl (kinspils_mem->s_maxl) #define maxlrst (kinspils_mem->s_maxlrst) #define pset (kinspils_mem->s_pset) #define psolve (kinspils_mem->s_psolve) #define P_data (kinspils_mem->s_P_data) /* * ----------------------------------------------------------------- * Function : KINSpilsAtimes * ----------------------------------------------------------------- * This routine coordinates the generation of the matrix-vector * product z = J*v by calling either KINSpilsDQJtimes, which uses * a difference quotient approximation for J*v, or by calling the * user-supplied routine KINSpilsJacTimesVecFn if it is non-null. * ----------------------------------------------------------------- */ int KINSpilsAtimes(void *kinsol_mem, N_Vector v, N_Vector z) { KINMem kin_mem; KINSpilsMem kinspils_mem; int ret; kin_mem = (KINMem) kinsol_mem; kinspils_mem = (KINSpilsMem) lmem; ret = jtimes(v, z, uu, &new_uu, J_data); njtimes++; return(ret); } /* * ----------------------------------------------------------------- * Function : KINSpilsPSolve * ----------------------------------------------------------------- * This routine interfaces between the generic Sp***Solve routine * (within the SPGMR, SPBCG, or SPTFQMR solver) and the * user's psolve routine. It passes to psolve all required state * information from kinsol_mem. Its return value is the same as that * returned by psolve. Note that the generic SP*** solver guarantees * that KINSpilsPSolve will not be called in the case in which * preconditioning is not done. This is the only case in which the * user's psolve routine is allowed to be NULL. * ----------------------------------------------------------------- */ int KINSpilsPSolve(void *kinsol_mem, N_Vector r, N_Vector z, int lrdummy) { KINMem kin_mem; KINSpilsMem kinspils_mem; int ret; kin_mem = (KINMem) kinsol_mem; kinspils_mem = (KINSpilsMem) lmem; /* copy the rhs into z before the psolve call */ /* Note: z returns with the solution */ N_VScale(ONE, r, z); /* this call is counted in nps within the KINSpilsSolve routine */ ret = psolve(uu, uscale, fval, fscale, z, P_data, vtemp1); return(ret); } /* * ----------------------------------------------------------------- * Function : KINSpilsDQJtimes * ----------------------------------------------------------------- * This routine generates the matrix-vector product z = J*v using a * difference quotient approximation. The approximation is * J*v = [func(uu + sigma*v) - func(uu)]/sigma. Here sigma is based * on the dot products (uscale*uu, uscale*v) and * (uscale*v, uscale*v), the L1Norm(uscale*v), and on sqrt_relfunc * (the square root of the relative error in the function). Note * that v in the argument list has already been both preconditioned * and unscaled. * * NOTE: Unlike the DQ Jacobian functions for direct linear solvers * (which are called from within the lsetup function), this * function is called from within the lsolve function and thus * a recovery may still be possible even if the system function * fails (recoverably). * ----------------------------------------------------------------- */ int KINSpilsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, booleantype *new_u, void *data) { realtype sigma, sigma_inv, sutsv, sq1norm, sign, vtv; KINMem kin_mem; KINSpilsMem kinspils_mem; int retval; /* data is kin_mem */ kin_mem = (KINMem) data; kinspils_mem = (KINSpilsMem) lmem; /* scale the vector v and put Du*v into vtemp1 */ N_VProd(v, uscale, vtemp1); /* scale u and put into Jv (used as a temporary storage) */ N_VProd(u, uscale, Jv); /* compute dot product (Du*u).(Du*v) */ sutsv = N_VDotProd(Jv, vtemp1); /* compute dot product (Du*v).(Du*v) */ vtv = N_VDotProd(vtemp1, vtemp1); sq1norm = N_VL1Norm(vtemp1); sign = (sutsv >= ZERO) ? ONE : -ONE ; /* this expression for sigma is from p. 469, Brown and Saad paper */ sigma = sign*sqrt_relfunc*MAX(ABS(sutsv),sq1norm)/vtv; sigma_inv = ONE/sigma; /* compute the u-prime at which to evaluate the function func */ N_VLinearSum(ONE, u, sigma, v, vtemp1); /* call the system function to calculate func(u+sigma*v) */ retval = func(vtemp1, vtemp2, user_data); nfes++; if (retval != 0) return(retval); /* finish the computation of the difference quotient */ N_VLinearSum(sigma_inv, vtemp2, -sigma_inv, fval, Jv); return(0); } sundials-2.5.0/src/kinsol/fcmix/0000755000175000017500000000000011767174700017430 5ustar sylvestresylvestresundials-2.5.0/src/kinsol/fcmix/fkinsol.h0000600000175000017500000005701711741421272021237 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the header file for the FKINSOL Interface Package. * See below for usage details. * ----------------------------------------------------------------- */ /*************************************************************************** FKINSOL Interface Package The FKINSOL Interface Package is a package of C functions which support the use of the KINSOL solver for the solution of nonlinear systems f(u) = 0, in a mixed Fortran/C setting. While KINSOL is written in C, it is assumed here that the user's calling program and user-supplied problem-defining routines are written in Fortran. This package provides the necessary interface to KINSOL for both the serial and the parallel NVECTOR implementations. The user-callable functions, with the corresponding KINSOL functions, are as follows: FNVINITS and FNVINITP initialize serial and parallel vector computations, respectively FKINMALLOC interfaces to KINInit FKINSETIIN, FKINSETRIN, FKINSETVIN interface to KINSet* functions FKINDENSE interfaces to KINDense FKINSPTFQMR interfaces to KINSptfqmr FKINSPGMR interfaces to KINSpgmr FKINSPBCG interfaces to KINSpbcg FKINSOL interfaces to KINSol and KINGet* functions FKINFREE interfaces to KINFree The user-supplied functions, each with the corresponding interface function which calls it (and its type within KINSOL), are as follows: FKFUN : called by the interface function FKINfunc of type KINSysFn FKDJAC : called by the interface function FKINDenseJac of type KINDenseJacFn FKBJAC : called by the interface function FKINBandJac of type KINBandJacFn FKJTIMES : called by the interface function FKINJtimes of type KINSpilsJacTimesVecFn FKPSOL : called by the interface function FKINPSol of type KINSpilsPrecSolveFn FKPSET : called by the interface function FKINPSet of type KINSpilsPrecSetupFn In contrast to the case of direct use of KINSOL, the names of all user-supplied routines here are fixed, in order to maximize portability for the resulting mixed-language program. ========================================================================= Usage of the FKINSOL Interface Package The usage of FKINSOL requires calls to several interface functions, and to a few user-supplied routines which define the problem to be solved. These function calls and user routines are summarized separately below. Some details are omitted, and the user is referred to the KINSOL manual for more complete documentation. Information on the arguments of any given user-callable interface routine, or of a given user-supplied function called by an interface function, can be found in the documentation on the corresponding function in the KINSOL package. The number labels on the instructions below end with "s" for instructions that apply to the serial version of KINSOL only, and end with "p" for those that apply to the parallel version only. (1) User-supplied system routine: FKFUN The user must in all cases supply the following Fortran routine: SUBROUTINE FKFUN (UU, FVAL, IER) DIMENSION UU(*), FVAL(*) It must set the FVAL array to f(u), the system function, as a function of the array UU = u. Here UU and FVAL are arrays representing vectors, which are distributed vectors in the parallel case. IER is a return flag (currently not used). (2s) Optional user-supplied dense Jacobian approximation routine: FKDJAC As an option when using the DENSE linear solver, the user may supply a routine that computes a dense approximation of the system Jacobian J = df/dy. If supplied, it must have the following form: SUBROUTINE FKDJAC(N, UU, FU, DJAC, WK1, WK2, IER) DIMENSION UU(*), FU(*), DJAC(N,*), WK1(*), WK2(*) This routine must compute the Jacobian and store it columnwise in DJAC. FKDJAC should return IER = 0 if successful, or a nonzero IER otherwise. (3s) Optional user-supplied band Jacobian approximation routine: FKBJAC As an option when using the BAND linear solver, the user may supply a routine that computes a band approximation of the system Jacobian J = df/dy. If supplied, it must have the following form: SUBROUTINE FKBJAC(N, MU, ML, MDIM, UU, FU, BJAC, WK1, WK2, IER) DIMENSION UU(*), FU(*), BJAC(MDIM,*), WK1(*), WK2(*) This routine must load the MDIM by N array BJAC with the Jacobian matrix. FKBJAC should return IER = 0 if successful, or a nonzero IER otherwise. (4) Optional user-supplied Jacobian-vector product routine: FKJTIMES As an option, the user may supply a routine that computes the product of the system Jacobian and a given vector. This has the following form: SUBROUTINE FKJTIMES(V, Z, NEWU, UU, IER) DIMENSION V(*), Z(*), UU(*) This must set the array Z to the product J*V, where J is the Jacobian matrix J = dF/du, and V is a given array. Here UU is an array containing the current value of the unknown vector u. NEWU is an input integer indicating whether UU has changed since FKJTIMES was last called (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then no such computation is necessary when NEWU = 0. Here V, Z, and UU are arrays of length NEQ, the problem size, or the local length of all distributed vectors in the parallel case. FKJTIMES should return IER = 0 if successful, or a nonzero IER otherwise. (5) Initialization: FNVINITS/FNVINITP and FKINMALLOC (5.1s) To initialize the serial machine environment, the user must make the following call: CALL FNVINITS (3, NEQ, IER) The arguments are: NEQ = size of vectors IER = return completion flag. Values are 0 = success, -1 = failure. (5.1p) To initialize the parallel machine environment, the user must make the following call: CALL FNVINITP (3, NLOCAL, NGLOBAL, IER) The arguments are: NLOCAL = local size of vectors for this process NGLOBAL = the system size, and the global size of vectors (the sum of all values of NLOCAL) IER = return completion flag. Values are 0 = success, -1 = failure. (5.2) To allocate internal memory, make the following call: CALL FKINMALLOC(IOUT, ROUT, IER) The arguments are: IOUT = array of length at least 15 for integer optional outputs (declare as INTEGER*4 or INTEGER*8 according to C type long int) ROUT = array of length at least 2 for real optional outputs IER = return completion flag. Values are 0 = success, and -1 = failure. Note: See printed message for details in case of failure. (5.3) To set various integer optional inputs, make the folowing call: CALL FKINSETIIN(KEY, VALUE, IER) to set the optional input specified by the character key KEY to the integer value VALUE. KEY is one of the following: PRNT_LEVEL, MAX_NITERS, ETA_FORM, MAX_SETUPS, MAX_SP_SETUPS, NO_INIT_SETUP, NO_MIN_EPS, NO_RES_MON. To set various real optional inputs, make the folowing call: CALL FKINSETRIN(KEY, VALUE, IER) to set the optional input specified by the character key KEY to the real value VALUE. KEY is one of the following: FNORM_TOL, SSTEP_TOL, MAX_STEP, RERR_FUNC, ETA_CONST, ETA_PARAMS, RMON_CONST, RMON_PARAMS. Note that if KEY is ETA_PARAMS or RMON_PARAMS, then VALUE must be an array of dimension 2. To set the vector of constraints on the solution, make the following call: CALL FKINSETVIN(KEY, ARRAY, IER) where ARRAY is an array of reals and KEY is 'CONSTR_VEC'. FKINSETIIN, FKINSETRIN, and FKINSETVIN return IER=0 if successful and IER<0 if an error occured. (6) Specification of linear system solution method: The solution method in KINSOL involves the solution of linear systems related to the Jacobian J = dF/du of the nonlinear system. (6.1s) DENSE treatment of the linear systems (NVECTOR_SERIAL only): The user must make the following call: CALL FKINDENSE(NEQ, IER) In the above routine, the arguments are as follows: NEQ = problem size. IER = return completion flag. If the user program includes the FKDJAC routine for the evaluation of the dense approximation to the system Jacobian, the following call must be made: CALL FKINDENSESETJAC(FLAG, IER) with FLAG = 1 to specify that FKDJAC is provided. (FLAG = 0 specifies using the internal finite difference approximation to the Jacobian.) (6.2s) BAND treatment of the linear systems (NVECTOR_SERIAL only): The user must make the following call: CALL FKINBAND(NEQ, MU, ML, IER) In the above routine, the arguments are as follows: NEQ = problem size. MU = upper half-bandwidth ML = lower half-bandwidth IER = return completion flag. If the user program includes the FKBJAC routine for the evaluation of the band approximation to the system Jacobian, the following call must be made: CALL FKINBANDSETJAC(FLAG, IER) with FLAG = 1 to specify that FKBJAC is provided. (FLAG = 0 specifies using the internal finite difference approximation to the Jacobian.) (6.3) SPTFQMR treatment of the linear systems: For the Scaled Preconditioned TFQMR solution of the linear systems, the user must make the call: CALL FKINSPTFQMR(MAXL, IER) In the above routine, the arguments are as follows: MAXL = maximum Krylov subspace dimension; 0 indicates default. IER = return completion flag. Values are 0 = succes, and -1 = failure. Note: See printed message for details in case of failure. (6.4) SPBCG treatment of the linear systems: For the Scaled Preconditioned Bi-CGSTAB solution of the linear systems, the user must make the call: CALL FKINSPBCG(MAXL, IER) In the above routine, the arguments are as follows: MAXL = maximum Krylov subspace dimension; 0 indicates default. IER = return completion flag. Values are 0 = succes, and -1 = failure. Note: See printed message for details in case of failure. (6.5) SPGMR treatment of the linear systems: For the Scaled Preconditioned GMRES solution of the linear systems, the user must make the call: CALL FKINSPGMR(MAXL, MAXLRST, IER) In the above routine, the arguments are as follows: MAXL = maximum Krylov subspace dimension; 0 indicates default. MAXLRST = maximum number of linear system restarts; 0 indicates default (SPGMR only). IER = return completion flag. Values are 0 = succes, and -1 = failure. Note: See printed message for details in case of failure. (6.6) Specifying user-provided functions for the iterative linear solvers If the user program includes the FKJTIMES routine for the evaluation of the Jacobian-vector product, the following call must be made: CALL FKINSPILSSETJAC(FLAG, IER) The argument FLAG = 0 specifies using the internal finite differences approximation to the Jacobian-vector product, while FLAG = 1 specifies that FKJTIMES is provided. Usage of the user-supplied routines FKPSET and FKPSOL for the setup and solution of the preconditioned linear system is specified by calling: CALL FKINSPILSSETPREC(FLAG, IER) where FLAG = 0 indicates no FKPSET or FKPSOL (default) and FLAG = 1 specifies using FKPSET and FKPSOL. The user-supplied routines FKPSET and FKPSOL must be of the form: SUBROUTINE FKPSET (UU, USCALE, FVAL, FSCALE, VTEMP1, VTEMP2, IER) DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*), VTEMP1(*), VTEMP2(*) It must perform any evaluation of Jacobian-related data and preprocessing needed for the solution of the preconditioned linear systems by FKPSOL. The variables UU through FSCALE are for use in the preconditioning setup process. Typically, the system function FKFUN is called, so that FVAL will have been updated. UU is the current solution iterate. VTEMP1 and VTEMP2 are available for work space. If scaling is being used, USCALE and FSCALE are available for those operatins requiring scaling. NEQ is the (global) problem size. On return, set IER = 0 if FKPSET was successful, set IER = 1 if an error occurred. SUBROUTINE FKPSOL (UU, USCALE, FVAL, FSCALE, VTEM, FTEM, IER) DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*), VTEM(*), FTEM(*) Typically this routine will use only UU, FVAL, VTEM and FTEM. It must solve the preconditioned linear system Pz = r, where r = VTEM is input, and store the solution z in VTEM as well. Here P is the right preconditioner. If scaling is being used, the routine supplied must also account for scaling on either coordinate or function value. (7) The solver: FKINSOL Solving the nonlinear system is accomplished by making the following call: CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) The arguments are: UU = array containing the initial guess on input, and the solution on return GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: 0 = No globalization, 1 = LineSearch USCALE = array of scaling factors for the UU vector FSCALE = array of scaling factors for the FVAL (function) vector IER = INTEGER error flag as returned by KINSOL: 0 means success, 1 means initial guess satisfies f(u) = 0 (approx.), 2 means apparent stalling (small step), a value < 0 means other error or failure. Note: See KINSOL documentation for detailed information. (8) Memory freeing: FKINFREE To the free the internal memory created by the calls to FKINMALLOC and either FNVINITS or FNVINITP, make the following call: CALL FKINFREE (9) Optional outputs: IOUT/ROUT The optional outputs available by way of IOUT and ROUT have the following names, locations, and descriptions. For further details see the KINSOL documentation. LENRW = IOUT(1) = real workspace size LENRW = IOUT(2) = real workspace size NNI = IOUT(3) = number of Newton iterations NFE = IOUT(4) = number of f evaluations NBCF = IOUT(5) = number of line search beta condition failures NBKTRK = IOUT(6) = number of line search backtracks FNORM = ROUT(1) = final scaled norm of f(u) STEPL = ROUT(2) = scaled last step length The following optional outputs are specific to the SPGMR/SPBCG/SPTFQMR module: LRW = IOUT( 7) = real workspace size for the linear solver module LIW = IOUT( 8) = integer workspace size for the linear solver module LSTF = IOUT( 9) = last flag returned by linear solver NFE = IOUT(10) = number of f evaluations for DQ Jacobian NJE = IOUT(11) = number of Jacobian-vector product evaluations NPE = IOUT(12) = number of preconditioner evaluations NPS = IOUT(13) = number of preconditioner solves NLI = IOUT(14) = number of linear (Krylov) iterations NCFL = IOUT(15) = number of linear convergence failures The following optional outputs are specific to the DENSE/BAND module: LRW = IOUT( 7) = real workspace size for the linear solver module LIW = IOUT( 8) = integer workspace size for the linear solver module LSTF = IOUT( 9) = last flag returned by linear solver NFE = IOUT(10) = number of f evaluations for DQ Jacobian NJE = IOUT(11) = number of Jacobian evaluations *******************************************************************************/ #ifndef _FKINSOL_H #define _FKINSOL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * header files * ----------------------------------------------------------------- */ #include #include /* definition of type DlsMat */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ /* * ----------------------------------------------------------------- * generic names are translated through the define statements below * ----------------------------------------------------------------- */ #if defined(SUNDIALS_F77_FUNC) #define FKIN_MALLOC SUNDIALS_F77_FUNC(fkinmalloc, FKINMALLOC) #define FKIN_SETIIN SUNDIALS_F77_FUNC(fkinsetiin, FKINSETIIN) #define FKIN_SETRIN SUNDIALS_F77_FUNC(fkinsetrin, FKINSETRIN) #define FKIN_SETVIN SUNDIALS_F77_FUNC(fkinsetvin, FKINSETVIN) #define FKIN_DENSE SUNDIALS_F77_FUNC(fkindense, FKINDENSE) #define FKIN_DENSESETJAC SUNDIALS_F77_FUNC(fkindensesetjac, FKINDENSESETJAC) #define FKIN_BAND SUNDIALS_F77_FUNC(fkinband, FKINBAND) #define FKIN_BANDSETJAC SUNDIALS_F77_FUNC(fkinbandsetjac, FKINBANDSETJAC) #define FKIN_LAPACKDENSE SUNDIALS_F77_FUNC(fkinlapackdense, FKINLAPACKDENSE) #define FKIN_LAPACKDENSESETJAC SUNDIALS_F77_FUNC(fkinlapackdensesetjac, FKINLAPACKDENSESETJAC) #define FKIN_LAPACKBAND SUNDIALS_F77_FUNC(fkinlapackband, FKINLAPACKBAND) #define FKIN_LAPACKBANDSETJAC SUNDIALS_F77_FUNC(fkinlapackbandsetjac, FKINLAPACKBANDSETJAC) #define FKIN_SPTFQMR SUNDIALS_F77_FUNC(fkinsptfqmr, FKINSPTFQMR) #define FKIN_SPBCG SUNDIALS_F77_FUNC(fkinspbcg, FKINSPBCG) #define FKIN_SPGMR SUNDIALS_F77_FUNC(fkinspgmr, FKINSPGMR) #define FKIN_SPILSSETJAC SUNDIALS_F77_FUNC(fkinspilssetjac, FKINSPILSSETJAC) #define FKIN_SPILSSETPREC SUNDIALS_F77_FUNC(fkinspilssetprec, FKINSPILSSETPREC) #define FKIN_SOL SUNDIALS_F77_FUNC(fkinsol, FKINSOL) #define FKIN_FREE SUNDIALS_F77_FUNC(fkinfree, FKINFREE) #define FK_FUN SUNDIALS_F77_FUNC(fkfun, FKFUN) #define FK_PSET SUNDIALS_F77_FUNC(fkpset, FKPSET) #define FK_PSOL SUNDIALS_F77_FUNC(fkpsol, FKPSOL) #define FK_JTIMES SUNDIALS_F77_FUNC(fkjtimes, FKJTIMES) #define FK_DJAC SUNDIALS_F77_FUNC(fkdjac, FKDJAC) #define FK_BJAC SUNDIALS_F77_FUNC(fkbjac, FKBJAC) #else #define FKIN_MALLOC fkinmalloc_ #define FKIN_SETIIN fkinsetiin_ #define FKIN_SETRIN fkinsetrin_ #define FKIN_SETVIN fkinsetvin_ #define FKIN_DENSE fkindense_ #define FKIN_DENSESETJAC fkindensesetjac_ #define FKIN_BAND fkinband_ #define FKIN_BANDSETJAC fkinbandsetjac_ #define FKIN_LAPACKDENSE fkinlapackdense_ #define FKIN_LAPACKDENSESETJAC fkinlapackdensesetjac_ #define FKIN_LAPACKBAND fkinlapackband_ #define FKIN_LAPACKBANDSETJAC fkinlapackbandsetjac_ #define FKIN_SPTFQMR fkinsptfqmr_ #define FKIN_SPBCG fkinspbcg_ #define FKIN_SPGMR fkinspgmr_ #define FKIN_SPILSSETJAC fkinspilssetjac_ #define FKIN_SPILSSETPREC fkinspilssetprec_ #define FKIN_SOL fkinsol_ #define FKIN_FREE fkinfree_ #define FK_FUN fkfun_ #define FK_PSET fkpset_ #define FK_PSOL fkpsol_ #define FK_JTIMES fkjtimes_ #define FK_DJAC fkdjac_ #define FK_BJAC fkbjac_ #endif /* * ----------------------------------------------------------------- * Prototypes : exported functions * ----------------------------------------------------------------- */ void FKIN_MALLOC(long int *iout, realtype *rout, int *ier); void FKIN_SETIIN(char key_name[], long int *ival, int *ier, int key_len); void FKIN_SETRIN(char key_name[], realtype *rval, int *ier, int key_len); void FKIN_SETVIN(char key_name[], realtype *vval, int *ier, int key_len); void FKIN_DENSE(long int *neq, int *ier); void FKIN_DENSESETJAC(int *flag, int *ier); void FKIN_BAND(long int *neq, long int *mupper, long int *mlower, int *ier); void FKIN_BANDSETJAC(int *flag, int *ier); void FKIN_LAPACKDENSE(int *neq, int *ier); void FKIN_LAPACKDENSESETJAC(int *flag, int *ier); void FKIN_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier); void FKIN_LAPACKBANDSETJAC(int *flag, int *ier); void FKIN_SPTFQMR(int *maxl, int *ier); void FKIN_SPBCG(int *maxl, int *ier); void FKIN_SPGMR(int *maxl, int *maxlrst, int *ier); void FKIN_SPILSSETJAC(int *flag, int *ier); void FKIN_SPILSSETPREC(int *flag, int *ier); void FKIN_SOL(realtype *uu, int *globalstrategy, realtype *uscale , realtype *fscale, int *ier); void FKIN_FREE(void); /* * ----------------------------------------------------------------- * Prototypes : functions called by the solver * ----------------------------------------------------------------- */ int FKINfunc(N_Vector uu, N_Vector fval, void *user_data); int FKINDenseJac(long int N, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINBandJac(long int N, long int mupper, long int mlower, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINLapackDenseJac(long int N, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINLapackBandJac(long int N, long int mupper, long int mlower, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINPSet(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINPSol(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector vtemp); int FKINJtimes(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *user_data); /* * ----------------------------------------------------------------- * declarations for global variables shared amongst various * routines * ----------------------------------------------------------------- */ extern N_Vector F2C_KINSOL_vec; extern void *KIN_kinmem; extern long int *KIN_iout; extern realtype *KIN_rout; extern int KIN_ls; /* Linear solver IDs */ enum { KIN_LS_SPGMR = 1, KIN_LS_SPBCG = 2, KIN_LS_SPTFQMR = 3, KIN_LS_DENSE = 4, KIN_LS_BAND = 5, KIN_LS_LAPACKDENSE = 6, KIN_LS_LAPACKBAND = 7 }; #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/fcmix/fkinsol.c0000600000175000017500000002741711741421272021233 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the Fortran interface to * the KINSOL package. See fkinsol.h for usage. * * Note: Some routines are necessarily stored elsewhere to avoid * linking problems. See also, therefore, fkinpreco.c, fkinjtimes.c, * and fkinbbd.c. * ----------------------------------------------------------------- */ #include #include #include #include "fkinsol.h" /* prototypes of interfaces and global vars. */ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* prototypes of KINBAND interface routines */ #include /* prototypes of KINDENSE interface routines */ #include /* prototypes of KINSPTFQMR interface routines */ #include /* prototypes of KINSPBCG interface routines */ #include /* prototypes of KINSPGMR interface routines */ /* * ---------------------------------------------------------------- * definitions of global variables shared amongst various routines * ---------------------------------------------------------------- */ void *KIN_kinmem; long int *KIN_iout; realtype *KIN_rout; int KIN_ls; /* * ---------------------------------------------------------------- * private constants * ---------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ---------------------------------------------------------------- * prototype of user-supplied fortran routine * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_FUN(realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_MALLOC * ---------------------------------------------------------------- */ void FKIN_MALLOC(long int *iout, realtype *rout, int *ier) { /* check for required vector operations */ if ((F2C_KINSOL_vec->ops->nvgetarraypointer == NULL) || (F2C_KINSOL_vec->ops->nvsetarraypointer == NULL)) { *ier = -1; printf("A required vector operation is not implemented.\n\n"); return; } /* Initialize pointers to NULL */ KIN_kinmem = NULL; /* Create KINSOL object */ KIN_kinmem = KINCreate(); if (KIN_kinmem == NULL) { *ier = -1; return; } /* Call KINInit */ *ier = 0; *ier = KINInit(KIN_kinmem, FKINfunc, F2C_KINSOL_vec); /* On failure, exit */ if (*ier != KIN_SUCCESS) { *ier = -1; return; } /* Grab optional output arrays and store them in global variables */ KIN_iout = iout; KIN_rout = rout; return; } /* * ---------------------------------------------------------------- * Function : FKIN_SETIIN * ---------------------------------------------------------------- */ void FKIN_SETIIN(char key_name[], long int *ival, int *ier, int key_len) { if (!strncmp(key_name,"PRNT_LEVEL", (size_t)key_len)) *ier = KINSetPrintLevel(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"MAX_NITERS", (size_t)key_len)) *ier = KINSetNumMaxIters(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"ETA_FORM", (size_t)key_len)) *ier = KINSetEtaForm(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"MAX_SETUPS", (size_t)key_len)) *ier = KINSetMaxSetupCalls(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"MAX_SP_SETUPS", (size_t)key_len)) *ier = KINSetMaxSubSetupCalls(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"NO_INIT_SETUP", (size_t)key_len)) *ier = KINSetNoInitSetup(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"NO_MIN_EPS", (size_t)key_len)) *ier = KINSetNoMinEps(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"NO_RES_MON", (size_t)key_len)) *ier = KINSetNoResMon(KIN_kinmem, (int) *ival); else { *ier = -99; printf("FKINSETIIN: Unrecognized key.\n\n"); } } /* * ---------------------------------------------------------------- * Function : FKIN_SETRIN * ---------------------------------------------------------------- */ void FKIN_SETRIN(char key_name[], realtype *rval, int *ier, int key_len) { if (!strncmp(key_name,"FNORM_TOL", (size_t)key_len)) *ier = KINSetFuncNormTol(KIN_kinmem, *rval); else if (!strncmp(key_name,"SSTEP_TOL", (size_t)key_len)) *ier = KINSetScaledStepTol(KIN_kinmem, *rval); else if (!strncmp(key_name,"MAX_STEP", (size_t)key_len)) *ier = KINSetMaxNewtonStep(KIN_kinmem, *rval); else if (!strncmp(key_name,"RERR_FUNC", (size_t)key_len)) *ier = KINSetRelErrFunc(KIN_kinmem, *rval); else if (!strncmp(key_name,"ETA_CONST", (size_t)key_len)) *ier = KINSetEtaConstValue(KIN_kinmem, *rval); else if (!strncmp(key_name,"ETA_PARAMS", (size_t)key_len)) *ier = KINSetEtaParams(KIN_kinmem, rval[0], rval[1]); else if (!strncmp(key_name,"RMON_CONST", (size_t)key_len)) *ier = KINSetResMonConstValue(KIN_kinmem, *rval); else if (!strncmp(key_name,"RMON_PARAMS", (size_t)key_len)) *ier = KINSetResMonParams(KIN_kinmem, rval[0], rval[1]); else { *ier = -99; printf("FKINSETRIN: Unrecognized key.\n\n"); } } /* * ---------------------------------------------------------------- * Function : FKIN_SETVIN * ---------------------------------------------------------------- */ void FKIN_SETVIN(char key_name[], realtype *vval, int *ier, int key_len) { N_Vector Vec; if (!strncmp(key_name,"CONSTR_VEC", (size_t)key_len)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_KINSOL_vec); if (Vec == NULL) { *ier = -1; return; } N_VSetArrayPointer(vval, Vec); KINSetConstraints(KIN_kinmem, Vec); N_VDestroy(Vec); } else { *ier = -99; printf("FKINSETVIN: Unrecognized key.\n\n"); } } /* * ---------------------------------------------------------------- * Function : FKIN_DENSE * ---------------------------------------------------------------- */ void FKIN_DENSE(long int *neq, int *ier) { *ier = KINDense(KIN_kinmem, *neq); KIN_ls = KIN_LS_DENSE; } /* * ---------------------------------------------------------------- * Function : FKIN_BAND * ---------------------------------------------------------------- */ void FKIN_BAND(long int *neq, long int *mupper, long int *mlower, int *ier) { *ier = KINBand(KIN_kinmem, *neq, *mupper, *mlower); KIN_ls = KIN_LS_BAND; } /* * ---------------------------------------------------------------- * Function : FKIN_SPTFQMR * ---------------------------------------------------------------- */ void FKIN_SPTFQMR(int *maxl, int *ier) { *ier = KINSptfqmr(KIN_kinmem, *maxl); KIN_ls = KIN_LS_SPTFQMR; } /* * ---------------------------------------------------------------- * Function : FKIN_SPBCG * ---------------------------------------------------------------- */ void FKIN_SPBCG(int *maxl, int *ier) { *ier = KINSpbcg(KIN_kinmem, *maxl); KIN_ls = KIN_LS_SPBCG; } /* * ---------------------------------------------------------------- * Function : FKIN_SPGMR * ---------------------------------------------------------------- */ void FKIN_SPGMR(int *maxl, int *maxlrst, int *ier) { *ier = KINSpgmr(KIN_kinmem, *maxl); KINSpilsSetMaxRestarts(KIN_kinmem, *maxlrst); KIN_ls = KIN_LS_SPGMR; } /* * ---------------------------------------------------------------- * Function : FKIN_SOL * ---------------------------------------------------------------- */ void FKIN_SOL(realtype *uu, int *globalstrategy, realtype *uscale , realtype *fscale, int *ier) { int lsflag; N_Vector uuvec, uscalevec, fscalevec; *ier = 0; uuvec = uscalevec = fscalevec = NULL; uuvec = F2C_KINSOL_vec; N_VSetArrayPointer(uu, uuvec); uscalevec = NULL; uscalevec = N_VCloneEmpty(F2C_KINSOL_vec); if (uscalevec == NULL) { *ier = -4; /* KIN_MEM_FAIL */ return; } N_VSetArrayPointer(uscale, uscalevec); fscalevec = NULL; fscalevec = N_VCloneEmpty(F2C_KINSOL_vec); if (fscalevec == NULL) { N_VDestroy(uscalevec); *ier = -4; /* KIN_MEM_FAIL */ return; } N_VSetArrayPointer(fscale, fscalevec); /* Call main solver function */ *ier = KINSol(KIN_kinmem, uuvec, *globalstrategy, uscalevec, fscalevec); N_VSetArrayPointer(NULL, uuvec); N_VSetArrayPointer(NULL, uscalevec); N_VDestroy(uscalevec); N_VSetArrayPointer(NULL, fscalevec); N_VDestroy(fscalevec); /* load optional outputs into iout[] and rout[] */ KINGetWorkSpace(KIN_kinmem, &KIN_iout[0], &KIN_iout[1]); /* LENRW & LENIW */ KINGetNumNonlinSolvIters(KIN_kinmem, &KIN_iout[2]); /* NNI */ KINGetNumFuncEvals(KIN_kinmem, &KIN_iout[3]); /* NFE */ KINGetNumBetaCondFails(KIN_kinmem, &KIN_iout[4]); /* NBCF */ KINGetNumBacktrackOps(KIN_kinmem, &KIN_iout[5]); /* NBCKTRK */ KINGetFuncNorm(KIN_kinmem, &KIN_rout[0]); /* FNORM */ KINGetStepLength(KIN_kinmem, &KIN_rout[1]); /* SSTEP */ switch(KIN_ls) { case KIN_LS_DENSE: case KIN_LS_BAND: case KIN_LS_LAPACKDENSE: case KIN_LS_LAPACKBAND: KINDlsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */ KINDlsGetLastFlag(KIN_kinmem, &KIN_iout[8]); /* LSTF */ KINDlsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]); /* NFE */ KINDlsGetNumJacEvals(KIN_kinmem, &KIN_iout[10]); /* NJE */ case KIN_LS_SPTFQMR: case KIN_LS_SPBCG: case KIN_LS_SPGMR: KINSpilsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */ KINSpilsGetLastFlag(KIN_kinmem, &KIN_iout[8]); /* LSTF */ KINSpilsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]); /* NFE */ KINSpilsGetNumJtimesEvals(KIN_kinmem, &KIN_iout[10]); /* NJE */ KINSpilsGetNumPrecEvals(KIN_kinmem, &KIN_iout[11]); /* NPE */ KINSpilsGetNumPrecSolves(KIN_kinmem, &KIN_iout[12]); /* NPS */ KINSpilsGetNumLinIters(KIN_kinmem, &KIN_iout[13]); /* NLI */ KINSpilsGetNumConvFails(KIN_kinmem, &KIN_iout[14]); /* NCFL */ break; } return; } /* * ---------------------------------------------------------------- * Function : FKIN_FREE * ---------------------------------------------------------------- */ void FKIN_FREE(void) { /* call KINFree: KIN_kinmem is the pointer to the KINSOL memory block */ KINFree(&KIN_kinmem); N_VSetArrayPointer(NULL , F2C_KINSOL_vec); N_VDestroy(F2C_KINSOL_vec); return; } /* * ---------------------------------------------------------------- * Function : FKINfunc * ---------------------------------------------------------------- * The C function FKINfunc acts as an interface between KINSOL and * the Fortran user-supplied subroutine FKFUN. Addresses of the * data uu and fdata are passed to FKFUN, using the routine * N_VGetArrayPointer from the NVECTOR module. The data in the * returned N_Vector fval is set using N_VSetArrayPointer. Auxiliary * data is assumed to be communicated by 'Common'. * ---------------------------------------------------------------- */ int FKINfunc(N_Vector uu, N_Vector fval, void *user_data) { realtype *udata, *fdata; int ier; udata = N_VGetArrayPointer(uu); fdata = N_VGetArrayPointer(fval); FK_FUN(udata, fdata, &ier); return(0); } sundials-2.5.0/src/kinsol/fcmix/CMakeLists.txt0000600000175000017500000000235311741421272022152 0ustar sylvestresylvestre# CMakeLists.txt file for the FKINSOL library # Add variable fcvode_SOURCES with the sources for the FCVODE library SET(fkinsol_SOURCES fkinband.c fkinbbd.c fkindense.c fkinjtimes.c fkinpreco.c fkinsol.c ) IF(LAPACK_FOUND) SET(fkinsol_BL_SOURCES fkinlapack.c fkinlapdense.c fkinlapband.c) ELSE(LAPACK_FOUND) SET(fkinsol_BL_SOURCES "") ENDIF(LAPACK_FOUND) # Add source directories to include directories for access to # implementation only header files (both for fkinsol and kinsol) INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(..) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Only build STATIC libraries (we cannot build shared libraries # for the FCMIX interfaces due to unresolved symbol errors # coming from inexistent user-provided functions) # Add the build target for the FKINSOL library ADD_LIBRARY(sundials_fkinsol_static STATIC ${fkinsol_SOURCES} ${fkinsol_BL_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_fkinsol_static PROPERTIES OUTPUT_NAME sundials_fkinsol CLEAN_DIRECT_OUTPUT 1) # Install the FKINSOL library INSTALL(TARGETS sundials_fkinsol_static DESTINATION lib) # MESSAGE(STATUS "Added KINSOL FCMIX module") sundials-2.5.0/src/kinsol/fcmix/Makefile.in0000600000175000017500000001034311741421272021455 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/03/25 23:10:50 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FKINSOL module # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ builddir = @builddir@ abs_builddir = @abs_builddir@ top_builddir = @top_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_LIB = @INSTALL_PROGRAM@ INSTALL_HEADER = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ top_srcdir = $(srcdir)/../../.. INCLUDES = -I$(top_srcdir)/include -I$(top_srcdir)/src/kinsol -I$(top_builddir)/include LIB_REVISION = 0:1:0 FKINSOL_LIB = libsundials_fkinsol.la FKINSOL_SRC_FILES = fkinsol.c fkindense.c fkinband.c fkinpreco.c fkinjtimes.c fkinbbd.c FKINSOL_BL_SRC_FILES = fkinlapack.c fkinlapdense.c fkinlapband.c FKINSOL_OBJ_FILES = $(FKINSOL_SRC_FILES:.c=.o) FKINSOL_BL_OBJ_FILES = $(FKINSOL_BL_SRC_FILES:.c=.o) FKINSOL_LIB_FILES = $(FKINSOL_SRC_FILES:.c=.lo) FKINSOL_BL_LIB_FILES = $(FKINSOL_BL_SRC_FILES:.c=.lo) mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs # ---------------------------------------------------------------------------------------------------------------------- all: $(FKINSOL_LIB) $(FKINSOL_LIB): $(FKINSOL_LIB_FILES) @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ make lib_with_bl; \ else \ make lib_without_bl; \ fi lib_without_bl: $(FKINSOL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FKINSOL_LIB) $(FKINSOL_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) lib_with_bl: $(FKINSOL_LIB_FILES) $(FKINSOL_BL_LIB_FILES) $(LIBTOOL) --mode=link $(CC) $(CFLAGS) -o $(FKINSOL_LIB) $(FKINSOL_LIB_FILES) $(FKINSOL_BL_LIB_FILES) -rpath $(libdir) $(LDFLAGS) $(LIBS) -static -version-info $(LIB_REVISION) install: $(FKINSOL_LIB) $(mkinstalldirs) $(libdir) $(LIBTOOL) --mode=install $(INSTALL_LIB) $(FKINSOL_LIB) $(libdir) uninstall: $(LIBTOOL) --mode=uninstall rm -f $(libdir)/$(FKINSOL_LIB) clean: $(LIBTOOL) --mode=clean rm -f $(FKINSOL_LIB) rm -f $(FKINSOL_LIB_FILES) rm -f $(FKINSOL_BL_LIB_FILES) rm -f $(FKINSOL_OBJ_FILES) rm -f $(FKINSOL_BL_OBJ_FILES) distclean: clean rm -f Makefile fkinsol.lo: $(srcdir)/fkinsol.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinsol.c fkinpreco.lo: $(srcdir)/fkinpreco.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinpreco.c fkinjtimes.lo: $(srcdir)/fkinjtimes.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinjtimes.c fkinbbd.lo: $(srcdir)/fkinbbd.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinbbd.c fkindense.lo: $(srcdir)/fkindense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkindense.c fkinband.lo: $(srcdir)/fkinband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinband.c fkinlapack.lo: $(srcdir)/fkinlapack.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinlapack.c fkinlapdense.lo: $(srcdir)/fkinlapdense.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinlapdense.c fkinlapband.lo: $(srcdir)/fkinlapband.c $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(INCLUDES) $(CFLAGS) -c $(srcdir)/fkinlapband.c libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/src/kinsol/fcmix/fkinbbd.c0000600000175000017500000001026511741421272021156 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This module contains the routines necessary to interface with * the KINBBDPRE module and user-supplied Fortran routines. Generic * names are used (e.g. FK_COMMFN). The routines here call the * generically named routines and provide a standard interface to * the C code of the KINBBDPRE package. * ---------------------------------------------------------------- */ #include #include #include "fkinsol.h" /* standard interfaces and global variables */ #include "fkinbbd.h" /* prototypes of interfaces to KINBBDPRE */ #include /* prototypes of KINBBDPRE functions and macros */ #include /* prototypes of KINSPTFQMR interface routines */ #include /* prototypes of KINSPBCG interface routines */ #include /* prototypes of KINSPGMR interface routines */ /* * ---------------------------------------------------------------- * private constants * ---------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_LOCFN(long int*, realtype*, realtype*, int*); extern void FK_COMMFN(long int*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_BBDINIT * ---------------------------------------------------------------- */ void FKIN_BBDINIT(long int *nlocal, long int *mudq, long int *mldq, long int *mu, long int *ml, int *ier) { *ier = KINBBDPrecInit(KIN_kinmem, *nlocal, *mudq, *mldq, *mu, *ml, ZERO, FKINgloc, FKINgcomm); return; } /* * ---------------------------------------------------------------- * Function : FKINgloc * ---------------------------------------------------------------- * C function FKINgloc is the interface between the KINBBDPRE * module and the Fortran subroutine FK_LOCFN. * ---------------------------------------------------------------- */ int FKINgloc(long int Nloc, N_Vector uu, N_Vector gval, void *user_data) { realtype *uloc, *gloc; int ier; uloc = gloc = NULL; uloc = N_VGetArrayPointer(uu); gloc = N_VGetArrayPointer(gval); FK_LOCFN(&Nloc, uloc, gloc, &ier); N_VSetArrayPointer(gloc, gval); return(0); } /* * ---------------------------------------------------------------- * Function : FKINgcomm * ---------------------------------------------------------------- * C function FKINgcomm is the interface between the KINBBDPRE * module and the Fortran subroutine FK_COMMFN. * ---------------------------------------------------------------- */ int FKINgcomm(long int Nloc, N_Vector uu, void *user_data) { realtype *uloc; int ier; uloc = NULL; uloc = N_VGetArrayPointer(uu); FK_COMMFN(&Nloc, uloc, &ier); return(0); } /* * ---------------------------------------------------------------- * Function : FKIN_BBDOPT * ---------------------------------------------------------------- * C function FKIN_BBDOPT is used to access optional outputs * realated to the BBD preconditioner. * ---------------------------------------------------------------- */ void FKIN_BBDOPT(long int *lenrpw, long int *lenipw, long int *nge) { KINBBDPrecGetWorkSpace(KIN_kinmem, lenrpw, lenipw); KINBBDPrecGetNumGfnEvals(KIN_kinmem, nge); return; } sundials-2.5.0/src/kinsol/fcmix/fkinlapdense.c0000600000175000017500000000635211741421272022224 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINLAPACKDENSE, for the * case of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" /* prototypes of standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_DJAC(long int*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_LAPACKDENSESETJAC * ---------------------------------------------------------------- */ void FKIN_LAPACKDENSESETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINDlsSetDenseJacFn(KIN_kinmem, NULL); } else { *ier = KINDlsSetDenseJacFn(KIN_kinmem, FKINLapackDenseJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINLapackDenseJac * ---------------------------------------------------------------- * C function FKINLapackDenseJac interfaces between KINSOL and a * Fortran subroutine FKDJAC for solution of a linear system * with dense Jacobian approximation using lapack functinos. * Addresses are passed to FKDJAC, using the macro DENSE_COL * and the routine N_VGetArrayPointer from NVECTOR. * Auxiliary data is assumed to be communicated by common blocks. * ---------------------------------------------------------------- */ int FKINLapackDenseJac(long int N, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); jacdata = DENSE_COL(J,0); /* Call user-supplied routine */ FK_DJAC(&N, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } sundials-2.5.0/src/kinsol/fcmix/fkinlapband.c0000600000175000017500000000665111741421272022034 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINBAND, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" /* standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_BJAC(long int*, long int*, long int*, long int*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_LAPACKBANDSETJAC * ---------------------------------------------------------------- */ void FKIN_LAPACKBANDSETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINDlsSetBandJacFn(KIN_kinmem, NULL); } else { *ier = KINDlsSetBandJacFn(KIN_kinmem, FKINLapackBandJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINLapackBandJac * ---------------------------------------------------------------- * C function FKINLapackBandJac interfaces between KINSOL and a * Fortran subroutine FKBJAC for solution of a linear system with * band Jacobian approximation using Lapack functions. * Addresses are passed to FKBJAC for the banded Jacobian and * vector data. * Auxiliary data is assumed to be communicated by common blocks. * ---------------------------------------------------------------- */ int FKINLapackBandJac(long int N, long int mupper, long int mlower, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; long int eband; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; /* Call user-supplied routine */ FK_BJAC(&N, &mupper, &mlower, &eband, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } sundials-2.5.0/src/kinsol/fcmix/fkinjtimes.c0000600000175000017500000000457311741421272021727 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:29:01 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Routines used to interface between KINSOL and a Fortran * user-supplied routine FKJTIMES (Jacobian J times vector v). * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include /* * ---------------------------------------------------------------- * prototype of the user-supplied fortran routine * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_JTIMES(realtype*, realtype*, int*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_SPILSSETJAC * ---------------------------------------------------------------- */ void FKIN_SPILSSETJAC(int *flag, int *ier) { if ((*flag) == 0) KINSpilsSetJacTimesVecFn(KIN_kinmem, NULL); else KINSpilsSetJacTimesVecFn(KIN_kinmem, FKINJtimes); return; } /* * ---------------------------------------------------------------- * Function : FKINJtimes * ---------------------------------------------------------------- * C function FKINJtimes is used to interface between * KINSp* / KINSp*JTimes and FK_JTIMES (user-supplied Fortran * routine). * ---------------------------------------------------------------- */ int FKINJtimes(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *user_data) { int retcode; realtype *vdata, *Jvdata, *uudata; vdata = Jvdata = uudata = NULL; vdata = N_VGetArrayPointer(v); uudata = N_VGetArrayPointer(uu); Jvdata = N_VGetArrayPointer(Jv); FK_JTIMES(vdata, Jvdata, (int *) new_uu, uudata, &retcode); return(retcode); } sundials-2.5.0/src/kinsol/fcmix/fkinband.c0000600000175000017500000000653111741421272021334 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINBAND, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" /* standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_BJAC(long int*, long int*, long int*, long int*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_BANDSETJAC * ---------------------------------------------------------------- */ void FKIN_BANDSETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINDlsSetBandJacFn(KIN_kinmem, NULL); } else { *ier = KINDlsSetBandJacFn(KIN_kinmem, FKINBandJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINBandJac * ---------------------------------------------------------------- * C function FKINBandJac interfaces between KINSOL and a Fortran * subroutine FKBJAC for solution of a linear system with band * Jacobian approximation. Addresses are passed to FKBJAC for * the banded Jacobian and vector data. * Auxiliary data is assumed to be communicated by common blocks. * ---------------------------------------------------------------- */ int FKINBandJac(long int N, long int mupper, long int mlower, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; long int eband; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); eband = (J->s_mu) + mlower + 1; jacdata = BAND_COL(J,0) - mupper; /* Call user-supplied routine */ FK_BJAC(&N, &mupper, &mlower, &eband, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } sundials-2.5.0/src/kinsol/fcmix/fkindense.c0000600000175000017500000000621511741421272021525 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:45:33 $ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2005, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINDENSE, for the case * of a user-supplied Jacobian approximation routine. * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" /* prototypes of standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_DJAC(long int*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_DENSESETJAC * ---------------------------------------------------------------- */ void FKIN_DENSESETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINDlsSetDenseJacFn(KIN_kinmem, NULL); } else { *ier = KINDlsSetDenseJacFn(KIN_kinmem, FKINDenseJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINDenseJac * ---------------------------------------------------------------- * C function FKINDenseJac interfaces between KINSOL and a Fortran * subroutine FKDJAC for solution of a linear system with dense * Jacobian approximation. Addresses are passed to FKDJAC, using * the macro DENSE_COL from DENSE and the routine N_VGetArrayPointer * from NVECTOR. Auxiliary data is assumed to be communicated by * Common. * ---------------------------------------------------------------- */ int FKINDenseJac(long int N, N_Vector uu, N_Vector fval, DlsMat J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); jacdata = DENSE_COL(J,0); /* Call user-supplied routine */ FK_DJAC(&N, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } sundials-2.5.0/src/kinsol/fcmix/fkinlapack.c0000600000175000017500000000245311741421272021662 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2006/11/22 00:12:51 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINLAPACK * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include /***************************************************************************/ void FKIN_LAPACKDENSE(int *neq, int *ier) { *ier = KINLapackDense(KIN_kinmem, *neq); KIN_ls = KIN_LS_LAPACKDENSE; } /***************************************************************************/ void FCV_LAPACKBAND(int *neq, int *mupper, int *mlower, int *ier) { *ier = KINLapackBand(KIN_kinmem, *neq, *mupper, *mlower); KIN_ls = KIN_LS_LAPACKBAND; } /***************************************************************************/ sundials-2.5.0/src/kinsol/fcmix/fkinbbd.h0000600000175000017500000003156611741421272021172 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.8 $ * $Date: 2010/12/15 19:40:08 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the Fortran interface include file for the BBD * preconditioner module KINBBDPRE. * ----------------------------------------------------------------- */ /******************************************************************************* FKINBBD Interface Package The FKINBBD Interface Package is a package of C functions which support the use of the KINSOL solver with the KINBBDPRE preconditioner module, for the solution of nonlinear systems in a mixed Fortran/C setting. The combination of KINSOL and KINBBDPRE solves systems f(u) = 0 with the SPGMR (scaled preconditioned GMRES), SPBCG (scaled preconditioned Bi-CGSTAB), or SPTFQMR (scaled preconditioned TFQMR) method for the linear systems that arise, and with a preconditioner that is block-diagonal with banded blocks. While KINSOL and KINBBDPRE are written in C, it is assumed here that the user's calling program and user-supplied problem-defining routines are written in Fortran. The user-callable functions in this package, with the corresponding KINSOL and KINBBDPRE functions, are as follows: FKINBBDINIT : interfaces to KINBBDPrecInit FKINBBDSPTFQMR: interfaces with KINSptfqmr FKINBBDSPBCG : interfaces with KINSpbcg FKINBBDSPGMR : interfaces with KINSpgmr FKINBBDOPT : accesses optional outputs FKINBBDFREE : interfaces to KINBBDPrecFree In addition to the Fortran system function FKFUN, and optional Jacobian vector product routine FKJTIMES, the following are the user-supplied functions required by this package, each with the corresponding interface function which calls it (and its type within KINBBDPRE): FKLOCFN : called by the interface function FKINgloc of type KINLocalFn FKCOMMFN : called by the interface function FKINgcomm of type KINCommFn Note: The names of all user-supplied routines here are fixed, in order to maximize portability for the resulting mixed-language program. Note: The names used within this interface package make use of the preprocessor to expand them appropriately for different machines/platforms. Later in this file, each name is expanded appropriately. For example, FKIN_BBDINIT is replaced with either fkinbbdinit, fkinbbdinit_, or fkinbbdinit__ depending upon the platform. ============================================================================== Usage of the FKINSOL/FKINBBD Interface Packages The usage of combined interface packages FKINSOL and FKINBBD requires calls to several interface functions, and a few user-supplied routines which define the problem to be solved and indirectly define the preconditioner. These function calls and user routines are summarized separately below. Some details have been omitted, and the user is referred to the KINSOL User Guide for more complete information. (1) User-supplied system function routine: FKFUN The user must in all cases supply the following Fortran routine: SUBROUTINE FKFUN (UU, FVAL, IER) DIMENSION UU(*), FVAL(*) It must set the FVAL array to f(u), the system function, as a function of the array UU = u. Here UU and FVAL are vectors (distributed in the parallel case). IER is a return flag (currently not used). (2) Optional user-supplied Jacobian-vector product routine: FKJTIMES As an option, the user may supply a routine that computes the product of the system Jacobian and a given vector. The user-supplied function must have the following form: SUBROUTINE FKJTIMES (V, Z, NEWU, UU, IER) DIMENSION V(*), Z(*), UU(*) This must set the array Z to the product J*V, where J is the Jacobian matrix J = dF/du, and V is a given array. Here UU is an array containing the current value of the unknown vector u, and NEWU is an input integer indicating whether UU has changed since FKJTIMES was last called (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then no such computation is necessary when NEWU = 0. Here V, Z, and UU are arrays of length NLOC - the local length of all distributed vectors. FKJTIMES should return IER = 0 if successful, or a nonzero IER otherwise. (3) User-supplied routines to define preconditoner: FKLOCFN and FKCOMMFN The routines in the KINBBDPRE (kinbbdpre.c) module provide a preconditioner matrix for KINSOL that is block-diagonal with banded blocks. The blocking corresponds to the distribution of the dependent variable vector u amongst the processes. Each preconditioner block is generated from the Jacobian of the local part (associated with the current process) of a given function g(u) approximating f(u). The blocks are generated by a difference quotient scheme (independently by each process), utilizing the assumed banded structure with given half-bandwidths. (3.1) Local approximate function: FKLOCFN The user must supply a subroutine of the following form: SUBROUTINE FKLOCFN (NLOC, ULOC, GLOC, IER) DIMENSION ULOC(*), GLOC(*) The routine is used to compute the function g(u) which approximates the system function f(u). This function is to be computed locally, i.e. without inter-process communication. Note: The case where g is mathematically identical to f is allowed. It takes as input the local vector length (NLOC) and the local real solution array ULOC. It is to compute the local part of g(u) and store the result in the realtype array GLOC. IER is a return flag (currently not used). (3.2) Communication function: FKCOMMFN The user must also supply a subroutine of the following form: SUBROUTINE FKCOMMFN (NLOC, ULOC, IER) DIMENSION ULOC(*) The routine is used to perform all inter-process communication necessary to evaluate the approximate system function g described above. This function takes as input the local vector length (NLOC), and the local real dependent variable array ULOC. It is expected to save communicated data in work space defined by the user, and made available to FKLOCFN. Each call to the FKCOMMFN function is preceded by a call to FKFUN with the same arguments. Thus FKCOMMFN can omit any communications done by FKFUN if relevant to the evaluation of g. IER is a return flag (currently not used). (4) Initialization: FNVINITP, FKINMALLOC, FKINBBDINIT, and FKINBBDSP* (4.1) To initialize the parallel machine environment, the user must make the following call: CALL FNVINITP (5, NLOCAL, NGLOBAL, IER) The arguments are: NLOCAL = local size of vectors associated with process NGLOBAL = the system size, and the global size of vectors (the sum of all values of NLOCAL) IER = return completion flag. Values are 0 = success, and -1 = failure. (4.2) To allocate internal memory for KINSOL, make the following call: CALL FKINMALLOC (MSBPRE, FNORMTOL, SCSTEPTOL, CONSTRAINTS, OPTIN, IOPT, ROPT, IER) The arguments are: MSBPRE = maximum number of preconditioning solve calls without calling the preconditioning setup routine Note: 0 indicates default (10). FNORMTOL = tolerance on the norm of f(u) to accept convergence SCSTEPTOL = tolerance on minimum scaled step size CONSTRAINTS = array of constraint values on components of the solution vector UU INOPT = integer used as a flag to indicate whether possible input values in IOPT[] array are to be used for input: 0 = no and 1 = yes. IOPT = array for integer optional inputs and outputs (declare as INTEGER*4 or INTEGER*8 according to C type long int) ROPT = array of real optional inputs and outputs IER = return completion flag. Values are 0 = success, and -1 = failure. Note: See printed message for details in case of failure. (4.3) Attach one of the 3 SPILS linear solvers. Make one of the following calls (see fkinsol.h) for more details. CALL FKINSPGMR (MAXL, MAXLRST, IER) CALL FKINSPBCG (MAXL, IER) CALL FKINSPTFQMR (MAXL, IER) (4.4) To allocate memory and initialize data associated with the BBD preconditioner, make the following call: CALL FKINBBDINIT (NLOCAL, MU, ML, IER) The arguments are: NLOCAL = local size of vectors associated with process MU, ML = upper and lower half-bandwidths to be used during the computation of the local Jacobian blocks. These may be smaller than the true half-bandwidths of the Jacobian of the local block of g, when smaller values may provide greater efficiency. IER = return completion flag. Values are 0 = success, and -1 = failure. (5) To solve the system, make the following call: CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) The arguments are: UU = array containing the initial guess when called and the solution upon termination GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: 1 = inexact Newton, 2 = line search. USCALE = array of scaling factors for the UU vector FSCALE = array of scaling factors for the FVAL (function) vector IER = integer error flag as returned by KINSOL. Note: See the KINSOL documentation for further information. (6) Optional outputs: FKINBBDOPT In addition to the optional inputs and outputs available with the FKINSOL interface package, there are optional outputs specific to the KINBBDPRE module. These are accessed by making the following call: CALL FKINBBDOPT (LENRPW, LENIPW, NGE) The arguments returned are: LENRPW = length of real preconditioner work space, in realtype words Note: This size is local to the current process. LENIPW = length of integer preconditioner work space, in integer words Note: This size is local to the current process. NGE = number of g(u) evaluations (calls to FKLOCFN) (7) Memory freeing: FKINFREE To the free the internal memory created by the calls to FNVINITP and FKINMALLOC, make the following call: CALL FKINFREE *******************************************************************************/ #ifndef _FKINBBD_H #define _FKINBBD_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * header files * ----------------------------------------------------------------- */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ /* * ----------------------------------------------------------------- * generic names are translated through the define statements below * ----------------------------------------------------------------- */ #if defined(SUNDIALS_F77_FUNC) #define FKIN_BBDINIT SUNDIALS_F77_FUNC(fkinbbdinit, FKINBBDINIT) #define FKIN_BBDOPT SUNDIALS_F77_FUNC(fkinbbdopt, FKINBBDOPT) #define FK_COMMFN SUNDIALS_F77_FUNC(fkcommfn, FKCOMMFN) #define FK_LOCFN SUNDIALS_F77_FUNC(fklocfn, FKLOCFN) #else #define FKIN_BBDINIT fkinbbdinit_ #define FKIN_BBDOPT fkinbbdopt_ #define FK_COMMFN fkcommfn_ #define FK_LOCFN fklocfn_ #endif /* * ----------------------------------------------------------------- * Prototypes: exported functions * ----------------------------------------------------------------- */ void FKIN_BBDINIT(long int *nlocal, long int *mudq, long int *mldq, long int *mu, long int *ml, int *ier); void FKIN_BBDOPT(long int *lenrpw, long int *lenipw, long int *nge); /* * ----------------------------------------------------------------- * Prototypes: FKINgloc and FKINgcomm * ----------------------------------------------------------------- */ int FKINgloc(long int Nloc, N_Vector uu, N_Vector gval, void *user_data); int FKINgcomm(long int Nloc, N_Vector uu, void *user_data); #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/fcmix/fkinpreco.c0000600000175000017500000001042111741421272021531 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2007/04/30 19:29:01 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This file contains the interfaces between KINSOL and the * user-supplied Fortran routines FK_PSET and FK_PSOL. * * The C function FKINPSet is used to interface between KINSOL and * the Fortran user-supplied preconditioner setup routine. * * The C function FKINPSol is used to interface between KINSOL and * the Fortran user-supplied preconditioner solve routine. * * Note: The use of the generic names FK_PSET and FK_PSOL below. * ----------------------------------------------------------------- */ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include /* * ---------------------------------------------------------------- * prototype of the user-supplied fortran routine * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_PSET(realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); extern void FK_PSOL(realtype*, realtype*, realtype*, realtype*, realtype*, realtype*, int*); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_SPILSSETPREC * ---------------------------------------------------------------- */ void FKIN_SPILSSETPREC(int *flag, int *ier) { if ((*flag) == 0) { *ier = KINSpilsSetPreconditioner(KIN_kinmem, NULL, NULL); } else { *ier = KINSpilsSetPreconditioner(KIN_kinmem, FKINPSet, FKINPSol); } return; } /* * ---------------------------------------------------------------- * Function : FKINPSet * ---------------------------------------------------------------- * C function FKINPSet is used to interface between FK_PSET and * the user-supplied Fortran preconditioner setup routine. * ---------------------------------------------------------------- */ int FKINPSet(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *udata, *uscaledata, *fdata, *fscaledata, *vtemp1data, *vtemp2data; int retcode; udata = uscaledata = fdata = fscaledata = vtemp1data = vtemp2data = NULL; udata = N_VGetArrayPointer(uu); uscaledata = N_VGetArrayPointer(uscale); fdata = N_VGetArrayPointer(fval); fscaledata = N_VGetArrayPointer(fscale); vtemp1data = N_VGetArrayPointer(vtemp1); vtemp2data = N_VGetArrayPointer(vtemp2); FK_PSET(udata, uscaledata, fdata, fscaledata, vtemp1data, vtemp2data, &retcode); /* Note: There is no need to use N_VSetArrayPointer since we are not getting back any information that should go into an N_Vector */ return(retcode); } /* * ---------------------------------------------------------------- * Function : FKINPSol * ---------------------------------------------------------------- * C function FKINPSol is used to interface between FK_PSOL and * the user-supplied Fortran preconditioner solve routine. * ---------------------------------------------------------------- */ int FKINPSol(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector ftem) { realtype *udata, *uscaledata, *fdata, *fscaledata, *vvdata, *ftemdata; int retcode; udata = uscaledata = fdata = fscaledata = vvdata = ftemdata = NULL; udata = N_VGetArrayPointer(uu); uscaledata = N_VGetArrayPointer(uscale); fdata = N_VGetArrayPointer(fval); fscaledata = N_VGetArrayPointer(fscale); vvdata = N_VGetArrayPointer(vv); ftemdata = N_VGetArrayPointer(ftem); FK_PSOL(udata, uscaledata, fdata, fscaledata, vvdata, ftemdata, &retcode); return(retcode); } sundials-2.5.0/src/kinsol/kinsol_direct_impl.h0000600000175000017500000000700211741421272022323 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the KINDLS linear solvers. * ----------------------------------------------------------------- */ #ifndef _KINDLS_IMPL_H #define _KINDLS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include /* * ----------------------------------------------------------------- * Types: KINDlsMemRec, KINDlsMem * ----------------------------------------------------------------- * The type KINDlsMem is pointer to a KINDlsMemRec. * This structure contains KINDLS solver-specific data. * ----------------------------------------------------------------- */ typedef struct KINDlsMemRec { int d_type; /* SUNDIALS_DENSE or SUNDIALS_BAND */ long int d_n; /* problem dimension */ long int d_ml; /* lower bandwidth of Jacobian */ long int d_mu; /* upper bandwidth of Jacobian */ long int d_smu; /* upper bandwith of M = MIN(N-1,d_mu+d_ml) */ booleantype d_jacDQ; /* TRUE if using internal DQ Jacobian approx. */ KINDlsDenseJacFn d_djac; /* dense Jacobian routine to be called */ KINDlsBandJacFn d_bjac; /* band Jacobian routine to be called */ void *d_J_data; /* J_data is passed to djac or bjac */ DlsMat d_J; /* problem Jacobian */ int *d_pivots; /* int pivot array for PM = LU */ long int *d_lpivots; /* long int pivot array for PM = LU */ long int d_nje; /* no. of calls to jac */ long int d_nfeDQ; /* no. of calls to F due to DQ Jacobian approx. */ long int d_last_flag; /* last error return flag */ } *KINDlsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ int kinDlsDenseDQJac(long int N, N_Vector u, N_Vector fu, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2); int kinDlsBandDQJac(long int N, long int mupper, long int mlower, N_Vector u, N_Vector fu, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2); /* * ----------------------------------------------------------------- * Error Messages * ----------------------------------------------------------------- */ #define MSGD_KINMEM_NULL "KINSOL memory is NULL." #define MSGD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGD_MEM_FAIL "A memory request failed." #define MSGD_LMEM_NULL "Linear solver memory is NULL." #define MSGD_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSGD_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/kinsol_direct.c0000600000175000017500000003375611741421272021314 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.6 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2006, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * This is the implementation file for the KINDLS linear solvers * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "kinsol_impl.h" #include "kinsol_direct_impl.h" #include /* * ================================================================= * FUNCTION SPECIFIC CONSTANTS * ================================================================= */ /* Constant for DQ Jacobian approximation */ #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ================================================================= * READIBILITY REPLACEMENTS * ================================================================= */ #define lrw1 (kin_mem->kin_lrw1) #define liw1 (kin_mem->kin_liw1) #define uround (kin_mem->kin_uround) #define func (kin_mem->kin_func) #define user_data (kin_mem->kin_user_data) #define printfl (kin_mem->kin_printfl) #define linit (kin_mem->kin_linit) #define lsetup (kin_mem->kin_lsetup) #define lsolve (kin_mem->kin_lsolve) #define lfree (kin_mem->kin_lfree) #define lmem (kin_mem->kin_lmem) #define inexact_ls (kin_mem->kin_inexact_ls) #define uu (kin_mem->kin_uu) #define fval (kin_mem->kin_fval) #define uscale (kin_mem->kin_uscale) #define fscale (kin_mem->kin_fscale) #define sqrt_relfunc (kin_mem->kin_sqrt_relfunc) #define sJpnorm (kin_mem->kin_sJpnorm) #define sfdotJp (kin_mem->kin_sfdotJp) #define errfp (kin_mem->kin_errfp) #define infofp (kin_mem->kin_infofp) #define setupNonNull (kin_mem->kin_setupNonNull) #define vtemp1 (kin_mem->kin_vtemp1) #define vec_tmpl (kin_mem->kin_vtemp1) #define vtemp2 (kin_mem->kin_vtemp2) #define mtype (kindls_mem->d_type) #define n (kindls_mem->d_n) #define ml (kindls_mem->d_ml) #define mu (kindls_mem->d_mu) #define smu (kindls_mem->d_smu) #define jacDQ (kindls_mem->d_jacDQ) #define djac (kindls_mem->d_djac) #define bjac (kindls_mem->d_bjac) #define J (kindls_mem->d_J) #define pivots (kindls_mem->d_pivots) #define nje (kindls_mem->d_nje) #define nfeDQ (kindls_mem->d_nfeDQ) #define J_data (kindls_mem->d_J_data) #define last_flag (kindls_mem->d_last_flag) /* * ================================================================= * EXPORTED FUNCTIONS * ================================================================= */ /* * ----------------------------------------------------------------- * KINDlsSetJacFn * ----------------------------------------------------------------- */ int KINDlsSetDenseJacFn(void *kinmem, KINDlsDenseJacFn jac) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINDlsSetDenseJacFn", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINDlsSetDenseJacFn", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; djac = jac; } else { jacDQ = TRUE; } return(KINDLS_SUCCESS); } int KINDlsSetBandJacFn(void *kinmem, KINDlsBandJacFn jac) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINDlsSetBandJacFn", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINDlsSetBandJacFn", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; if (jac != NULL) { jacDQ = FALSE; bjac = jac; } else { jacDQ = TRUE; } return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINDlsGetWorkSpace * ----------------------------------------------------------------- */ int KINDlsGetWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINBandGetWorkSpace", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINBandGetWorkSpace", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; if (mtype == SUNDIALS_DENSE) { *lenrwLS = n*n; *leniwLS = n; } else if (mtype == SUNDIALS_BAND) { *lenrwLS = n*(smu + mu + 2*ml + 2); *leniwLS = n; } return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINDlsGetNumJacEvals * ----------------------------------------------------------------- */ int KINDlsGetNumJacEvals(void *kinmem, long int *njevals) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINDlsGetNumJacEvals", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINDlsGetNumJacEvals", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; *njevals = nje; return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINDlsGetNumFuncEvals * ----------------------------------------------------------------- */ int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevalsLS) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINDlsGetNumFuncEvals", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINDlsGetNumGuncEvals", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; *nfevalsLS = nfeDQ; return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINDlsGetLastFlag * ----------------------------------------------------------------- */ int KINDlsGetLastFlag(void *kinmem, long int *flag) { KINMem kin_mem; KINDlsMem kindls_mem; /* Return immediately if kinmem is NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINDLS_MEM_NULL, "KINDLS", "KINDlsGetLastFlag", MSGD_KINMEM_NULL); return(KINDLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (lmem == NULL) { KINProcessError(kin_mem, KINDLS_LMEM_NULL, "KINDLS", "KINDlsGetLastFlag", MSGD_LMEM_NULL); return(KINDLS_LMEM_NULL); } kindls_mem = (KINDlsMem) lmem; *flag = last_flag; return(KINDLS_SUCCESS); } /* * ----------------------------------------------------------------- * KINDlsGetReturnFlagName * ----------------------------------------------------------------- */ char *KINDlsGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case KINDLS_SUCCESS: sprintf(name, "KINDLS_SUCCESS"); break; case KINDLS_MEM_NULL: sprintf(name, "KINDLS_MEM_NULL"); break; case KINDLS_LMEM_NULL: sprintf(name, "KINDLS_LMEM_NULL"); break; case KINDLS_ILL_INPUT: sprintf(name, "KINDLS_ILL_INPUT"); break; case KINDLS_MEM_FAIL: sprintf(name, "KINDLS_MEM_FAIL"); break; default: sprintf(name, "NONE"); } return(name); } /* * ================================================================= * DQ JACOBIAN APPROXIMATIONS * ================================================================= */ /* * ----------------------------------------------------------------- * kinDlsDenseDQJac * ----------------------------------------------------------------- * This routine generates a dense difference quotient approximation to * the Jacobian of F(u). It assumes that a dense matrix of type * DlsMat is stored column-wise, and that elements within each column * are contiguous. The address of the jth column of J is obtained via * the macro DENSE_COL and this pointer is associated with an N_Vector * using the N_VGetArrayPointer/N_VSetArrayPointer functions. * Finally, the actual computation of the jth column of the Jacobian is * done with a call to N_VLinearSum. * * The increment used in the finite-difference approximation * J_ij = ( F_i(u+sigma_j * e_j) - F_i(u) ) / sigma_j * is * sigma_j = max{|u_j|, |1/uscale_j|} * sqrt(uround) * * Note: uscale_j = 1/typ(u_j) * * NOTE: Any type of failure of the system function her leads to an * unrecoverable failure of the Jacobian function and thus * of the linear solver setup function, stopping KINSOL. * ----------------------------------------------------------------- */ int kinDlsDenseDQJac(long int N, N_Vector u, N_Vector fu, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv, ujsaved, ujscale, sign; realtype *tmp2_data, *u_data, *uscale_data; N_Vector ftemp, jthCol; int retval = 0; long int j; KINMem kin_mem; KINDlsMem kindls_mem; /* data points to kin_mem */ kin_mem = (KINMem) data; kindls_mem = (KINDlsMem) lmem; /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for u and uscale */ u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(uscale); /* This is the only for loop for 0..N-1 in KINSOL */ for (j = 0; j < N; j++) { /* Generate the jth col of Jac(u) */ N_VSetArrayPointer(DENSE_COL(Jac,j), jthCol); ujsaved = u_data[j]; ujscale = ONE/uscale_data[j]; sign = (ujsaved >= ZERO) ? ONE : -ONE; inc = sqrt_relfunc*MAX(ABS(ujsaved), ujscale)*sign; u_data[j] += inc; retval = func(u, ftemp, user_data); nfeDQ++; if (retval != 0) break; u_data[j] = ujsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fu, jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /* * ----------------------------------------------------------------- * kinDlsBandDQJac * ----------------------------------------------------------------- * This routine generates a banded difference quotient approximation to * the Jacobian of F(u). It assumes that a band matrix of type * BandMat is stored column-wise, and that elements within each column * are contiguous. This makes it possible to get the address of a column * of J via the macro BAND_COL and to write a simple for loop to set * each of the elements of a column in succession. * * NOTE: Any type of failure of the system function her leads to an * unrecoverable failure of the Jacobian function and thus * of the linear solver setup function, stopping KINSOL. * ----------------------------------------------------------------- */ int kinDlsBandDQJac(long int N, long int mupper, long int mlower, N_Vector u, N_Vector fu, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv; N_Vector futemp, utemp; int retval; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *fu_data, *futemp_data, *u_data, *utemp_data, *uscale_data; KINMem kin_mem; KINDlsMem kindls_mem; /* data points to kinmem */ kin_mem = (KINMem) data; kindls_mem = (KINDlsMem) lmem; /* Rename work vectors for use as temporary values of u and fu */ futemp = tmp1; utemp = tmp2; /* Obtain pointers to the data for ewt, fy, futemp, y, ytemp */ fu_data = N_VGetArrayPointer(fu); futemp_data = N_VGetArrayPointer(futemp); u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(uscale); utemp_data = N_VGetArrayPointer(utemp); /* Load utemp with u */ N_VScale(ONE, u, utemp); /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = MIN(width, N); for (group=1; group <= ngroups; group++) { /* Increment all utemp components in group */ for(j=group-1; j < N; j+=width) { inc = sqrt_relfunc*MAX(ABS(u_data[j]), ABS(uscale_data[j])); utemp_data[j] += inc; } /* Evaluate f with incremented u */ retval = func(utemp, futemp, user_data); if (retval != 0) return(-1); /* Restore utemp components, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { utemp_data[j] = u_data[j]; col_j = BAND_COL(Jac,j); inc = sqrt_relfunc*MAX(ABS(u_data[j]), ABS(uscale_data[j])); inc_inv = ONE/inc; i1 = MAX(0, j-mupper); i2 = MIN(j+mlower, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (futemp_data[i] - fu_data[i]); } } /* Increment counter nfeDQ */ nfeDQ += ngroups; return(0); } sundials-2.5.0/src/kinsol/kinsol_spils_impl.h0000600000175000017500000001350711741421272022212 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:43:33 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Common implementation header file for the scaled, preconditioned * linear solver modules. * ----------------------------------------------------------------- */ #ifndef _KINSPILS_IMPL_H #define _KINSPILS_IMPL_H #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #include #include "kinsol_impl.h" /* Types of iterative linear solvers */ #define SPILS_SPGMR 1 #define SPILS_SPBCG 2 #define SPILS_SPTFQMR 3 /* * ----------------------------------------------------------------- * keys for KINPrintInfo (do not use 1 -> conflict with PRNT_RETVAL) * ----------------------------------------------------------------- */ #define PRNT_NLI 101 #define PRNT_EPS 102 /* * ----------------------------------------------------------------- * Types : struct KINSpilsMemRec and struct *KINSpilsMem * ----------------------------------------------------------------- * A variable declaration of type struct *KINSpilsMem denotes a * pointer to a data structure of type struct KINSpilsMemRec. The * KINSpilsMemRec structure contains fields that must be accessible * by KINSPILS/SPGMR solver module routines. * ----------------------------------------------------------------- */ typedef struct KINSpilsMemRec { int s_type; /* type of scaled preconditioned iterative LS */ /* problem specification data */ int s_maxl; /* maximum allowable dimension of Krylov subspace */ int s_pretype; /* preconditioning type: PREC_NONE, PREC_RIGHT, PREC_LEFT or PREC_BOTH (used by SPGMR module and defined in sundials_iterative.h) */ int s_gstype; /* Gram-Schmidt orthogonalization procedure: CLASSICAL_GS or MODIFIED_GS (used by SPGMR module and defined in sundials_iterative.h) */ booleantype s_new_uu; /* flag indicating if the iterate has been updated - Jacobian must be updated/reevaluated (meant to be used by user-supplied jtimes function) */ int s_maxlrst; /* maximum number of times the SPGMR linear solver can be restarted */ /* counters */ long int s_nli; /* number of linear iterations performed */ long int s_npe; /* number of preconditioner evaluations */ long int s_nps; /* number of calls to preconditioner solve fun. */ long int s_ncfl; /* number of linear convergence failures */ long int s_nfes; /* number of evaluations of the system function F(u) or number of calls made to func routine */ long int s_njtimes; /* number of times the matrix-vector product J(u)*v was computed or number of calls made to jtimes routine */ /* miscellaneous */ void *s_spils_mem; /* pointer to generic linear solver memory block */ long int s_last_flag; /* last flag returned */ /* Preconditioner computation * (a) user-provided: * - P_data == user_data * - pfree == NULL (the user dealocates memory for user_data) * (b) internal preconditioner module * - P_data == kinsol_mem * - pfree == set by the prec. module and called in KINSpilsFree */ KINSpilsPrecSetupFn s_pset; KINSpilsPrecSolveFn s_psolve; void (*s_pfree)(KINMem kin_mem); void *s_P_data; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - J_data == user_data * - jtimesDQ == FALSE * (b) internal jtimes * - J_data == kinsol_mem * - jtimesDQ == TRUE */ booleantype s_jtimesDQ; KINSpilsJacTimesVecFn s_jtimes; void *s_J_data; } *KINSpilsMem; /* * ----------------------------------------------------------------- * Prototypes of internal functions * ----------------------------------------------------------------- */ /* KINSpgmr Atimes and PSolve routines called by generic SPGMR solver */ int KINSpilsAtimes(void *kinsol_mem, N_Vector v, N_Vector z); int KINSpilsPSolve(void *kinsol_mem, N_Vector r, N_Vector z, int lr); /* difference quotient approximation for jacobian times vector */ int KINSpilsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, booleantype *new_u, void *data); /* * ----------------------------------------------------------------- * KINSPILS error messages * ----------------------------------------------------------------- */ #define MSGS_KINMEM_NULL "KINSOL memory is NULL." #define MSGS_MEM_FAIL "A memory request failed." #define MSGS_BAD_NVECTOR "A required vector operation is not implemented." #define MSGS_LMEM_NULL "Linear solver memory is NULL." #define MSGS_NEG_MAXRS "maxrs < 0 illegal." /* * ----------------------------------------------------------------- * KINSPILS info messages * ----------------------------------------------------------------- */ #define INFO_NLI "nli_inc = %d" #if defined(SUNDIALS_EXTENDED_PRECISION) #define INFO_EPS "residual norm = %12.3Lg eps = %12.3Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define INFO_EPS "residual norm = %12.3lg eps = %12.3lg" #else #define INFO_EPS "residual norm = %12.3g eps = %12.3g" #endif #ifdef __cplusplus } #endif #endif sundials-2.5.0/src/kinsol/kinsol_bbdpre.c0000600000175000017500000004046011741421272021266 0ustar sylvestresylvestre/* *----------------------------------------------------------------- * $Revision: 1.7 $ * $Date: 2010/12/01 22:43:33 $ *----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL *----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. *----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with KINSol, KINSp* * and the parallel implementation of NVECTOR. * * Note: With only one process, a banded matrix results * rather than a b-b-d matrix with banded blocks. Diagonal * blocking occurs at the process level. *----------------------------------------------------------------- */ #include #include #include #include #include #include "kinsol_impl.h" #include "kinsol_spils_impl.h" #include "kinsol_bbdpre_impl.h" #include /* *----------------------------------------------------------------- * private constants *----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes for functions KINBBDPrecSetup and KINBBDPrecSolve */ static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *p_data, N_Vector vtemp1, N_Vector vtemp2); static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *p_data, N_Vector vtemp); /* Prototype for KINBBDPrecFree */ static void KINBBDPrecFree(KINMem kin_mem); /* Prototype for difference quotient jacobian calculation routine */ static int KBBDDQJac(KBBDPrecData pdata, N_Vector uu, N_Vector uscale, N_Vector gu, N_Vector gtemp, N_Vector utemp); /* *----------------------------------------------------------------- * redability replacements *----------------------------------------------------------------- */ #define errfp (kin_mem->kin_errfp) #define uround (kin_mem->kin_uround) #define vec_tmpl (kin_mem->kin_vtemp1) /* *----------------------------------------------------------------- * user-callable functions *----------------------------------------------------------------- */ /* *----------------------------------------------------------------- * Function : KINBBDPrecInit *----------------------------------------------------------------- */ int KINBBDPrecInit(void *kinmem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_uu, KINLocalFn gloc, KINCommFn gcomm) { KBBDPrecData pdata; KINSpilsMem kinspils_mem; KINMem kin_mem; N_Vector vtemp3; long int muk, mlk, storage_mu; int flag; pdata = NULL; if (kinmem == NULL) { KINProcessError(NULL, 0, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if one of the SPILS linear solvers has been attached */ if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) kin_mem->kin_lmem; /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner. Note: do NOT need to check for N_VScale since it is required by KINSOL and so has already been checked for (see KINMalloc) */ if (vec_tmpl->ops->nvgetarraypointer == NULL) { KINProcessError(kin_mem, KINSPILS_ILL_INPUT, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_BAD_NVECTOR); return(KINSPILS_ILL_INPUT); } pdata = NULL; pdata = (KBBDPrecData) malloc(sizeof *pdata); /* allocate data memory */ if (pdata == NULL) { KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* set pointers to gloc and gcomm and load half-bandwiths */ pdata->kin_mem = kinmem; pdata->gloc = gloc; pdata->gcomm = gcomm; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); muk = MIN(Nlocal-1, MAX(0,mukeep)); mlk = MIN(Nlocal-1, MAX(0,mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* allocate memory for preconditioner matrix */ storage_mu = MIN(Nlocal-1, muk+mlk); pdata->PP = NULL; pdata->PP = NewBandMat(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* allocate memory for lpivots */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(Nlocal); if (pdata->lpivots == NULL) { DestroyMat(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINSPILS_MEM_FAIL); } /* allocate vtemp3 for use by KBBDDQJac routine */ vtemp3 = NULL; vtemp3 = N_VClone(kin_mem->kin_vtemp1); if (vtemp3 == NULL) { DestroyArray(pdata->lpivots); DestroyMat(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINSPILS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINSPILS_MEM_FAIL); } pdata->vtemp3 = vtemp3; /* set rel_uu based on input value dq_rel_uu */ if (dq_rel_uu > ZERO) pdata->rel_uu = dq_rel_uu; else pdata->rel_uu = RSqrt(uround); /* using dq_rel_uu = 0.0 means use default */ /* store Nlocal to be used by the preconditioner routines */ pdata->n_local = Nlocal; /* set work space sizes and initialize nge */ pdata->rpwsize = Nlocal * (storage_mu*mlk + 1) + 1; pdata->ipwsize = Nlocal + 1; pdata->nge = 0; /* Overwrite the P_data field in the SPILS memory */ kinspils_mem->s_P_data = pdata; /* Attach the pfree function */ kinspils_mem->s_pfree = KINBBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = KINSpilsSetPreconditioner(kinmem, KINBBDPrecSetup, KINBBDPrecSolve); return(flag); } /* *----------------------------------------------------------------- * Function : KINBBDPrecGetWorkSpace *----------------------------------------------------------------- */ int KINBBDPrecGetWorkSpace(void *kinmem, long int *lenrwBBDP, long int *leniwBBDP) { KINMem kin_mem; KINSpilsMem kinspils_mem; KBBDPrecData pdata; if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) kin_mem->kin_lmem; if (kinspils_mem->s_P_data == NULL) { KINProcessError(kin_mem, KINSPILS_PMEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(KINSPILS_PMEM_NULL); } pdata = (KBBDPrecData) kinspils_mem->s_P_data; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(KINSPILS_SUCCESS); } /* *----------------------------------------------------------------- * Function : KINBBDPrecGetNumGfnEvals *----------------------------------------------------------------- */ int KINBBDPrecGetNumGfnEvals(void *kinmem, long int *ngevalsBBDP) { KINMem kin_mem; KINSpilsMem kinspils_mem; KBBDPrecData pdata; if (kinmem == NULL) { KINProcessError(NULL, KINSPILS_MEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(KINSPILS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINSPILS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(KINSPILS_LMEM_NULL); } kinspils_mem = (KINSpilsMem) kin_mem->kin_lmem; if (kinspils_mem->s_P_data == NULL) { KINProcessError(kin_mem, KINSPILS_PMEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(KINSPILS_PMEM_NULL); } pdata = (KBBDPrecData) kinspils_mem->s_P_data; *ngevalsBBDP = pdata->nge; return(KINSPILS_SUCCESS); } /* *----------------------------------------------------------------- * preconditioner setup and solve functions *----------------------------------------------------------------- */ /* *----------------------------------------------------------------- * readability replacements *----------------------------------------------------------------- */ #define Nlocal (pdata->n_local) #define mudq (pdata->mudq) #define mldq (pdata->mldq) #define mukeep (pdata->mukeep) #define mlkeep (pdata->mlkeep) #define gloc (pdata->gloc) #define gcomm (pdata->gcomm) #define lpivots (pdata->lpivots) #define PP (pdata->PP) #define vtemp3 (pdata->vtemp3) #define nge (pdata->nge) #define rel_uu (pdata->rel_uu) /* *----------------------------------------------------------------- * Function : KINBBDPrecSetup *----------------------------------------------------------------- * KINBBDPrecSetup generates and factors a banded block of the * preconditioner matrix on each processor, via calls to the * user-supplied gloc and gcomm functions. It uses difference * quotient approximations to the Jacobian elements. * * KINBBDPrecSetup calculates a new Jacobian, stored in banded * matrix PP and does an LU factorization of P in place in PP. * * The parameters of KINBBDPrecSetup are as follows: * * uu is the current value of the dependent variable vector, * namely the solutin to func(uu)=0 * * uscale is the dependent variable scaling vector (i.e. uu) * * fval is the vector f(u) * * fscale is the function scaling vector * * bbd_data is the pointer to BBD data set by IDABBDInit. * * vtemp1, vtemp2 are pointers to memory allocated for vectors of * length N which are be used by KINBBDPrecSetup * as temporary storage or work space. A third * vector (vtemp3) required for KINBBDPrecSetup * was previously allocated as pdata->vtemp3. * * Note: The value to be returned by the KINBBDPrecSetup function * is a flag indicating whether it was successful. This value is: * 0 if successful, * > 0 for a recoverable error - step will be retried. *----------------------------------------------------------------- */ static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *bbd_data, N_Vector vtemp1, N_Vector vtemp2) { KBBDPrecData pdata; KINMem kin_mem; int retval; long int ier; pdata = (KBBDPrecData) bbd_data; kin_mem = (KINMem) pdata->kin_mem; /* call KBBDDQJac for a new jacobian and store in PP */ SetToZero(PP); retval = KBBDDQJac(pdata, uu, uscale, vtemp1, vtemp2, vtemp3); if (retval != 0) { KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } nge += (1 + MIN(mldq+mudq+1, Nlocal)); /* do LU factorization of P in place (in PP) */ ier = BandGBTRF(PP, lpivots); /* return 0 if the LU was complete, else return 1 */ if (ier > 0) return(1); else return(0); } /* *----------------------------------------------------------------- * Function : KINBBDPrecSolve *----------------------------------------------------------------- * KINBBDPrecSolve solves a linear system Pz = r, with the * banded blocked preconditioner matrix P generated and factored * by KINBBDPrecSetup. Here, r comes in as vtemp and z is * returned in vtemp as well. * * The parameters for KINBBDPrecSolve are as follows: * * uu an N_Vector giving the current iterate for the system * * uscale an N_Vector giving the diagonal entries of the * uu scaling matrix * * fval an N_Vector giving the current function value * * fscale an N_Vector giving the diagonal entries of the * function scaling matrix * * bbd_data is the pointer to BBD data set by IDABBDInit. * * vtemp an N_Vector (temporary storage), usually the scratch * vector vtemp from SPGMR/SPBCG/SPTFQMR (typical calling * routine) * * Note: The value returned by the KINBBDPrecSolve function is a * flag indicating whether it was successful. Here this value is * always 0 which indicates success. *----------------------------------------------------------------- */ static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *bbd_data, N_Vector vtemp) { KBBDPrecData pdata; realtype *vd; pdata = (KBBDPrecData) bbd_data; /* do the backsolve and return */ vd = N_VGetArrayPointer(vv); BandGBTRS(PP, lpivots, vd); return(0); } static void KINBBDPrecFree(KINMem kin_mem) { KINSpilsMem kinspils_mem; KBBDPrecData pdata; if (kin_mem->kin_lmem == NULL) return; kinspils_mem = (KINSpilsMem) kin_mem->kin_lmem; if (kinspils_mem->s_P_data == NULL) return; pdata = (KBBDPrecData) kinspils_mem->s_P_data; N_VDestroy(vtemp3); DestroyMat(PP); DestroyArray(lpivots); free(pdata); pdata = NULL; } /* *----------------------------------------------------------------- * Function : KBBDDQJac *----------------------------------------------------------------- * This routine generates a banded difference quotient * approximation to the Jacobian of f(u). It assumes that a band * matrix of type BandMat is stored column-wise, and that elements * within each column are contiguous. All matrix elements are * generated as difference quotients, by way of calls to the user * routine gloc. By virtue of the band structure, the number of * these calls is bandwidth + 1, where bandwidth = ml + mu + 1. * This routine also assumes that the local elements of a vector * are stored contiguously. *----------------------------------------------------------------- */ #define user_data (kin_mem->kin_user_data) static int KBBDDQJac(KBBDPrecData pdata, N_Vector uu, N_Vector uscale, N_Vector gu, N_Vector gtemp, N_Vector utemp) { realtype inc, inc_inv; long int group, i, j, width, ngroups, i1, i2; KINMem kin_mem; realtype *udata, *uscdata, *gudata, *gtempdata, *utempdata, *col_j; int retval; kin_mem = (KINMem) pdata->kin_mem; /* set pointers to the data for all vectors */ udata = N_VGetArrayPointer(uu); uscdata = N_VGetArrayPointer(uscale); gudata = N_VGetArrayPointer(gu); gtempdata = N_VGetArrayPointer(gtemp); utempdata = N_VGetArrayPointer(utemp); /* load utemp with uu = predicted solution vector */ N_VScale(ONE, uu, utemp); /* call gcomm and gloc to get base value of g(uu) */ if (gcomm != NULL) { retval = gcomm(Nlocal, uu, user_data); if (retval != 0) return(retval); } retval = gloc(Nlocal, uu, gu, user_data); if (retval != 0) return(retval); /* set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* loop over groups */ for (group = 1; group <= ngroups; group++) { /* increment all u_j in group */ for(j = group - 1; j < Nlocal; j += width) { inc = rel_uu * MAX(ABS(udata[j]), (ONE / uscdata[j])); utempdata[j] += inc; } /* evaluate g with incremented u */ retval = gloc(Nlocal, utemp, gtemp, user_data); if (retval != 0) return(retval); /* restore utemp, then form and load difference quotients */ for (j = group - 1; j < Nlocal; j += width) { utempdata[j] = udata[j]; col_j = BAND_COL(PP,j); inc = rel_uu * MAX(ABS(udata[j]) , (ONE / uscdata[j])); inc_inv = ONE / inc; i1 = MAX(0, (j - mukeep)); i2 = MIN((j + mlkeep), (Nlocal - 1)); for (i = i1; i <= i2; i++) BAND_COL_ELEM(col_j, i, j) = inc_inv * (gtempdata[i] - gudata[i]); } } return(0); } sundials-2.5.0/src/kinsol/README0000600000175000017500000004427211741421272017172 0ustar sylvestresylvestre KINSOL Release 2.7.0, March 2012 Aaron Collier, Alan C. Hindmarsh, and Radu Serban Center for Applied Scientific Computing, LLNL KINSOL is a solver for nonlinear algebraic systems which can be described as F(u) = 0. It is newly rewritten in the C language and based on the previous Fortran package NKSOL [4], written by Peter Brown and Youcef Saad. KINSOL can be used both on serial and parallel (MPI) computers. The difference is only in the NVECTOR module of vector functions. The desired version is obtained when compiling the example files by linking with the appropriate library of NVECTOR functions. In the parallel version, communication between processes is done via the MPI (Message Passage Interface) system. When used with the serial NVECTOR module, KINSOL provides both direct (dense and band) and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When used with the parallel NVECTOR module, KINSOL provides a preconditioner module called KINBBDPRE, which provides a band-block-diagonal preconditioner for use with the Krylov linear solvers. However, within KINSOL any NVECTOR module may be combined with an appropriate user-supplied preconditioning module for acceleration of the Krylov solvers. KINSOL is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers. This suite consists of CVODE, KINSOL, and IDA, and variants of these. The directory structure of the package supplied reflects this family relationship. For use with Fortran applications, a set of Fortran/C interface routines, called FKINSOL, is also supplied. These are written in C, but assume that the user calling program and all user-supplied routines are in Fortran. The notes below provide the location of documentation, directions for the installation of the KINSOL package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/kinsol/ contains PDF files for the KINSOL User Guide [1] (kin_guide.pdf) and the KINSOL Examples [2] (kin_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_NOTES. For complete installation instructions see the "KINSOL Installation Procedure" chapter in the KINSOL User Guide [1]. C. References ------------- [1] A. M. Collier, A. C. Hindmarsh, R. Serban, and C. S. Woodward, "User Documentation for KINSOL v2.7.0," LLNL technical report UCRL-SM-208116, December 2011. [2] A. M. Collier and R. Serban, "Example Programs for KINSOL v2.7.0," LLNL technical report UCRL-SM-208114, December 2011. [3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. [4] Peter N. Brown and Youcef Saad, "Hybrid Krylov Methods for Nonlinear Systems of Equations," SIAM J. Sci. Stat. Comput., Vol 11, no 3, pp. 450-481, May 1990. [5] A. G. Taylor and A. C. Hindmarsh, "User Documentation for KINSOL, A Nonlinear Solver for Sequential and Parallel Computers," LLNL technical report UCRL-ID-131185, July 1998. D. Releases ----------- v. 2.7.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - Apr. 2005 v. 2.2.2 - Mar. 2005 v. 2.2.1 - Jan. 2005 v. 2.2.0 - Dec. 2004 v. 2.0 - Jul. 2002 (first SUNDIALS release) v. 1.0 - Aug. 1998 (date written) E. Revision History ------------------- v. 2.6.0 (May 2009) ---> v. 2.7.0 (Mar. 2012) --------------------------------------------- - Bug fixes - Three major logic bugs were fixed -- involving updating the solution vector, updating the linesearch parameter, and a missing error return. - Three minor errors were fixed -- involving setting etachoice in the Matlab/KINSOL interface, a missing error case in KINPrintInfo, and avoiding an exponential overflow in the evaluation of omega. - In each linear solver interface function, the linear solver memory is freed on an error return, and the **Free function now includes a line setting to NULL the main memory pointer to the linear solver memory. - Changes to user interface - One significant design change was made with this release: The problem size and its relatives, bandwidth parameters, related internal indices, pivot arrays, and the optional output lsflag, have all been changed from type int to type long int, except for the problem size and bandwidths in user calls to routines specifying BLAS/LAPACK routines for the dense/band linear solvers. The function NewIntArray is replaced by a pair NewIntArray/NewLintArray, for int and long int arrays, respectively. - in the installation files, we modified the treatment of the macro SUNDIALS_USE_GENERIC_MATH, so that the parameter GENERIC_MATH_LIB is either defined (with no value) or not defined. v. 2.5.0 (Nov. 2006) ---> v. 2.6.0 (May 2009) --------------------------------------------- - New features - added a new linear solver module based on Blas + Lapack for both dense and banded matrices. - Bug fixes - added logic to ensure omega is updated every iteration. - fixed difference-quotient Jacobian memory reset bug. - Changes to user interface - renamed all **Malloc functions to **Init - all user-supplied functions now receive the same pointer to user data (instead of having different ones for the system evaluation, Jacobian information functions, etc. - common functionality for all direct linear solvers (dense, band, and the new Lapack solver) has been collected into the DLS (Direct Linear Solver) module, similar to the SPILS module for the iterative linear solvers. All optional input and output functions for these linear solver now have the prefix 'KINDls'. In addition, in order to include the new Lapack-based linear solver, all dimensions for these linear solvers (problem sizes, bandwidths, etc) are now of type 'int' (instead of 'long int'). - the initialization function for the preconditioner module KINBBDPRE was renamed KINBBDInit (from KINBBDAlloc) and it does not return a pointer to preconditioner memory anymore. Instead, all preconditioner module-related functions are now called with the main solver memory pointer as their first argument. When using the KINBBDPRE module, there is no need to use special functions to attach one of the SPILS linear solvers (instead use one of KINSpgmr, KINSpbcg, or KINSptfqmr). Moreover, there is no need to call a memory deallocation function for the preconditioner module. - changes corresponding to the above were made to the FCMIX interface. v. 2.4.0 (Mar. 2006) ---> v. 2.5.0 (Oct. 2006) ---------------------------------------------- - Changes related to the build system - reorganized source tree: header files in ${srcdir}/include/kinsol, source files in ${srcdir}/src/kinsol, fcmix source files in ${srcdir}/src/kinsol/fcmix, examples in ${srcdir}/examples/kinsol - exported header files are installed unde ${includedir}/kinsol - Changes to user interface - all included header files use relative paths from ${includedir} v. 2.3.0 (Apr. 2005) ---> v. 2.4.0 (Mar. 2006) ---------------------------------------------- - New features - added direct linear solvers (dense and band, provided through the KINDENSE and KINBAND modules, respectively) thus adding modified (and exact) Newton methods to KINSOL. - added KINSPBCG interface module to allow KINSOL to interface with the shared SPBCG (scaled preconditioned Bi-CGSTAB) linear solver module. - added KINSPTFQMR interface module to allow KINSOL to interface with the shared SPTFQMR (scaled preconditioned TFQMR) linear solver module - added support for SPBCG and SPTFQMR to the KINBBDPRE preconditioner module. - added option to KINBBDPRE preconditioner module to allow specification of different half-bandwidths for difference quotient approximation and retained matrix. - added support for interpreting failures in user-supplied functions. - Bug fixes - corrected a bug in the preconditioner logic that caused the initial call to the preconditioner setup routine (controlled by KINSetNoInitSetup) to be skipped during subsequent calls to KINSol - Changes to underlying algorithms - modified the KINBBDPRE preconditioner module to allow the use of different half-bandwidths for the difference quotient approximation and the retained matrix. - added nonlinear residual monitoring scheme to control Jacobian updating when a direct linear solver is used (modified Newton iteration) - Changes to user interface - changed argument of KINFree and KINBBDPrecFree to be the address of the respective memory block pointer, so that its NULL value is propagated back to the calling function. - modified the argument list of KINBBDPrecAlloc to allow specification of the upper and lower half-bandwidths to be used in the computation of the local Jacobian blocks (mudq, mldq), and the half-bandwidths of the retained banded approximation to the local Jacobian block (mukeep, mlkeep). - added KINSPBCG module which defines appropriate KINSpbcg* functions to allow KINSOL to interface with the shared SPBCG linear solver module. - added KINBBDSpbcg function to KINBBDPRE module to support SPBCG linear solver module. - changed function type names (not the actual definitions) to accomodate all the Scaled Preconditioned Iterative Linear Solvers now available: KINSpgmrJactimesVecFn -> KINSpilsJacTimesVecFn KINSpgmrPrecSetupFn -> KINSpilsPrecSetupFn KINSpgmrPrecSolveFn -> KINSpilsPrecSolveFn - changed function types so that all user-supplied functions return an integer flag (not all of them currently used). - changed some names for KINBBDPRE function outputs - added option for user-supplied error handler function. - added option for user-supplied info handler function. - renamed all exported header files (except for kinsol.h, all header files have the prefix 'kinsol_') - changed naming scheme for KINSOL examples - Changes to the FKINSOL module - modified argument list of FKINBBDINIT to accomadate changes made to KINBBDPRE module, so now user must specify the upper and lower half-bandwidths for the difference quotient approximation (mudq, mldq) and the retained matrix (mukeep, mlkeep). - added support for KINSPBCG/SPBCG (added FKIN*SPBCG* functions). - added support for KINSPTFQMR/SPTFQMR (added FKIN*SPTFQMR* functions). - added support for KINDENSE/DENSE (added FKIN*DENSE* functions). - added support for KINBAND/BAND (added FKIN*DENSE* functions). - Optional inputs are now set using routines FKINSETIIN (integer inputs), FKINSETRIN (real inputs), and FKINSETVIN (vector inputs) through pairs key-value. Optional outputs are still obtained from two arrays (IOUT and ROUT), owned by the user and passed as arguments to FKINMALLOC. - Changes related to the build system - updated configure script and Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link only if necessary) - the main KINSOL header file (kinsol.h) is still exported to the install include directory. However, all other KINSOL header files are exported into an 'kinsol' subdirectory of the install include directory. - the KINSOL library now contains all shared object files (there is no separate libsundials_shared library anymore) v. 2.2.2 (Mar. 2005) ---> v. 2.3.0 (Apr. 2005) ---------------------------------------------- - Changes to user interface - KINSOL now stores an actual copy of the constraints vector rather than just a pointer in order to resolve potential scoping issues - several optional input functions were combined into a single function: - KINSpgmrSetPrecSetupFn, KINSpgmrSetPrecSolveFn and KINSpgmrSetPrecData were combined into KINSpgmrSetPreconditioner - KINSpgmrSetJacTimesVecFn and KINSpgmrSetJacData were combined into KINSpgmrSetJacTimesVecFn - Changes to FKINSOL module: - FKINSPGMRSETPSET and FKINSPGMRSETPSOL were combined into FKINSPGMRSETPREC - due to changes to the main solver, if FKPSOL is provided, then FKPSET must also be defined, even if it is empty v. 2.2.1 (Jan. 2005) ---> v. 2.2.2 (Mar. 2005) ---------------------------------------------- - Bug fixes - fixed bug in computation of the scaled step length - fixed bug in logic for disabling the call to the preconditioner setup function at the first iteration - modified FCMIX files to avoid C++ compiler errors - changed implicit type conversion to explicit in check_flag() routine in examples to avoid C++ compiler errors - Changes to documentation - added section with numerical values of all input and output solver constants - added description of --with-mpi-flags option - Changes related to the build system - fixed autoconf-related bug to allow configuration with the PGI Fortran compiler - modified to use customized detection of the Fortran name mangling scheme (autoconf's AC_F77_WRAPPERS routine is problematic on some platforms) - added --with-mpi-flags as a configure option to allow user to specify MPI-specific flags - updated Makefiles for Fortran examples to avoid C++ compiler errors (now use CC and MPICC to link) v. 2.2.0 (Dec. 2004) ---> v. 2.2.1 (Jan. 2005) ---------------------------------------------- - Changes related to the build system - changed order of compiler directives in header files to avoid compilation errors when using a C++ compiler. v. 2.0 (Jul. 2002) ---> v. 2.2.0 (Dec. 2004) -------------------------------------------- - New feature - added option to disable all error messages. - Bug fixes - fixed constraints-related bug. - fixed bug in implementation of line-search method related to beta-condition. - corrected value of ealpha variable (related to forcing term). - Changes related to NVECTOR module (see also the file sundials/shared/README) - removed machEnv, redefined table of vector operations (now contained in the N_Vector structure itself). - all KINSOL functions create new N_Vector variables through cloning, using an N_Vector passed by the user as a template. - Changes to type names and KINSOL constants - removed type 'integertype'; instead use 'int' or 'long int', as appropriate. - restructured the list of return values from the various KINSOL functions. - changed all KINSOL constants (inputs and return values) to have the prefix 'KIN_' (e.g. KIN_SUCCESS). - renamed function type 'SysFn' to 'KINSysFn'. - Changes to underlying algorithms - modified line-search backtracking scheme to use cubic interpolation after the first backtrack, if possible. - changed implementation of constraints: if constraints[i] = 0 u[i] NOT constrained +1 u[i] >= 0 -1 u[i] <= 0 +2 u[i] > 0 -2 u[i] < 0 where u is the solution vector (see the KINSOL User Guide [1] for additional details). - Changes to optional input/output - added KINSet* and KINGet* functions for optional inputs/outputs, replacing the arrays iopt and ropt. - added new optional inputs (e.g. maximum number of nonlinear iterations between calls to preconditioner setup routine, etc.). - the value of the last return flag from any function within the SPGMR linear solver module can be obtained as an optional output using KINSpgmrGetLastFlag. - Changes to user-callable functions - added new function KINCreate which initializes the KINSOL solver object and returns a pointer to the KINSOL memory block. - removed N (problem size) from all functions. - shortened argument lists of most KINSOL functions (the arguments that were dropped can now be specified through KINSet* functions). - removed reinitialization functions for SPGMR linear solver (same functionality can be obtained using KINSpgmrSet* functions). - Changes to user-supplied functions - removed N (problem dimension) from argument lists. - in KINSPGMR, shortened argument lists for user preconditioner functions. - Changes to the FKINSOL module - revised to use underscore and precision flags at compile time (from configure); example sources are preprocessed accordingly. - use KIN*Set* and KIN*Get* functions from KINSOL (although the optional I/O is still communicated to the user of FKINSOL through arrays IOPT and ROPT). - added new optional inputs and outputs (e.g. last return flag from the linear solver, etc.). v. 1.0 (Aug. 1998) ---> v. 2.0 (Jul. 2002) ------------------------------------------ YYYYMMDD 19980802 DATE WRITTEN - KINSOL released. 19981203 Implemented serial Fortran/C interface (fkinsols.c). 19990301 Fixed bug in nbktrk. 19990325 Removed machEnv as an argument to KINSol. 19991229 Fixed preconditioner evaluation logic; revised SPGMR module to treat scalings correctly. 20000324 Upgraded serial and parallel versions of NVECTOR module. 20000706 Fixed bug in use of vtemp1 in KINSpgmrSolve call to KINAtimes etc. 20000808 Fixed bug in N_VMin routine. 20010118 Minor corrections, notably: In fkinsol.h, KINUAtimes prototype fixed. In fkinsols.c and fkinsolp.c, N_Vector's disposed with N_VDISPOSE after KINSol call. In all fkin*.c, #include lines for header files corrected. 20011212 Corrected 4 N_VDISPOSE arguments in FKINSOL. 20011212 Added missing error flag print in KINSol, and changed 5 return values in KINStop to enum-defined expressions. 20011220 Default type 'integer' changed to 'long int' in llnltyps.h. 20011221 In FKINSOL, corrected type (integer) for Neq in KINPreco, KINPSol. 20020313 Modified to work with new NVECTOR abstraction. 20020627 Modified to reflect type name changes. sundials-2.5.0/bin/0000755000175000017500000000000011767174700015004 5ustar sylvestresylvestresundials-2.5.0/bin/fortran-update.in0000600000175000017500000004221011741421110020234 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.1 $ # $Date: 2007/01/30 15:23:24 $ # ----------------------------------------------------------------- # Programmer(s): Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # This script updates Fortran source code according to the level # of precision specified using the --with-precision option. It also # updates variable type specifiers according to the sizes of the # C types 'long int' and 'int' and the SUNDIALS-specific type # 'realtype'. # ----------------------------------------------------------------- # Notes: # # (1) The environment variable F77_KEYWORD_LIST should contain # a list of all intrinsic functions/procedures used in the # Fortran examples (defined under 'update' target). # # (2) F77_MPI_REAL_* is set to MPI_REAL#, where # is the number # of bytes in realtype (SUNDIALS-specific data type). However, # if MPI_REAL# is NOT defined in the header file 'mpif.h', # then MPI_REAL is used instead. Also, if the file 'mpif.h' # does NOT exist under the directory MPI_INC_DIR, then # MPI_REAL# is still used, but there is NO guarantee that # it is actually defined. Of course, the problem can easily # be avoided by adding -I to FFLAGS or # --with-fflags. # ----------------------------------------------------------------- SAVED_LC_ALL="${LC_ALL}" LC_ALL="C" abs_top_builddir="@abs_top_builddir@" prefix="@prefix@" includedir="@includedir@" FLOAT_TYPE="@FLOAT_TYPE@" MPI_INC_DIR="@MPI_INC_DIR@" EGREP="@EGREP@" FGREP="@FGREP@" MPI_COMM_F2C="@F77_MPI_COMM_F2C@" TEMP_A=`echo "${MPI_COMM_F2C}" | ${FGREP} "#define SUNDIALS_MPI_COMM_F2C 1"` if test "X${TEMP_A}" = "X"; then USE_MPI_COMM_F2C_EXT="no" else USE_MPI_COMM_F2C_EXT="yes" fi INSTALL="@INSTALL@" TEMP_INSTALL=`echo "${INSTALL}" | cut -d' ' -f1` if test -f ${TEMP_INSTALL} ; then : else INSTALL="${abs_top_builddir}/config/${INSTALL}" fi CP_FILE="@INSTALL_DATA@" srcdir="${1}" SOURCE_FILE="${2}" builddir="." F77_KEYWORD_LIST="FLOAT/DBLE/QFLOAT,float/dble/qfloat SIN/DSIN/QSIN,sin/dsin/qsin" F77_KEYWORD_LIST="${F77_KEYWORD_LIST} EXP/DEXP/QEXP,exp/dexp/qexp" F77_KEYWORD_LIST="${F77_KEYWORD_LIST} ABS/DABS/QABS,abs/dabs/qabs" F77_KEYWORD_LIST="${F77_KEYWORD_LIST} AMAX1/DMAX1/QMAX1,amax1/dmax1/qmax1" TEMP_A=`${FGREP} "#define SIZEOF_INT 4" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_INT 8" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then INT_BYTES="4" else INT_BYTES="8" fi else INT_BYTES="4" fi F77_INT_UPPER="INTEGER\*${INT_BYTES}" F77_INT_LOWER="integer\*${INT_BYTES}" TEMP_A=`${FGREP} "#define SIZEOF_LONG_INT 4" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_LONG_INT 8" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then LONG_INT_BYTES="4" else LONG_INT_BYTES="8" fi else LONG_INT_BYTES="4" fi F77_LONG_INT_UPPER="INTEGER\*${LONG_INT_BYTES}" F77_LONG_INT_LOWER="integer\*${LONG_INT_BYTES}" if test "X${FLOAT_TYPE}" = "Xsingle"; then TEMP_A=`${FGREP} "#define SIZEOF_FLOAT 4" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_FLOAT 8" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_FLOAT 16" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then FLOAT_BYTES="" else FLOAT_BYTES="16" fi else FLOAT_BYTES="8" fi else FLOAT_BYTES="4" fi elif test "X${FLOAT_TYPE}" = "Xdouble"; then TEMP_A=`${FGREP} "#define SIZEOF_DOUBLE 4" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_DOUBLE 8" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_DOUBLE 16" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then FLOAT_BYTES="" else FLOAT_BYTES="16" fi else FLOAT_BYTES="8" fi else FLOAT_BYTES="4" fi elif test "X${FLOAT_TYPE}" = "Xextended"; then TEMP_A=`${FGREP} "#define SIZEOF_LONG_DOUBLE 4" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_LONG_DOUBLE 8" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "#define SIZEOF_LONG_DOUBLE 16" ${abs_top_builddir}/config.h` if test "X${TEMP_A}" = "X"; then FLOAT_BYTES="" else FLOAT_BYTES="16" fi else FLOAT_BYTES="8" fi else FLOAT_BYTES="4" fi fi if test "X${FLOAT_BYTES}" = "X" || test "X${FLOAT_TYPE}" = "Xdouble"; then F77_FLOAT_UPPER="" F77_FLOAT_LOWER="" elif test "X${FLOAT_TYPE}" = "Xsingle" || test "X${FLOAT_TYPE}" = "Xextended"; then F77_FLOAT_UPPER="REAL\*${FLOAT_BYTES}" F77_FLOAT_LOWER="real\*${FLOAT_BYTES}" fi if test "X${FLOAT_TYPE}" = "Xsingle"; then C_FLOAT_TYPE="float" elif test "X${FLOAT_TYPE}" = "Xdouble"; then C_FLOAT_TYPE="double" elif test "X${FLOAT_TYPE}" = "Xextended"; then C_FLOAT_TYPE="long double" fi TEMP_A=`echo "${srcdir}" | ${FGREP} "examples_par"` if test "X${TEMP_A}" = "X"; then : else if test -f ${MPI_INC_DIR}/mpif.h ; then TEMP_A=`${FGREP} "MPI_REAL${FLOAT_BYTES}" ${MPI_INC_DIR}/mpif.h` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "mpi_real${FLOAT_BYTES}" ${MPI_INC_DIR}/mpif.h` fi if test "X${TEMP_A}" = "X"; then F77_MPI_REAL_UPPER="MPI_REAL" F77_MPI_REAL_LOWER="mpi_real" else F77_MPI_REAL_UPPER="MPI_REAL${FLOAT_BYTES}" F77_MPI_REAL_LOWER="mpi_real${FLOAT_BYTES}" fi else echo "" echo "WARNING: using MPI_REAL${FLOAT_BYTES} since unable to find mpif.h" echo "" F77_MPI_REAL_UPPER="MPI_REAL${FLOAT_BYTES}" F77_MPI_REAL_LOWER="mpi_real${FLOAT_BYTES}" fi fi if test "X${FLOAT_BYTES}" = "X"; then echo "" echo "WARNING: ${C_FLOAT_TYPE} floating-point data type has NO Fortran equivalent" echo "" fi if test -f ${srcdir}/${SOURCE_FILE} ; then echo "Updating ${SOURCE_FILE}..." ${CP_FILE} ${srcdir}/${SOURCE_FILE} ${builddir}/temp1.f TEMP_A=`${FGREP} "INTEGER*4" ${builddir}/temp1.f` TEMP_B=`${FGREP} "integer*4" ${builddir}/temp1.f` TEMP_A="${TEMP_A} ${TEMP_B}" for j in ${TEMP_A} ; do TEMP_B=`echo "${j}" | ${FGREP} "INTEGER*4"` F77_CASE="upper" if test "X${TEMP_B}" = "X"; then TEMP_B=`echo "${j}" | ${FGREP} "integer*4"` F77_CASE="lower" fi if test "X${TEMP_B}" = "X"; then : else TEMP1=`echo "${j}" | cut -d'*' -f1` TEMP2=`echo "${j}" | cut -d'*' -f2` j="${TEMP1}\*${TEMP2}" if test "X${F77_CASE}" = "Xupper"; then sed "s,${j},${F77_LONG_INT_UPPER}," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,${j},${F77_LONG_INT_LOWER}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done TEMP_A=`${FGREP} "INTEGER " ${builddir}/temp1.f` TEMP_B=`${FGREP} "integer " ${builddir}/temp1.f` TEMP_A="${TEMP_A} ${TEMP_B}" for j in ${TEMP_A} ; do TEMP_B=`echo "${j}" | ${FGREP} "INTEGER"` F77_CASE="upper" if test "X${TEMP_B}" = "X"; then TEMP_B=`echo "${j}" | ${FGREP} "integer"` F77_CASE="lower" fi if test "X${TEMP_B}" = "X"; then : else if test "X${F77_CASE}" = "Xupper"; then sed "s,${j} ,${F77_INT_UPPER} ," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,${j} ,${F77_INT_LOWER} ," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done if test "X${FLOAT_TYPE}" = "Xdouble" || test "X${FLOAT_BYTES}" = "X"; then : elif test "X${FLOAT_TYPE}" = "Xsingle"; then CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_A=`${FGREP} "DOUBLE PRECISION" ${builddir}/temp1.f` F77_CASE="upper" if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "double precision" ${builddir}/temp1.f` F77_CASE="lower" fi if test "X${TEMP_A}" = "X"; then CONTINUE="no" else if test "X${F77_CASE}" = "Xupper"; then sed "s,DOUBLE PRECISION,${F77_FLOAT_UPPER}," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,double precision,${F77_FLOAT_LOWER}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_A=`${FGREP} "MPI_DOUBLE_PRECISION" ${builddir}/temp1.f` F77_CASE="upper" if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "mpi_double_precision" ${builddir}/temp1.f` F77_CASE="lower" fi if test "X${TEMP_A}" = "X"; then CONTINUE="no" else if test "X${F77_CASE}" = "Xupper"; then sed "s,MPI_DOUBLE_PRECISION,${F77_MPI_REAL_UPPER}," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,mpi_double_precision,${F77_MPI_REAL_LOWER}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done TEMP_A=`${EGREP} "[/]?[[:digit:]]+[.]{1}[[:digit:]]*[dD]{1}[+-]?[[:digit:]]+[/]?" ${builddir}/temp1.f` CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_B=`echo "${TEMP_A}" | ${FGREP} ","` if test "X${TEMP_B}" = "X"; then CONTINUE="no" else TEMP_A=`echo "${TEMP_A}" | sed "s,\,, ,"` fi done CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_B=`echo "${TEMP_A}" | ${FGREP} "("` if test "X${TEMP_B}" = "X"; then CONTINUE="no" else TEMP_A=`echo "${TEMP_A}" | sed "s,(, ,"` fi done for j in ${TEMP_A} ; do TEMP_B=`echo "${j}" | ${EGREP} "[/]?[[:digit:]]+[.]{1}[[:digit:]]*[dD]{1}[+-]?[[:digit:]]+[/]?"` if test "X${TEMP_B}" = "X"; then : else TEMP_B=`echo "${j}" | ${FGREP} "/"` if test "X${TEMP_B}" = "X"; then TEMP_B=`echo "${j}" | sed "s,D,E,"` TEMP_B=`echo "${TEMP_B}" | sed "s,d,e,"` sed "s,${j},${TEMP_B}," ${builddir}/temp1.f > ${builddir}/temp2.f else TEMP_B=`echo "${j}" | cut -d'/' -f2` TEMP_C=`echo "${TEMP_B}" | sed "s,D,E,"` TEMP_C=`echo "${TEMP_C}" | sed "s,d,e,"` TEMP_C=`echo "${j}" | sed "s,${TEMP_B},${TEMP_C},"` sed "s,${j},${TEMP_C}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done for k in ${F77_KEYWORD_LIST} ; do F77_LIST_UPPER=`echo "${k}" | cut -d',' -f1` F77_LIST_LOWER=`echo "${k}" | cut -d',' -f2` DEFAULT_KEYWORD_UPPER=`echo "${F77_LIST_UPPER}" | cut -d'/' -f2` DEFAULT_KEYWORD_LOWER=`echo "${F77_LIST_LOWER}" | cut -d'/' -f2` TEMP_A=`${FGREP} "${DEFAULT_KEYWORD_UPPER}(" ${builddir}/temp1.f` TEMP_B=`${FGREP} "${DEFAULT_KEYWORD_LOWER}(" ${builddir}/temp1.f` TEMP_A="${TEMP_A} ${TEMP_B}" CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_B=`echo "${TEMP_A}" | ${FGREP} ","` if test "X${TEMP_B}" = "X"; then CONTINUE="no" else TEMP_A=`echo "${TEMP_A}" | sed "s,\,, ,"` fi done for j in ${TEMP_A} ; do TEMP_B=`echo "${j}" | ${FGREP} "${DEFAULT_KEYWORD_UPPER}("` F77_CASE="upper" if test "X${TEMP_B}" = "X"; then TEMP_B=`echo "${j}" | ${FGREP} "${DEFAULT_KEYWORD_LOWER}("` F77_CASE="lower" fi if test "X${TEMP_B}" = "X"; then : else if test "X${F77_CASE}" = "Xupper"; then TEMP_C=`echo "${F77_LIST_UPPER}" | cut -d'/' -f1` TEMP_B=`echo "${j}" | sed "s,${DEFAULT_KEYWORD_UPPER}(,${TEMP_C}(,"` else TEMP_C=`echo "${F77_LIST_LOWER}" | cut -d'/' -f1` TEMP_B=`echo "${j}" | sed "s,${DEFAULT_KEYWORD_LOWER}(,${TEMP_C}(,"` fi sed "s,${j},${TEMP_B}," ${builddir}/temp1.f > ${builddir}/temp2.f ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done done elif test "X${FLOAT_TYPE}" = "Xextended"; then CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_A=`${FGREP} "DOUBLE PRECISION" ${builddir}/temp1.f` F77_CASE="upper" if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "double precision" ${builddir}/temp1.f` F77_CASE="lower" fi if test "X${TEMP_A}" = "X"; then CONTINUE="no" else if test "X${F77_CASE}" = "Xupper"; then sed "s,DOUBLE PRECISION,${F77_FLOAT_UPPER}," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,double precision,${F77_FLOAT_LOWER}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_A=`${FGREP} "MPI_DOUBLE_PRECISION" ${builddir}/temp1.f` F77_CASE="upper" if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "mpi_double_precision" ${builddir}/temp1.f` F77_CASE="lower" fi if test "X${TEMP_A}" = "X"; then CONTINUE="no" else if test "X${F77_CASE}" = "Xupper"; then sed "s,MPI_DOUBLE_PRECISION,${F77_MPI_REAL_UPPER}," ${builddir}/temp1.f > ${builddir}/temp2.f else sed "s,mpi_double_precision,${F77_MPI_REAL_LOWER}," ${builddir}/temp1.f > ${builddir}/temp2.f fi ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done if test "X${FLOAT_BYTES}" = "X16"; then for k in ${F77_KEYWORD_LIST} ; do F77_LIST_UPPER=`echo "${k}" | cut -d',' -f1` F77_LIST_LOWER=`echo "${k}" | cut -d',' -f2` DEFAULT_KEYWORD_UPPER=`echo "${F77_LIST_UPPER}" | cut -d'/' -f2` DEFAULT_KEYWORD_LOWER=`echo "${F77_LIST_LOWER}" | cut -d'/' -f2` TEMP_A=`${FGREP} "${DEFAULT_KEYWORD_UPPER}(" ${builddir}/temp1.f` TEMP_B=`${FGREP} "${DEFAULT_KEYWORD_LOWER}(" ${builddir}/temp1.f` TEMP_A="${TEMP_A} ${TEMP_B}" CONTINUE="yes" while test "X${CONTINUE}" = "Xyes" ; do TEMP_B=`echo "${TEMP_A}" | ${FGREP} ","` if test "X${TEMP_B}" = "X"; then CONTINUE="no" else TEMP_A=`echo "${TEMP_A}" | sed "s,\,, ,"` fi done for j in ${TEMP_A} ; do TEMP_B=`echo "${j}" | ${FGREP} "${DEFAULT_KEYWORD_UPPER}("` F77_CASE="upper" if test "X${TEMP_B}" = "X"; then TEMP_B=`echo "${j}" | ${FGREP} "${DEFAULT_KEYWORD_LOWER}("` F77_CASE="lower" fi if test "X${TEMP_B}" = "X"; then : else if test "X${F77_CASE}" = "Xupper"; then TEMP_C=`echo "${F77_LIST_UPPER}" | cut -d'/' -f3` TEMP_B=`echo "${j}" | sed "s,${DEFAULT_KEYWORD_UPPER}(,${TEMP_C}(,"` else TEMP_C=`echo "${F77_LIST_LOWER}" | cut -d'/' -f3` TEMP_B=`echo "${j}" | sed "s,${DEFAULT_KEYWORD_LOWER}(,${TEMP_C}(,"` fi sed "s,${j},${TEMP_B}," ${builddir}/temp1.f > ${builddir}/temp2.f ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi done done fi fi F77_MPI_KEYWORD_LIST="FNVINITP,fnvinitp FNVINITPQ,fnvinitpq FNVINITPS,fnvinitps" F77_MPI_KEYWORD_LIST="${F77_MPI_KEYWORD_LIST} FNVINITPB,fnvinitpb FNVINITPQB,fnvinitpqb" if test "X${USE_MPI_COMM_F2C_EXT}" = "Xno"; then F77_MPI_KEYWORD="" for z in ${F77_MPI_KEYWORD_LIST} ; do F77_MPI_A=`echo "${z}" | cut -d',' -f1` F77_MPI_B=`echo "${z}" | cut -d',' -f2` TEMP_A=`${FGREP} "${F77_MPI_A}(" ${builddir}/temp1.f` if test "X${TEMP_A}" = "X"; then TEMP_A=`${FGREP} "${F77_MPI_B}(" ${builddir}/temp1.f` if test "X${TEMP_A}" = "X"; then F77_SKIP_MPI_UPDATE="yes" else F77_MPI_KEYWORD="${F77_MPI_B}" F77_MPI_CASE="lower" F77_SKIP_MPI_UPDATE="no" fi else F77_MPI_KEYWORD="${F77_MPI_A}" F77_MPI_CASE="upper" F77_SKIP_MPI_UPDATE="no" fi if test "X${F77_SKIP_MPI_UPDATE}" = "Xno"; then break fi done if test "X${F77_SKIP_MPI_UPDATE}" = "Xno"; then if test "X${F77_MPI_CASE}" = "Xupper"; then sed "s,${F77_MPI_KEYWORD}(MPI\_COMM\_WORLD\, ,${F77_MPI_KEYWORD}(0\, ," ${builddir}/temp1.f > ${builddir}/temp2.f ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f else sed "s,${F77_MPI_KEYWORD}(mpi\_comm\_world\, ,${F77_MPI_KEYWORD}(0\, ," ${builddir}/temp1.f > ${builddir}/temp2.f ${CP_FILE} ${builddir}/temp2.f ${builddir}/temp1.f fi fi fi SOURCE_FILE=`echo "${SOURCE_FILE}" | cut -d'.' -f1` SOURCE_FILE="${SOURCE_FILE}-updated.f" ${CP_FILE} ${builddir}/temp1.f ${builddir}/${SOURCE_FILE} rm -f ${builddir}/temp1.f ${builddir}/temp2.f fi LC_ALL="${SAVED_LC_ALL}" sundials-2.5.0/bin/sundials-config.in0000600000175000017500000000660511741421110020376 0ustar sylvestresylvestre#! @SHELL@ # ----------------------------------------------------------------------------------- NAME_="sundials-config" PURPOSE_="returns required flags for linking to SUNDIALS libraries" SYNOPSIS_="$NAME_ -m cvode|cvodes|ida|idas|kinsol -t s|p -l c|f [-s libs|cppflags -hv]" REQUIRES_="standard GNU commands" VERSION_="0.1" DATE_="2006-07-25" AUTHOR_="Radu Serban " # ----------------------------------------------------------------------------------- usage () { echo >&2 "$NAME_ $VERSION_ - $PURPOSE_ Usage: $SYNOPSIS_ Requires: $REQUIRES_ Options: -m cvode|cvodes|ida|idas|kinsol SUNDIALS module -t s|p use serial or parallel vectors -l c|f use C or Fortran -s libs|cppflags show linking flags or C preprocessor flags. (show both if option not given.) -h usage and options (this help) -v view this script Notes: '-l f' is not valid for '-m cvodes' or '-m idas' '-s cppflags' returns an empty string for '-l f'" exit 1 } # args check [ $# -eq 0 ] && { echo >&2 missing argument, type $NAME_ -h for help; exit 1; } # process args while getopts hvm:t:l:s: options do case $options in m) module=$OPTARG ;; t) vector=$OPTARG ;; l) lang=$OPTARG ;; s) show=$OPTARG ;; h) usage ;; v) more $0; exit 1 ;; \?) echo invalid argument, type $NAME_ -h for help; exit 1 ;; esac done shift $(( $OPTIND - 1 )) # args check [[ $module ]] || { echo >&2 the -m option and argument must be specified; exit 1; } [[ $vector ]] || { echo >&2 the -t option and argument must be specified; exit 1; } [[ $lang ]] || { echo >&2 the -l option and argument must be specified; exit 1; } [[ $show ]] || { show=both; } # main prefix=@prefix@; exec_prefix=@exec_prefix@; includedir=@includedir@; libdir=@libdir@; abs_includedir=`cd "${includedir}" > /dev/null 2>&1 && pwd`; abs_libdir=`cd "${libdir}" > /dev/null 2>&1 && pwd`; if test $abs_includedir != /usr/include ; then includes=-I$abs_includedir fi libdirs=-L$abs_libdir case $module in cvode) sun_lib="-lsundials_cvode"; sun_flib="-lsundials_fcvode"; ;; cvodes) sun_lib="-lsundials_cvodes"; sun_flib=; ;; ida) sun_lib="-lsundials_ida"; sun_flib="-lsundials_fida"; ;; idas) sun_lib="-lsundials_idas"; sun_flib=; ;; kinsol) sun_lib="-lsundials_kinsol"; sun_flib="-lsundials_fkinsol"; ;; esac case $vector in s) nvec_lib="-lsundials_nvecserial"; nvec_flib="-lsundials_fnvecserial"; ;; p) nvec_lib="-lsundials_nvecparallel"; nvec_flib="-lsundials_fnvecparallel"; ;; esac case $lang in c) cppflags=$includes; libs="$libdirs $sun_lib $nvec_lib @LIBS@"; ;; f) cppflags=; if test $module = cvodes ; then libs="Fortran interface not available for CVODES"; else libs="$libdirs $sun_flib $sun_lib $nvec_flib $nvec_lib @LIBS@ @FLIBS@"; fi ;; esac case $show in cppflags) echo $cppflags ;; libs) echo $libs ;; both) echo $cppflags echo $libs ;; esac # end script sundials-2.5.0/bin/makefile-update.in0000600000175000017500000000224511741421110020342 0ustar sylvestresylvestre#! @SHELL@ # ----------------------------------------------------------------------------------- # $Revision: 1.2 $ # $Date: 2007/12/19 20:33:59 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # This script updates example Makefiles before export. # It is called by the configure script, after an initial export # Makefile_ex has been created by config.status. # ----------------------------------------------------------------- infile="${1}" solver="${2}" examples="${3}" examples_bl="${4}" solver_lib="${5}" solver_flib="${6}" sed "s/@SOLVER@/${solver}/" ${infile} | \ sed "s/@EXAMPLES@/${examples}/" | \ sed "s/@EXAMPLES_BL@/${examples_bl}/" | \ sed "s/@SOLVER_LIB@/${solver_lib}/" | \ sed "s/@SOLVER_FLIB@/${solver_flib}/" > foo_makefile mv foo_makefile ${infile} sundials-2.5.0/README0000600000175000017500000000603011741421110015061 0ustar sylvestresylvestre SUNDIALS SUite of Nonlinear and DIfferential/ALgebraic equation Solvers Release 2.5.0, March 2012 Alan Hindmarsh, Radu Serban, Carol Woodward Center for Applied Scientific Computing, LLNL The family of solvers referred to as SUNDIALS consists of the following solvers: CVODE - for integration of ordinary differential equation systems (ODEs) CVODE treats stiff and nonstiff ODE systems of the form y' = f(t,y), y(t0) = y0 CVODES - for integration and sensitivity analysis of ODEs CVODES treats stiff and nonstiff ODE systems of the form y' = f(t,y,p), y(t0) = y0(p) IDA - for integration of differential-algebraic equation systems (DAEs) IDA treats DAE systems of the form F(t,y,y') = 0, y(t0) = y0, y'(t0) = y0' IDAS - for integration and sensitivity analysis of DAEs IDAS treats DAE systems of the form F(t,y,y',p) = 0, y(t0) = y0(p), y'(t0) = y0'(p) KINSOL - for solution of nonlinear algebraic systems KINSOL treats nonlinear systems of the form F(u) = 0 The various solvers of this family share many subordinate modules. For this reason, it is organized as a family, with a directory structure that exploits that sharing. Each individual solver includes documentation on installation, along with full usage documentation. Warning to users who receive more than one of these individual solvers at different times: The mixing of old and new versions SUNDIALS may fail. To avoid such failures, obtain all desired solvers at the same time. For installation directions see the file INSTALL_NOTES. For additional information on a particular solver, see the README file in the solver directory (e.g. src/cvode/README). Release history +----------+-----------------------------------------------------------------+ | | SUNDIALS | Solver version | | Date | +----------+----------+----------+---------------------+ | | release | CVODE | CVODES | IDA | IDAS | KINSOL | +----------+----------+----------+----------+----------+---------------------+ | Jul 2002 | 1.0 | 2.0 | 1.0 | 2.0 | | 2.0 | | Dec 2004 | 2.0 | 2.2.0 | 2.1.0 | 2.2.0 | | 2.2.0 | | Jan 2005 | 2.0.1 | 2.2.1 | 2.1.1 | 2.2.1 | | 2.2.1 | | Mar 2005 | 2.0.2 | 2.2.2 | 2.1.2 | 2.2.2 | | 2.2.2 | | Apr 2005 | 2.1.0 | 2.3.0 | 2.2.0 | 2.3.0 | | 2.3.0 | | May 2005 | 2.1.1 | 2.3.0 | 2.3.0 | 2.3.0 | | 2.3.0 | | Mar 2006 | 2.2.0 | 2.4.0 | 2.4.0 | 2.4.0 | | 2.4.0 | | Nov 2006 | 2.3.0 | 2.5.0 | 2.5.0 | 2.5.0 | | 2.5.0 | | May 2009 | 2.4.0 | 2.6.0 | 2.6.0 | 2.6.0 | 1.0.0 | 2.6.0 | | Mar 2012 | 2.5.0 | 2.7.0 | 2.7.0 | 2.7.0 | 1.1.0 | 2.7.0 | +----------+----------+----------+----------+----------+---------------------+ sundials-2.5.0/examples/0000755000175000017500000000000011767174700016052 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/0000755000175000017500000000000011767174700017152 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/fcmix_parallel/0000755000175000017500000000000011767174700022134 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_kry_bbd_p.f0000600000175000017500000002316211741421121025635 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2009/03/11 23:18:28 $ C ---------------------------------------------------------------- C Diagonal ODE example. Stiff case, with diagonal preconditioner. C Uses FCVODE interfaces and FCVBBD interfaces. C Solves problem twice -- with left and right preconditioning. C ---------------------------------------------------------------- C C Include MPI-Fortran header file for MPI_COMM_WORLD, MPI types. IMPLICIT NONE C INCLUDE "mpif.h" C INTEGER*4 NLOCAL PARAMETER (NLOCAL=10) C INTEGER NOUT, LNST, LNFE, LNSETUP, LNNI, LNCF, LNETF, LNPE INTEGER LNLI, LNPS, LNCFL, MYPE, IER, NPES, METH, ITMETH INTEGER LLENRW, LLENIW, LLENRWLS, LLENIWLS INTEGER IATOL, ITASK, IPRE, IGS, JOUT INTEGER*4 IOUT(25), IPAR(2) INTEGER*4 NEQ, I, MUDQ, MLDQ, MU, ML, NETF INTEGER*4 NST, NFE, NPSET, NPE, NPS, NNI, NLI, NCFN, NCFL, NGEBBD INTEGER*4 LENRW, LENIW, LENRWLS, LENIWLS, LENRWBBD, LENIWBBD DOUBLE PRECISION Y(1024), ROUT(10), RPAR(1) DOUBLE PRECISION ALPHA, TOUT, ERMAX, AVDIM DOUBLE PRECISION ATOL, ERRI, RTOL, GERMAX, DTOUT, T C DATA ATOL/1.0D-10/, RTOL/1.0D-5/, DTOUT/0.1D0/, NOUT/10/ DATA LLENRW/1/, LLENIW/2/, LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, 1 LNNI/7/, LNSETUP/8/, LLENRWLS/13/, LLENIWLS/14/, 1 LNPE/18/, LNLI/20/, LNPS/19/, LNCFL/21/ C C Get NPES and MYPE. Requires initialization of MPI. CALL MPI_INIT(IER) IF (IER .NE. 0) THEN WRITE(6,5) IER 5 FORMAT(///' MPI_ERROR: MPI_INIT returned IER = ', I5) STOP ENDIF CALL MPI_COMM_SIZE(MPI_COMM_WORLD, NPES, IER) IF (IER .NE. 0) THEN WRITE(6,6) IER 6 FORMAT(///' MPI_ERROR: MPI_COMM_SIZE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF CALL MPI_COMM_RANK(MPI_COMM_WORLD, MYPE, IER) IF (IER .NE. 0) THEN WRITE(6,7) IER 7 FORMAT(///' MPI_ERROR: MPI_COMM_RANK returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C C Set input arguments. NEQ = NPES * NLOCAL T = 0.0D0 METH = 2 ITMETH = 2 IATOL = 1 ITASK = 1 IPRE = 1 IGS = 1 C Set parameter alpha ALPHA = 10.0D0 C C Load IPAR and RPAR IPAR(1) = NLOCAL IPAR(2) = MYPE RPAR(1) = ALPHA C DO I = 1, NLOCAL Y(I) = 1.0D0 ENDDO C IF (MYPE .EQ. 0) THEN WRITE(6,15) NEQ, ALPHA, RTOL, ATOL, NPES 15 FORMAT('Diagonal test problem:'//' NEQ = ', I3, / & ' parameter alpha = ', F8.3/ & ' ydot_i = -alpha*i * y_i (i = 1,...,NEQ)'/ & ' RTOL, ATOL = ', 2E10.1/ & ' Method is BDF/NEWTON/SPGMR'/ & ' Preconditioner is band-block-diagonal, using CVBBDPRE' & /' Number of processors = ', I3/) ENDIF C CALL FNVINITP(MPI_COMM_WORLD, 1, NLOCAL, NEQ, IER) C IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITP returned IER = ', I5) CALL MPI_FINALIZE(IER) STOP ENDIF C CALL FCVMALLOC(T, Y, METH, ITMETH, IATOL, RTOL, ATOL, & IOUT, ROUT, IPAR, RPAR, IER) C IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C CALL FCVSPGMR(IPRE, IGS, 0, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,36) IER 36 FORMAT(///' SUNDIALS_ERROR: FCVSPGMR returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C MUDQ = 0 MLDQ = 0 MU = 0 ML = 0 CALL FCVBBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,35) IER 35 FORMAT(///' SUNDIALS_ERROR: FCVBBDINIT returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C IF (MYPE .EQ. 0) WRITE(6,38) 38 FORMAT(/'Preconditioning on left'/) C C Looping point for cases IPRE = 1 and 2. C 40 CONTINUE C C Loop through tout values, call solver, print output, test for failure. TOUT = DTOUT DO 60 JOUT = 1, NOUT C CALL FCVODE(TOUT, T, Y, ITASK, IER) C IF (MYPE .EQ. 0) WRITE(6,45) T, IOUT(LNST), IOUT(LNFE) 45 FORMAT(' t = ', E10.2, 5X, 'no. steps = ', I5, & ' no. f-s = ', I5) C IF (IER .NE. 0) THEN WRITE(6,50) IER, IOUT(15) 50 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, & ' Linear Solver returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C TOUT = TOUT + DTOUT 60 CONTINUE C C Get max. absolute error in the local vector. ERMAX = 0.0D0 DO 65 I = 1, NLOCAL ERRI = Y(I) - EXP(-ALPHA * (MYPE * NLOCAL + I) * T) ERMAX = MAX(ERMAX, ABS(ERRI)) 65 CONTINUE C Get global max. error from MPI_REDUCE call. CALL MPI_REDUCE(ERMAX, GERMAX, 1, MPI_DOUBLE_PRECISION, MPI_MAX, & 0, MPI_COMM_WORLD, IER) IF (IER .NE. 0) THEN WRITE(6,70) IER 70 FORMAT(///' MPI_ERROR: MPI_REDUCE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF IF (MYPE .EQ. 0) WRITE(6,75) GERMAX 75 FORMAT(/'Max. absolute error is', E10.2/) C C Print final statistics. IF (MYPE .EQ. 0) THEN NST = IOUT(LNST) NFE = IOUT(LNFE) NPSET = IOUT(LNSETUP) NPE = IOUT(LNPE) NPS = IOUT(LNPS) NNI = IOUT(LNNI) NLI = IOUT(LNLI) AVDIM = DBLE(NLI) / DBLE(NNI) NCFN = IOUT(LNCF) NCFL = IOUT(LNCFL) NETF = IOUT(LNETF) LENRW = IOUT(LLENRW) LENIW = IOUT(LLENIW) LENRWLS = IOUT(LLENRWLS) LENIWLS = IOUT(LLENIWLS) WRITE(6,80) NST, NFE, NPSET, NPE, NPS, NNI, NLI, AVDIM, NCFN, & NCFL, NETF, LENRW, LENIW, LENRWLS, LENIWLS 80 FORMAT(/'Final statistics:'// & ' number of steps = ', I5, 4X, & ' number of f evals. = ', I5/ & ' number of prec. setups = ', I5/ & ' number of prec. evals. = ', I5, 4X, & ' number of prec. solves = ', I5/ & ' number of nonl. iters. = ', I5, 4X, & ' number of lin. iters. = ', I5/ & ' average Krylov subspace dimension (NLI/NNI) = ',F8.4/ & ' number of conv. failures.. nonlinear = ', I3, & ' linear = ', I3/ & ' number of error test failures = ', I3/ & ' main solver real/int workspace sizes = ',2I5/ & ' linear solver real/int workspace sizes = ',2I5) CALL FCVBBDOPT(LENRWBBD, LENIWBBD, NGEBBD) WRITE(6,82) LENRWBBD, LENIWBBD, NGEBBD 82 FORMAT('In CVBBDPRE:'/ & ' real/int local workspace = ', 2I5/ & ' number of g evals. = ', I5) ENDIF C C If IPRE = 1, re-initialize T, Y, and the solver, and loop for C case IPRE = 2. Otherwise jump to final block. IF (IPRE .EQ. 2) GO TO 99 C T = 0.0D0 DO I = 1, NLOCAL Y(I) = 1.0D0 ENDDO C CALL FCVREINIT(T, Y, IATOL, RTOL, ATOL, IER) IF (IER .NE. 0) THEN WRITE(6,91) IER 91 FORMAT(///' SUNDIALS_ERROR: FCVREINIT returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C IPRE = 2 C CALL FCVBBDREINIT(NLOCAL, MUDQ, MLDQ, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,92) IER 92 FORMAT(///' SUNDIALS_ERROR: FCVBBDREINIT returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C CALL FCVSPGMRREINIT(IPRE, IGS, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,93) IER 93 FORMAT(///' SUNDIALS_ERROR: FCVSPGMRREINIT returned IER = ',I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C IF (MYPE .EQ. 0) WRITE(6,95) 95 FORMAT(//60('-')///'Preconditioning on right'/) GO TO 40 C C Free the memory and finalize MPI. 99 CALL FCVFREE CALL MPI_FINALIZE(IER) C STOP END C C ------------------------------------------------------------------------ C SUBROUTINE FCVFUN(T, Y, YDOT, IPAR, RPAR, IER) C Routine for right-hand side function f IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, Y(*), YDOT(*), RPAR(*) C INTEGER MYPE INTEGER*4 I, NLOCAL DOUBLE PRECISION ALPHA C NLOCAL = IPAR(1) MYPE = IPAR(2) ALPHA = RPAR(1) C DO I = 1, NLOCAL YDOT(I) = -ALPHA * (MYPE * NLOCAL + I) * Y(I) ENDDO C IER = 0 C RETURN END C C ------------------------------------------------------------------------ C SUBROUTINE FCVGLOCFN(NLOC, T, YLOC, GLOC, IPAR, RPAR, IER) C Routine to define local approximate function g, here the same as f. IMPLICIT NONE C INTEGER*4 NLOC, IPAR(*), IER DOUBLE PRECISION T, YLOC(*), GLOC(*), RPAR(*) C CALL FCVFUN(T, YLOC, GLOC, IPAR, RPAR, IER) C RETURN END C C ------------------------------------------------------------------------ C SUBROUTINE FCVCOMMFN(NLOC, T, YLOC, IPAR, RPAR, IER) C Routine to perform communication required for evaluation of g. IER = 0 RETURN END sundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_kry_p.f0000600000175000017500000002452411741421121025031 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2009/03/11 23:17:13 $ C ---------------------------------------------------------------- C Diagonal ODE example. Stiff case, with BDF/SPGMR, diagonal C preconditioner. Solved with preconditioning on left, then with C preconditioning on right. C ---------------------------------------------------------------- C C Include MPI-Fortran header file for MPI_COMM_WORLD, MPI types. C IMPLICIT NONE C INCLUDE "mpif.h" C INTEGER*4 NLOCAL PARAMETER (NLOCAL=10) C INTEGER LNST, LNFE, LNSETUP, LNNI, LNCF, LNETF, LNPE, LNLI, LNPS INTEGER LNCFL, NOUT, MYPE, NPES, IER, METH, ITMETH, IATOL INTEGER ITASK, IPRE, IGS, JOUT INTEGER*4 IOUT(25), IPAR(2) INTEGER*4 NEQ, I, NST, NFE, NPSET, NPE, NPS, NNI, NLI INTEGER*4 NCFL, NETF, NCFN DOUBLE PRECISION Y(1024), ROUT(10), RPAR(1) DOUBLE PRECISION ATOL, DTOUT, T, ALPHA, RTOL, TOUT, ERMAX, ERRI DOUBLE PRECISION GERMAX, AVDIM C DATA ATOL/1.0D-10/, RTOL/1.0D-5/, DTOUT/0.1D0/, NOUT/10/ DATA LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, LNNI/7/, LNSETUP/8/, 1 LNPE/18/, LNLI/20/, LNPS/19/, LNCFL/21/ C C Get NPES and MYPE. Requires initialization of MPI. CALL MPI_INIT(IER) IF (IER .NE. 0) THEN WRITE(6,5) IER 5 FORMAT(///' MPI_ERROR: MPI_INIT returned IER = ', I5) STOP ENDIF CALL MPI_COMM_SIZE(MPI_COMM_WORLD, NPES, IER) IF (IER .NE. 0) THEN WRITE(6,6) IER 6 FORMAT(///' MPI_ERROR: MPI_COMM_SIZE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF CALL MPI_COMM_RANK(MPI_COMM_WORLD, MYPE, IER) IF (IER .NE. 0) THEN WRITE(6,7) IER 7 FORMAT(///' MPI_ERROR: MPI_COMM_RANK returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C C Set input arguments. NEQ = NPES * NLOCAL T = 0.0D0 METH = 2 ITMETH = 2 IATOL = 1 ITASK = 1 IPRE = 1 IGS = 1 C Set parameter alpha. ALPHA = 10.0D0 C C Load IPAR and RPAR IPAR(1) = NLOCAL IPAR(2) = MYPE RPAR(1) = ALPHA C C Do remaining initializations for first case: IPRE = 1 (prec. on left). C DO 10 I = 1, NLOCAL 10 Y(I) = 1.0D0 C IF (MYPE .EQ. 0) THEN WRITE(6,11) NEQ, ALPHA 11 FORMAT('Diagonal test problem:'//' NEQ = ', I3, 1 ' parameter alpha = ', F8.3) WRITE(6,12) 12 FORMAT(' ydot_i = -alpha*i * y_i (i = 1,...,NEQ)') WRITE(6,13) RTOL, ATOL 13 FORMAT(' RTOL, ATOL = ', 2E10.1) WRITE(6,14) 14 FORMAT(' Method is BDF/NEWTON/SPGMR'/ 1 ' Diagonal preconditioner uses approximate Jacobian') WRITE(6,15) NPES 15 FORMAT(' Number of processors = ', I3) WRITE(6,16) 16 FORMAT(//'Preconditioning on left'/) ENDIF C CALL FNVINITP(MPI_COMM_WORLD, 1, NLOCAL, NEQ, IER) C IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITP returned IER = ', I5) CALL MPI_FINALIZE(IER) STOP ENDIF C CALL FCVMALLOC(T, Y, METH, ITMETH, IATOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) C IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C CALL FCVSPGMR (IPRE, IGS, 0, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,35) IER 35 FORMAT(///' SUNDIALS_ERROR: FCVSPGMR returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C CALL FCVSPILSSETPREC(1, IER) C C Loop through tout values, call solver, print output, test for failure. TOUT = DTOUT DO 70 JOUT = 1, NOUT C CALL FCVODE(TOUT, T, Y, ITASK, IER) C IF (MYPE .EQ. 0) WRITE(6,40) T, IOUT(LNST), IOUT(LNFE) 40 FORMAT(' t = ', E10.2, 5X, 'no. steps = ', I5, & ' no. f-s = ', I5) C IF (IER .NE. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, & ' Linear Solver returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C TOUT = TOUT + DTOUT 70 CONTINUE C C Get max. absolute error in the local vector. ERMAX = 0.0D0 DO 75 I = 1, NLOCAL ERRI = Y(I) - EXP(-ALPHA * (MYPE * NLOCAL + I) * T) 75 ERMAX = MAX(ERMAX, ABS(ERRI)) C Get global max. error from MPI_REDUCE call. CALL MPI_REDUCE(ERMAX, GERMAX, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 1 0, MPI_COMM_WORLD, IER) IF (IER .NE. 0) THEN WRITE(6,80) IER 80 FORMAT(///' MPI_ERROR: MPI_REDUCE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF IF (MYPE .EQ. 0) WRITE(6,85) GERMAX 85 FORMAT(/'Max. absolute error is ', E10.2/) C C Print final statistics. NST = IOUT(LNST) NFE = IOUT(LNFE) NPSET = IOUT(LNSETUP) NPE = IOUT(LNPE) NPS = IOUT(LNPS) NNI = IOUT(LNNI) NLI = IOUT(LNLI) AVDIM = DBLE(NLI) / DBLE(NNI) NCFN = IOUT(LNCF) NCFL = IOUT(LNCFL) NETF = IOUT(LNETF) IF (MYPE .EQ. 0) 1 WRITE (6,90) NST, NFE, NPSET, NPE, NPS, NNI, NLI, AVDIM, NCFN, & NCFL, NETF 90 FORMAT(/'Final statistics:'// & ' number of steps = ', I5, 5X, & 'number of f evals. =', I5/ & ' number of prec. setups = ', I5/ & ' number of prec. evals. = ', I5, 5X, & 'number of prec. solves = ', I5/ & ' number of nonl. iters. = ', I5, 5X, & 'number of lin. iters. = ', I5/ & ' average Krylov subspace dimension (NLI/NNI) = ', F8.4/ & ' number of conv. failures.. nonlinear = ', I3, & ' linear = ', I3/ & ' number of error test failures = ', I3) C C Re-initialize to run second case: IPRE = 2 (prec. on right). IPRE = 2 T = 0.0D0 DO 110 I = 1, NLOCAL 110 Y(I) = 1.0D0 C IF (MYPE .EQ. 0) WRITE(6,111) 111 FORMAT(//60('-')///'Preconditioning on right'/) C CALL FCVREINIT(T, Y, IATOL, RTOL, ATOL, IER) C IF (IER .NE. 0) THEN WRITE(6,130) IER 130 FORMAT(///' SUNDIALS_ERROR: FCVREINIT returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C CALL FCVSPGMRREINIT (IPRE, IGS, 0.0D0, IER) IF (IER .NE. 0) THEN WRITE(6,140) IER 140 FORMAT(///' SUNDIALS_ERROR: FCVSPGMRREINIT returned IER = ',I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C C Loop through tout values, call solver, print output, test for failure. TOUT = DTOUT DO 170 JOUT = 1, NOUT C CALL FCVODE(TOUT, T, Y, ITASK, IER) C IF (MYPE .EQ. 0) WRITE(6,40) T, IOUT(LNST), IOUT(LNFE) C IF (IER .NE. 0) THEN WRITE(6,60) IER CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C TOUT = TOUT + DTOUT 170 CONTINUE C C Get max. absolute error in the local vector. ERMAX = 0.0D0 DO 175 I = 1, NLOCAL ERRI = Y(I) - EXP(-ALPHA * (MYPE * NLOCAL + I) * T) 175 ERMAX = MAX(ERMAX, ABS(ERRI)) C Get global max. error from MPI_REDUCE call. CALL MPI_REDUCE(ERMAX, GERMAX, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 1 0, MPI_COMM_WORLD, IER) IF (IER .NE. 0) THEN WRITE(6,80) IER CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF IF (MYPE .EQ. 0) WRITE(6,85) GERMAX C C Print final statistics. NST = IOUT(LNST) NFE = IOUT(LNFE) NPSET = IOUT(LNSETUP) NPE = IOUT(LNPE) NPS = IOUT(LNPS) NNI = IOUT(LNNI) NLI = IOUT(LNLI) AVDIM = DBLE(NLI) / DBLE(NNI) NCFN = IOUT(LNCF) NCFL = IOUT(LNCFL) NETF = IOUT(LNETF) IF (MYPE .EQ. 0) 1 WRITE (6,90) NST, NFE, NPSET, NPE, NPS, NNI, NLI, AVDIM, NCFN, & NCFL, NETF C C Free the memory and finalize MPI. CALL FCVFREE CALL MPI_FINALIZE(IER) IF (IER .NE. 0) THEN WRITE(6,195) IER 195 FORMAT(///' MPI_ERROR: MPI_FINALIZE returned IER = ', I5) STOP ENDIF C STOP END C C ------------------------------------------------------------------------ C SUBROUTINE FCVFUN(T, Y, YDOT, IPAR, RPAR, IER) C Routine for right-hand side function f IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, Y(*), YDOT(*), RPAR(*) C INTEGER*4 I, MYPE, NLOCAL DOUBLE PRECISION ALPHA C NLOCAL = IPAR(1) MYPE = IPAR(2) ALPHA = RPAR(1) C DO I = 1, NLOCAL YDOT(I) = -ALPHA * (MYPE * NLOCAL + I) * Y(I) ENDDO C IER = 0 C RETURN END C C ------------------------------------------------------------------------ C SUBROUTINE FCVPSOL(T, Y, FY, R, Z, GAMMA, DELTA, LR, & IPAR, RPAR, VTEMP, IER) C Routine to solve preconditioner linear system C This routine uses a diagonal preconditioner P = I - gamma*J, C where J is a diagonal approximation to the true Jacobian, given by: C J = diag(0, 0, 0, -4*alpha, ..., -N*alpha). C The vector r is copied to z, and the inverse of P (restricted to the C local vector segment) is applied to the vector z. IMPLICIT NONE C INTEGER IER, LR INTEGER*4 IPAR(*) DOUBLE PRECISION T, Y(*), FY(*), R(*), Z(*) DOUBLE PRECISION GAMMA, DELTA, RPAR(*) DOUBLE PRECISION VTEMP(*) C INTEGER*4 I, MYPE, NLOCAL, ISTART, IBASE DOUBLE PRECISION PSUBI, ALPHA C NLOCAL = IPAR(1) MYPE = IPAR(2) ALPHA = RPAR(1) C DO I = 1, NLOCAL Z(I) = R(I) ENDDO C IBASE = MYPE * NLOCAL ISTART = MAX(1, 4 - IBASE) DO I = ISTART, NLOCAL PSUBI = 1.0D0 + GAMMA * ALPHA * (IBASE + I) Z(I) = Z(I) / PSUBI ENDDO C RETURN END C C ------------------------------------------------------------------------ C SUBROUTINE FCVPSET(T, Y, FY, JOK, JCUR, GAMMA, H, & IPAR, RPAR, V1, V2, V3, IER) C Empty function. Not needed for the preconditioner, but required C by the FCVODE module. RETURN END sundials-2.5.0/examples/cvode/fcmix_parallel/CMakeLists.txt0000600000175000017500000001023711741421121024647 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FCVODE parallel examples # Add variable FCVODE_examples with the names of the parallel CVODE examples SET(FCVODE_examples fcvDiag_non_p fcvDiag_kry_bbd_p fcvDiag_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the Fortran compiler to the MPIF77 script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPIF77 ) # use MPI_MPIF77 as the compiler SET(CMAKE_Fortran_COMPILER ${MPI_MPIF77}) ELSE(MPI_MPIF77) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPIF77) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_static) SET(NVECP_LIB sundials_nvecparallel_static) SET(FNVECP_LIB sundials_fnvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_shared) SET(NVECP_LIB sundials_nvecparallel_shared) SET(FNVECP_LIB sundials_fnvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FCVODE_LIB sundials_fcvode_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FCVODE_LIB} ${CVODE_LIB} ${FNVECP_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each CVODE example FOREACH(example ${FCVODE_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPIF77) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPIF77) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FCVODE_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODE") SET(SOLVER_LIB "sundials_cvode") SET(SOLVER_FLIB "sundials_fcvode") LIST2STRING(FCVODE_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvode/fcmix_parallel/Makefile.in0000600000175000017500000000747011741421121024161 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.11 $ # $Date: 2009/03/11 23:20:14 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FCVODE parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ FFLAGS = @FFLAGS@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ MPIF77 = @MPIF77@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_FLAGS = @MPI_FLAGS@ MPIF77_LNKR = @MPIF77_LNKR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/cvode/fcmix/libsundials_fcvode.la \ $(top_builddir)/src/cvode/libsundials_cvode.la \ $(top_builddir)/src/nvec_par/libsundials_fnvecparallel.la \ $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fcvDiag_non_p \ fcvDiag_kry_bbd_p \ fcvDiag_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${MPIF77} ${MPI_FLAGS} -I${MPI_INC_DIR} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${MPIF77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${MPI_FLAGS} ${F77_LDFLAGS} ${SUNDIALS_LIBS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${F77_LIBS} $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/cvode/fcmix_parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvode/fcmix_parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_parallel/README $(EXS_INSTDIR)/cvode/fcmix_parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_parallel/$${i}.f $(EXS_INSTDIR)/cvode/fcmix_parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_parallel/$${i}.out $(EXS_INSTDIR)/cvode/fcmix_parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/cvode/fcmix_parallel/Makefile rm -f $(EXS_INSTDIR)/cvode/fcmix_parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvode/fcmix_parallel/$${i}.f ; \ rm -f $(EXS_INSTDIR)/cvode/fcmix_parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/cvode/fcmix_parallel $(rminstalldirs) $(EXS_INSTDIR)/cvode clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_kry_p.out0000600000175000017500000000447311741421121025414 0ustar sylvestresylvestreDiagonal test problem: NEQ = 40 parameter alpha = 10.000 ydot_i = -alpha*i * y_i (i = 1,...,NEQ) RTOL, ATOL = 0.1E-04 0.1E-09 Method is BDF/NEWTON/SPGMR Diagonal preconditioner uses approximate Jacobian Number of processors = 4 Preconditioning on left t = 0.10E+00 no. steps = 221 no. f-s = 262 t = 0.20E+00 no. steps = 265 no. f-s = 308 t = 0.30E+00 no. steps = 290 no. f-s = 334 t = 0.40E+00 no. steps = 306 no. f-s = 351 t = 0.50E+00 no. steps = 319 no. f-s = 365 t = 0.60E+00 no. steps = 329 no. f-s = 375 t = 0.70E+00 no. steps = 339 no. f-s = 385 t = 0.80E+00 no. steps = 346 no. f-s = 393 t = 0.90E+00 no. steps = 351 no. f-s = 400 t = 0.10E+01 no. steps = 355 no. f-s = 404 Max. absolute error is 0.15E-07 Final statistics: number of steps = 355 number of f evals. = 404 number of prec. setups = 37 number of prec. evals. = 7 number of prec. solves = 727 number of nonl. iters. = 400 number of lin. iters. = 367 average Krylov subspace dimension (NLI/NNI) = 0.9175 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 5 ------------------------------------------------------------ Preconditioning on right t = 0.10E+00 no. steps = 221 no. f-s = 262 t = 0.20E+00 no. steps = 265 no. f-s = 308 t = 0.30E+00 no. steps = 290 no. f-s = 334 t = 0.40E+00 no. steps = 306 no. f-s = 351 t = 0.50E+00 no. steps = 319 no. f-s = 365 t = 0.60E+00 no. steps = 329 no. f-s = 375 t = 0.70E+00 no. steps = 339 no. f-s = 385 t = 0.80E+00 no. steps = 345 no. f-s = 392 t = 0.90E+00 no. steps = 352 no. f-s = 399 t = 0.10E+01 no. steps = 358 no. f-s = 405 Max. absolute error is 0.21E-08 Final statistics: number of steps = 358 number of f evals. = 405 number of prec. setups = 36 number of prec. evals. = 6 number of prec. solves = 730 number of nonl. iters. = 401 number of lin. iters. = 367 average Krylov subspace dimension (NLI/NNI) = 0.9152 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 5 sundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_non_p.out0000600000175000017500000000172511741421121025376 0ustar sylvestresylvestreDiagonal test problem: NEQ = 8 parameter alpha = 1.250 ydot_i = -alpha*i * y_i (i = 1,...,NEQ) RTOL, ATOL = 0.1E-04 0.1E-09 Method is ADAMS/FUNCTIONAL Number of processors = 4 t = 0.10D+00 no. steps = 14 no. f-s = 32 t = 0.20D+00 no. steps = 22 no. f-s = 40 t = 0.30D+00 no. steps = 29 no. f-s = 47 t = 0.40D+00 no. steps = 37 no. f-s = 55 t = 0.50D+00 no. steps = 44 no. f-s = 62 t = 0.60D+00 no. steps = 51 no. f-s = 69 t = 0.70D+00 no. steps = 59 no. f-s = 78 t = 0.80D+00 no. steps = 66 no. f-s = 85 t = 0.90D+00 no. steps = 74 no. f-s = 93 t = 0.10D+01 no. steps = 81 no. f-s = 100 Max. absolute error is 0.41E-07 Final statistics: number of steps = 81 number of f evals. = 100 number of nonlinear iters. = 96 number of nonlinear conv. failures = 0 number of error test failures = 3 sundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_kry_bbd_p.out0000600000175000017500000000526211741421121026220 0ustar sylvestresylvestreDiagonal test problem: NEQ = 40 parameter alpha = 10.000 ydot_i = -alpha*i * y_i (i = 1,...,NEQ) RTOL, ATOL = 0.1E-04 0.1E-09 Method is BDF/NEWTON/SPGMR Preconditioner is band-block-diagonal, using CVBBDPRE Number of processors = 4 Preconditioning on left t = 0.10E+00 no. steps = 221 no. f-s = 262 t = 0.20E+00 no. steps = 265 no. f-s = 308 t = 0.30E+00 no. steps = 290 no. f-s = 334 t = 0.40E+00 no. steps = 306 no. f-s = 351 t = 0.50E+00 no. steps = 319 no. f-s = 365 t = 0.60E+00 no. steps = 329 no. f-s = 375 t = 0.70E+00 no. steps = 339 no. f-s = 386 t = 0.80E+00 no. steps = 345 no. f-s = 392 t = 0.90E+00 no. steps = 352 no. f-s = 399 t = 0.10E+01 no. steps = 359 no. f-s = 406 Max. absolute error is 0.28E-08 Final statistics: number of steps = 359 number of f evals. = 406 number of prec. setups = 38 number of prec. evals. = 7 number of prec. solves = 728 number of nonl. iters. = 402 number of lin. iters. = 364 average Krylov subspace dimension (NLI/NNI) = 0.9055 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 5 main solver real/int workspace sizes = 489 120 linear solver real/int workspace sizes = 446 80 In CVBBDPRE: real/int local workspace = 20 10 number of g evals. = 14 ------------------------------------------------------------ Preconditioning on right t = 0.10E+00 no. steps = 221 no. f-s = 262 t = 0.20E+00 no. steps = 265 no. f-s = 308 t = 0.30E+00 no. steps = 290 no. f-s = 334 t = 0.40E+00 no. steps = 306 no. f-s = 351 t = 0.50E+00 no. steps = 319 no. f-s = 365 t = 0.60E+00 no. steps = 329 no. f-s = 375 t = 0.70E+00 no. steps = 339 no. f-s = 386 t = 0.80E+00 no. steps = 345 no. f-s = 392 t = 0.90E+00 no. steps = 352 no. f-s = 399 t = 0.10E+01 no. steps = 359 no. f-s = 406 Max. absolute error is 0.28E-08 Final statistics: number of steps = 359 number of f evals. = 406 number of prec. setups = 38 number of prec. evals. = 7 number of prec. solves = 728 number of nonl. iters. = 402 number of lin. iters. = 364 average Krylov subspace dimension (NLI/NNI) = 0.9055 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 5 main solver real/int workspace sizes = 489 120 linear solver real/int workspace sizes = 446 80 In CVBBDPRE: real/int local workspace = 20 10 number of g evals. = 14 sundials-2.5.0/examples/cvode/fcmix_parallel/README0000600000175000017500000000120111741421121022756 0ustar sylvestresylvestreList of parallel CVODE FCMIX examples fcvDiag_non_p : diagonal ODE example - non-stiff case (ADAMS/FUNCTIONAL) fcvDiag_kry_bbd_p : diagonal ODE example - stiff case (BDF/SPGMR/FCVBBD) fcvDiag_kry_p : diagonal ODE example - stiff case (BDF/SPGMR) Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/cvode/fcmix_parallel/fcvDiag_non_p.f0000600000175000017500000001304211741421121025007 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2009/03/11 23:16:06 $ C ---------------------------------------------------------------- C Diagonal ODE example. Nonstiff case: alpha = 10/NEQ. C ---------------------------------------------------------------- C C Include MPI-Fortran header file for MPI_COMM_WORLD, MPI types. C IMPLICIT NONE C INCLUDE "mpif.h" C INTEGER*4 NLOCAL PARAMETER (NLOCAL=2) C INTEGER IER, MYPE, NPES, NOUT, LNST, LNFE, LNNI, LNCF, LNETF INTEGER METH, ITMETH, IATOL, ITASK, JOUT INTEGER*4 NEQ, I, NST, NFE, NNI, NCFN, NETF INTEGER*4 IOUT(25), IPAR(2) DOUBLE PRECISION Y(128), ROUT(10), RPAR(1) DOUBLE PRECISION ATOL, RTOL, DTOUT, T, ALPHA, TOUT DOUBLE PRECISION ERMAX, ERRI, GERMAX C DATA ATOL/1.0D-10/, RTOL/1.0D-5/, DTOUT/0.1D0/, NOUT/10/ DATA LNST/3/, LNFE/4/, LNNI/7/, LNCF/6/, LNETF/5/ C C Get NPES and MYPE. Requires initialization of MPI. CALL MPI_INIT(IER) IF (IER .NE. 0) THEN WRITE(6,5) IER 5 FORMAT(///' MPI_ERROR: MPI_INIT returned IER = ', I5) STOP ENDIF CALL MPI_COMM_SIZE(MPI_COMM_WORLD, NPES, IER) IF (IER .NE. 0) THEN WRITE(6,6) IER 6 FORMAT(///' MPI_ERROR: MPI_COMM_SIZE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF CALL MPI_COMM_RANK(MPI_COMM_WORLD, MYPE, IER) IF (IER .NE. 0) THEN WRITE(6,7) IER 7 FORMAT(///' MPI_ERROR: MPI_COMM_RANK returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C C Set input arguments. NEQ = NPES * NLOCAL T = 0.0D0 METH = 1 ITMETH = 1 IATOL = 1 ITASK = 1 c Set parameter ALPHA ALPHA = 10.0D0 / NEQ C C Load IPAR and RPAR IPAR(1) = NLOCAL IPAR(2) = MYPE RPAR(1) = ALPHA C DO 10 I = 1, NLOCAL 10 Y(I) = 1.0D0 C IF (MYPE .EQ. 0) THEN WRITE(6,11) NEQ, ALPHA 11 FORMAT('Diagonal test problem:'//' NEQ = ', I3, / 1 ' parameter alpha = ', F8.3) WRITE(6,12) 12 FORMAT(' ydot_i = -alpha*i * y_i (i = 1,...,NEQ)') WRITE(6,13) RTOL, ATOL 13 FORMAT(' RTOL, ATOL = ', 2E10.1) WRITE(6,14) 14 FORMAT(' Method is ADAMS/FUNCTIONAL') WRITE(6,15) NPES 15 FORMAT(' Number of processors = ', I3//) ENDIF C CALL FNVINITP(MPI_COMM_WORLD, 1, NLOCAL, NEQ, IER) C IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITP returned IER = ', I5) CALL MPI_FINALIZE(IER) STOP ENDIF C CALL FCVMALLOC(T, Y, METH, ITMETH, IATOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) C IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C C Loop through tout values, call solver, print output, test for failure. TOUT = DTOUT DO 70 JOUT = 1, NOUT C CALL FCVODE(TOUT, T, Y, ITASK, IER) C IF (MYPE .EQ. 0) WRITE(6,40) T, IOUT(LNST), IOUT(LNFE) 40 FORMAT(' t = ', D10.2, 5X, 'no. steps = ', I5, & ' no. f-s = ', I5) C IF (IER .NE. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, & ' Linear Solver returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF C TOUT = TOUT + DTOUT 70 CONTINUE C C Get max. absolute error in the local vector. ERMAX = 0.0D0 DO 75 I = 1, NLOCAL ERRI = Y(I) - EXP(-ALPHA * (MYPE * NLOCAL + I) * T) ERMAX = MAX(ERMAX, ABS(ERRI)) 75 CONTINUE C Get global max. error from MPI_REDUCE call. CALL MPI_REDUCE(ERMAX, GERMAX, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 1 0, MPI_COMM_WORLD, IER) IF (IER .NE. 0) THEN WRITE(6,80) IER 80 FORMAT(///' MPI_ERROR: MPI_REDUCE returned IER = ', I5) CALL MPI_ABORT(MPI_COMM_WORLD, 1, IER) STOP ENDIF IF (MYPE .EQ. 0) WRITE(6,85) GERMAX 85 FORMAT(/'Max. absolute error is ', E10.2/) C C Print final statistics. NST = IOUT(LNST) NFE = IOUT(LNFE) NNI = IOUT(LNNI) NCFN = IOUT(LNCF) NETF = IOUT(LNETF) IF (MYPE .EQ. 0) WRITE (6,90) NST, NFE, NNI, NCFN, NETF 90 FORMAT(/'Final statistics:'// & ' number of steps = ', I5, 5X, /, & ' number of f evals. = ', I5/ & ' number of nonlinear iters. = ', I5/ & ' number of nonlinear conv. failures = ', I3/ & ' number of error test failures = ', I3) C C Free the memory and finalize MPI. CALL FCVFREE CALL MPI_FINALIZE(IER) IF (IER .NE. 0) THEN WRITE(6,95) IER 95 FORMAT(///' MPI_ERROR: MPI_FINALIZE returned IER = ', I5) STOP ENDIF C STOP END C C ------------------------------------------------------------------------ C SUBROUTINE FCVFUN(T, Y, YDOT, IPAR, RPAR, IER) C Routine for right-hand side function f C IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, Y(*), YDOT(*), RPAR(*) C INTEGER MYPE INTEGER*4 NLOCAL, I DOUBLE PRECISION ALPHA C NLOCAL = IPAR(1) MYPE = IPAR(2) ALPHA = RPAR(1) C DO I = 1, NLOCAL YDOT(I) = -ALPHA * (MYPE * NLOCAL + I) * Y(I) ENDDO C IER = 0 C RETURN END sundials-2.5.0/examples/cvode/parallel/0000755000175000017500000000000011767174700020746 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/parallel/cvDiurnal_kry_bbd_p.c0000600000175000017500000007404511741421121025036 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/14 21:31:59 $ * ----------------------------------------------------------------- * Programmer(s): S. D. Cohen, A. C. Hindmarsh, M. R. Wittman, and * Radu Serban @ LLNL * -------------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * mesh, with simple polynomial initial profiles. * * The problem is solved by CVODE on NPE processors, treated * as a rectangular process grid of size NPEX by NPEY, with * NPE = NPEX*NPEY. Each processor contains a subgrid of size MXSUB * by MYSUB of the (x,y) mesh. Thus the actual mesh sizes are * MX = MXSUB*NPEX and MY = MYSUB*NPEY, and the ODE system size is * neq = 2*MX*MY. * * The solution is done with the BDF/GMRES method (i.e. using the * CVSPGMR linear solver) and a block-diagonal matrix with banded * blocks as a preconditioner, using the CVBBDPRE module. * Each block is generated using difference quotients, with * half-bandwidths mudq = mldq = 2*MXSUB, but the retained banded * blocks have half-bandwidths mukeep = mlkeep = 2. * A copy of the approximate Jacobian is saved and conditionally * reused within the preconditioner routine. * * The problem is solved twice -- with left and right preconditioning. * * Performance data and sampled solution values are printed at * selected output times, and all performance counters are printed * on completion. * * This version uses MPI for user routines. * Execute with number of processors = NPEX*NPEY (see constants below). * -------------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* prototypes and constants for CVSPGMR */ #include /* prototypes for CVBBDPRE module */ #include /* def. of N_Vector, macro NV_DATA_P */ #include /* definitions of realtype, booleantype */ #include /* definition of macros SQR and EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define ZERO RCONST(0.0) #define NVARS 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define NPEX 2 /* no. PEs in x direction of PE array */ #define NPEY 2 /* no. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* no. x points per subgrid */ #define MYSUB 5 /* no. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ /* Type : UserData contains problem constants, extended dependent variable array, grid constants, processor indices, MPI communicator */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; realtype uext[NVARS*(MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby; long int nvmxsub, nvmxsub2, Nlocal; MPI_Comm comm; } *UserData; /* Prototypes of private helper functions */ static void InitUserData(int my_pe, long int local_N, MPI_Comm comm, UserData data); static void SetInitialProfiles(N_Vector u, UserData data); static void PrintIntro(int npes, long int mudq, long int mldq, long int mukeep, long int mlkeep); static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uarray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]); static void fucomm(realtype t, N_Vector u, void *user_data); /* Prototype of function called by the solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Prototype of functions called by the CVBBDPRE module */ static int flocal(long int Nlocal, realtype t, N_Vector u, N_Vector udot, void *user_data); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; realtype abstol, reltol, t, tout; N_Vector u; int iout, my_pe, npes, flag, jpre; long int neq, local_N, mudq, mldq, mukeep, mlkeep; MPI_Comm comm; data = NULL; cvode_mem = NULL; u = NULL; /* Set problem size neq */ neq = NVARS*MX*MY; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate and load user data block */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, local_N, comm, data); /* Allocate and initialize u, and set tolerances */ u = N_VNew_Parallel(comm, local_N, neq); if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetInitialProfiles(u, data); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the default maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVBBDSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Initialize BBD preconditioner */ mudq = mldq = NVARS*MXSUB; mukeep = mlkeep = NVARS; flag = CVBBDPrecInit(cvode_mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, flocal, NULL); if(check_flag(&flag, "CVBBDPrecAlloc", 1, my_pe)) MPI_Abort(comm, 1); /* Print heading */ if (my_pe == 0) PrintIntro(npes, mudq, mldq, mukeep, mlkeep); /* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { /* On second run, re-initialize u, the integrator, CVBBDPRE, and CVSPGMR */ if (jpre == PREC_RIGHT) { SetInitialProfiles(u, data); flag = CVodeReInit(cvode_mem, T0, u); if(check_flag(&flag, "CVodeReInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVBBDPrecReInit(cvode_mem, mudq, mldq, ZERO); if(check_flag(&flag, "CVBBDPrecReInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVSpilsSetPrecType(cvode_mem, PREC_RIGHT); check_flag(&flag, "CVSpilsSetPrecType", 1, my_pe); if (my_pe == 0) { printf("\n\n-------------------------------------------------------"); printf("------------\n"); } } if (my_pe == 0) { printf("\n\nPreconditioner type is: jpre = %s\n\n", (jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT"); } /* In loop over output points, call CVode, print results, test for error */ for (iout = 1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, comm, u, t); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem); } /* End of jpre loop */ /* Free memory */ N_VDestroy_Parallel(u); free(data); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /*********************** Private Helper Functions ************************/ /* Load constants in data */ static void InitUserData(int my_pe, long int local_N, MPI_Comm comm, UserData data) { int isubx, isuby; /* Set problem constants */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/((realtype)(MX-1)); data->dy = (YMAX-YMIN)/((realtype)(MY-1)); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0; /* Set machine-related constants */ data->comm = comm; data->my_pe = my_pe; data->Nlocal = local_N; /* isubx and isuby are the PE grid indices corresponding to my_pe */ isuby = my_pe/NPEX; isubx = my_pe - isuby*NPEX; data->isubx = isubx; data->isuby = isuby; /* Set the sizes of a boundary x-line in u and uext */ data->nvmxsub = NVARS*MXSUB; data->nvmxsub2 = NVARS*(MXSUB+2); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, UserData data) { int isubx, isuby; int lx, ly, jx, jy; long int offset; realtype dx, dy, x, y, cx, cy, xmid, ymid; realtype *uarray; /* Set pointer to data array in vector u */ uarray = NV_DATA_P(u); /* Get mesh spacings, and subgrid indices for this PE */ dx = data->dx; dy = data->dy; isubx = data->isubx; isuby = data->isuby; /* Load initial profiles of c1 and c2 into local u vector. Here lx and ly are local mesh point indices on the local subgrid, and jx and jy are the global mesh point indices. */ offset = 0; xmid = RCONST(0.5)*(XMIN + XMAX); ymid = RCONST(0.5)*(YMIN + YMAX); for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - ymid)); cy = RCONST(1.0) - cy + RCONST(0.5)*SQR(cy); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - xmid)); cx = RCONST(1.0) - cx + RCONST(0.5)*SQR(cx); uarray[offset ] = C1_SCALE*cx*cy; uarray[offset+1] = C2_SCALE*cx*cy; offset = offset + 2; } } } /* Print problem introduction */ static void PrintIntro(int npes, long int mudq, long int mldq, long int mukeep, long int mlkeep) { printf("\n2-species diurnal advection-diffusion problem\n"); printf(" %d by %d mesh on %d processors\n", MX, MY, npes); printf(" Using CVBBDPRE preconditioner module\n"); printf(" Difference-quotient half-bandwidths are"); printf(" mudq = %ld, mldq = %ld\n", mudq, mldq); printf(" Retained band block half-bandwidths are"); printf(" mukeep = %ld, mlkeep = %ld", mukeep, mlkeep); return; } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t) { int qu, flag, npelast; long int i0, i1, nst; realtype hu, *uarray, tempu[2]; MPI_Status status; npelast = NPEX*NPEY - 1; uarray = NV_DATA_P(u); /* Send c1,c2 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&uarray[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { tempu[0] = uarray[i0]; tempu[1] = uarray[i1]; } } /* On PE 0, receive c1,c2 at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3le %12.3le \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3le %12.3le \n\n", tempu[0], tempu[1]); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3e %12.3e \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]); #endif } } /* Print final statistics contained in iopt */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int lenrwBBDP, leniwBBDP, ngevalsBBDP; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1, 0); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1, 0); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1, 0); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1, 0); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1, 0); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1, 0); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1, 0); printf("\nFinal Statistics: \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfels = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); flag = CVBBDPrecGetWorkSpace(cvode_mem, &lenrwBBDP, &leniwBBDP); check_flag(&flag, "CVBBDPrecGetWorkSpace", 1, 0); flag = CVBBDPrecGetNumGfnEvals(cvode_mem, &ngevalsBBDP); check_flag(&flag, "CVBBDPrecGetNumGfnEvals", 1, 0); printf("In CVBBDPRE: real/integer local work space sizes = %ld, %ld\n", lenrwBBDP, leniwBBDP); printf(" no. flocal evals. = %ld\n",ngevalsBBDP); } /* Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uarray[]) { int i, ly; long int offsetu, offsetbuf; realtype bufleft[NVARS*MYSUB], bufright[NVARS*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = ly*dsizex; for (i = 0; i < NVARS; i++) bufleft[offsetbuf+i] = uarray[offsetu+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = offsetbuf*MXSUB + (MXSUB-1)*NVARS; for (i = 0; i < NVARS; i++) bufright[offsetbuf+i] = uarray[offsetu+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Routine to start receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Irecv(&uext[NVARS], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) { offsetue = NVARS*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* Routine to finish receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]) { int i, ly; long int dsizex2, offsetue, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NVARS; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+1)*dsizex2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+2)*dsizex2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufright[offsetbuf+i]; } } } /* fucomm routine. This routine performs all inter-processor communication of data in u needed to calculate f. */ static void fucomm(realtype t, N_Vector u, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*NVARS*MYSUB]; MPI_Comm comm; int my_pe, isubx, isuby; long int nvmxsub, nvmysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(u); /* Get comm, my_pe, subgrid indices, data sizes, extended array uext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmysub = NVARS*MYSUB; uext = data->uext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, uarray); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer); } /***************** Function called by the solver **************************/ /* f routine. Evaluate f(t,y). First call fucomm to do communication of subgrid boundary data into uext. Then calculate f by a call to flocal. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { UserData data; data = (UserData) user_data; /* Call fucomm to do inter-processor communication */ fucomm (t, u, user_data); /* Call flocal to calculate all right-hand sides */ flocal (data->Nlocal, t, u, udot, user_data); return(0); } /***************** Functions called by the CVBBDPRE module ****************/ /* flocal routine. Compute f(t,y). This routine assumes that all inter-processor communication of data needed to calculate f has already been done, and this data is in the work array uext. */ static int flocal(long int Nlocal, realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype *uext; realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int i, lx, ly, jx, jy; int isubx, isuby; long int nvmxsub, nvmxsub2, offsetu, offsetue; UserData data; realtype *uarray, *duarray; uarray = NV_DATA_P(u); duarray = NV_DATA_P(udot); /* Get subgrid indices, array sizes, extended work array uext */ data = (UserData) user_data; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2; uext = data->uext; /* Copy local segment of u vector into the working extended array uext */ offsetu = 0; offsetue = nvmxsub2 + NVARS; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i]; offsetu = offsetu + nvmxsub; offsetue = offsetue + nvmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of u to uext */ /* If isuby = 0, copy x-line 2 of u to uext */ if (isuby == 0) { for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = uarray[nvmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */ if (isuby == NPEY-1) { offsetu = (MYSUB-2)*nvmxsub; offsetue = (MYSUB+1)*nvmxsub2 + NVARS; for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i]; } /* If isubx = 0, copy y-line 2 of u to uext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*nvmxsub + NVARS; offsetue = (ly+1)*nvmxsub2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = (ly+1)*nvmxsub - 2*NVARS; offsetue = (ly+2)*nvmxsub2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i]; } } /* Make local copies of problem variables, for efficiency */ dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Set diurnal rate coefficients as functions of t, and save q4 in data block for use by preconditioner evaluation routine */ s = sin((data->om)*t); if (s > ZERO) { q3 = EXP(-A3/s); q4coef = EXP(-A4/s); } else { q3 = ZERO; q4coef = ZERO; } data->q4 = q4coef; /* Loop over all grid points in local subgrid */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; /* Extract c1 and c2, and set kinetic rate terms */ offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2; c1 = uext[offsetue]; c2 = uext[offsetue+1]; qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + 2.0*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms */ c1dn = uext[offsetue-nvmxsub2]; c2dn = uext[offsetue-nvmxsub2+1]; c1up = uext[offsetue+nvmxsub2]; c2up = uext[offsetue+nvmxsub2+1]; vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms */ c1lt = uext[offsetue-2]; c2lt = uext[offsetue-1]; c1rt = uext[offsetue+2]; c2rt = uext[offsetue+3]; hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt); hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into duarray */ offsetu = lx*NVARS + ly*nvmxsub; duarray[offsetu] = vertd1 + hord1 + horad1 + rkin1; duarray[offsetu+1] = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/parallel/CMakeLists.txt0000600000175000017500000000753311741421121023466 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for CVODE parallel examples # Add variable CVODE_examples with the names of the parallel CVODE examples SET(CVODE_examples cvAdvDiff_non_p cvDiurnal_kry_bbd_p cvDiurnal_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the C compiler to the MPICC script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_static) SET(NVECP_LIB sundials_nvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_shared) SET(NVECP_LIB sundials_nvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${CVODE_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each CVODE example FOREACH(example ${CVODE_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPICC) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPICC) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODE_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODE") SET(SOLVER_LIB "sundials_cvode") LIST2STRING(CVODE_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvode/parallel/Makefile.in0000600000175000017500000000704611741421121022772 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for CVODE parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/cvode/libsundials_cvode.la $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = cvAdvDiff_non_p \ cvDiurnal_kry_bbd_p \ cvDiurnal_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(SUNDIALS_INCS) -I$(MPI_INC_DIR) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(MPICC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}$(OBJ_EXT) $(MPI_FLAGS) $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/cvode/parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvode/parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvode/parallel/README $(EXS_INSTDIR)/cvode/parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/parallel/$${i}.c $(EXS_INSTDIR)/cvode/parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/parallel/$${i}.out $(EXS_INSTDIR)/cvode/parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/cvode/parallel/Makefile rm -f $(EXS_INSTDIR)/cvode/parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvode/parallel/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvode/parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/cvode/parallel $(rminstalldirs) $(EXS_INSTDIR)/cvode clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvode/parallel/cvDiurnal_kry_p.c0000600000175000017500000010073111741421121024217 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/01 22:52:20 $ * ----------------------------------------------------------------- * Programmer(s): S. D. Cohen, A. C. Hindmarsh, M. R. Wittman, and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * mesh, with simple polynomial initial profiles. * * The problem is solved by CVODE on NPE processors, treated * as a rectangular process grid of size NPEX by NPEY, with * NPE = NPEX*NPEY. Each processor contains a subgrid of size MXSUB * by MYSUB of the (x,y) mesh. Thus the actual mesh sizes are * MX = MXSUB*NPEX and MY = MYSUB*NPEY, and the ODE system size is * neq = 2*MX*MY. * * The solution is done with the BDF/GMRES method (i.e. using the * CVSPGMR linear solver) and the block-diagonal part of the * Newton matrix as a left preconditioner. A copy of the * block-diagonal part of the Jacobian is saved and conditionally * reused within the preconditioner routine. * * Performance data and sampled solution values are printed at * selected output times, and all performance counters are printed * on completion. * * This version uses MPI for user routines. * * Execution: mpirun -np N cvDiurnal_kry_p with N = NPEX*NPEY * (see constants below). * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* prototypes & constants for CVSPGMR */ #include /* def. of N_Vector, macro NV_DATA_P */ #include /* prototypes for small dense fcts. */ #include /* definitions of realtype, booleantype */ #include /* definition of macros SQR and EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define NVARS 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 RCONST(0.0) /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN RCONST(0.0) /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define NPEX 2 /* no. PEs in x direction of PE array */ #define NPEY 2 /* no. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* no. x points per subgrid */ #define MYSUB 5 /* no. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ /* CVodeMalloc Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ /* User-defined matrix accessor macro: IJth */ /* IJth is defined in order to write code which indexes into dense matrices with a (row,column) pair, where 1 <= row,column <= NVARS. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NVARS. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains problem constants, preconditioner blocks, pivot arrays, grid constants, and processor indices, as well as data needed for the preconditiner */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; realtype uext[NVARS*(MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby; int nvmxsub, nvmxsub2; MPI_Comm comm; /* For preconditioner */ realtype **P[MXSUB][MYSUB], **Jbd[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; } *UserData; /* Private Helper Functions */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, UserData data); static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype udata[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]); static void ucomm(realtype t, N_Vector u, UserData data); static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int neq, local_N; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; /* Set problem size neq */ neq = NVARS*MX*MY; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate and load user data block; allocate preconditioner block */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, comm, data); /* Allocate u, and set initial values and tolerances */ u = N_VNew_Parallel(comm, local_N, neq); if (check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1); SetInitialProfiles(u, data); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if (check_flag(&flag, "CVSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Set preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if (check_flag(&flag, "CVSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) printf("\n2-species diurnal advection-diffusion problem\n\n"); /* In loop over output points, call CVode, print results, test for error */ for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if (check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, comm, u, t); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem); /* Free memory */ N_VDestroy_Parallel(u); FreeUserData(data); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /*********************** Private Helper Functions ************************/ /* Load constants in data */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data) { int isubx, isuby; int lx, ly; /* Set problem constants */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/((realtype)(MX-1)); data->dy = (YMAX-YMIN)/((realtype)(MY-1)); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0; /* Set machine-related constants */ data->comm = comm; data->my_pe = my_pe; /* isubx and isuby are the PE grid indices corresponding to my_pe */ isuby = my_pe/NPEX; isubx = my_pe - isuby*NPEX; data->isubx = isubx; data->isuby = isuby; /* Set the sizes of a boundary x-line in u and uext */ data->nvmxsub = NVARS*MXSUB; data->nvmxsub2 = NVARS*(MXSUB+2); /* Preconditioner-related fields */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { (data->P)[lx][ly] = newDenseMat(NVARS, NVARS); (data->Jbd)[lx][ly] = newDenseMat(NVARS, NVARS); (data->pivot)[lx][ly] = newLintArray(NVARS); } } } /* Free user data memory */ static void FreeUserData(UserData data) { int lx, ly; for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { destroyMat((data->P)[lx][ly]); destroyMat((data->Jbd)[lx][ly]); destroyArray((data->pivot)[lx][ly]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, UserData data) { int isubx, isuby, lx, ly, jx, jy; long int offset; realtype dx, dy, x, y, cx, cy, xmid, ymid; realtype *udata; /* Set pointer to data array in vector u */ udata = NV_DATA_P(u); /* Get mesh spacings, and subgrid indices for this PE */ dx = data->dx; dy = data->dy; isubx = data->isubx; isuby = data->isuby; /* Load initial profiles of c1 and c2 into local u vector. Here lx and ly are local mesh point indices on the local subgrid, and jx and jy are the global mesh point indices. */ offset = 0; xmid = RCONST(0.5)*(XMIN + XMAX); ymid = RCONST(0.5)*(YMIN + YMAX); for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - ymid)); cy = RCONST(1.0) - cy + RCONST(0.5)*SQR(cy); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - xmid)); cx = RCONST(1.0) - cx + RCONST(0.5)*SQR(cx); udata[offset ] = C1_SCALE*cx*cy; udata[offset+1] = C2_SCALE*cx*cy; offset = offset + 2; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t) { int qu, flag; realtype hu, *udata, tempu[2]; int npelast; long int i0, i1, nst; MPI_Status status; npelast = NPEX*NPEY - 1; udata = NV_DATA_P(u); /* Send c1,c2 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&udata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { tempu[0] = udata[i0]; tempu[1] = udata[i1]; } } /* On PE 0, receive c1,c2 at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3le %12.3le \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3le %12.3le \n\n", tempu[0], tempu[1]); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]); #endif } } /* Print final statistics contained in iopt */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1, 0); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1, 0); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1, 0); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1, 0); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1, 0); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1, 0); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1, 0); printf("\nFinal Statistics: \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfels = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype udata[]) { int i, ly; long int offsetu, offsetbuf; realtype bufleft[NVARS*MYSUB], bufright[NVARS*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&udata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&udata[offsetu], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = ly*dsizex; for (i = 0; i < NVARS; i++) bufleft[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = offsetbuf*MXSUB + (MXSUB-1)*NVARS; for (i = 0; i < NVARS; i++) bufright[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Routine to start receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Irecv(&uext[NVARS], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) { offsetue = NVARS*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* Routine to finish receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]) { int i, ly; long int dsizex2, offsetue, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NVARS; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+1)*dsizex2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+2)*dsizex2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufright[offsetbuf+i]; } } } /* ucomm routine. This routine performs all communication between processors of data needed to calculate f. */ static void ucomm(realtype t, N_Vector u, UserData data) { realtype *udata, *uext, buffer[2*NVARS*MYSUB]; MPI_Comm comm; int my_pe, isubx, isuby; long int nvmxsub, nvmysub; MPI_Request request[4]; udata = NV_DATA_P(u); /* Get comm, my_pe, subgrid indices, data sizes, extended array uext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmysub = NVARS*MYSUB; uext = data->uext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, udata); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer); } /* fcalc routine. Compute f(t,y). This routine assumes that communication between processors of data needed to calculate f has already been done, and this data is in the work array uext. */ static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data) { realtype *uext; realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int i, lx, ly, jx, jy; int isubx, isuby; long int nvmxsub, nvmxsub2, offsetu, offsetue; /* Get subgrid indices, data sizes, extended work array uext */ isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2; uext = data->uext; /* Copy local segment of u vector into the working extended array uext */ offsetu = 0; offsetue = nvmxsub2 + NVARS; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; offsetu = offsetu + nvmxsub; offsetue = offsetue + nvmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of u to uext */ /* If isuby = 0, copy x-line 2 of u to uext */ if (isuby == 0) { for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = udata[nvmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */ if (isuby == NPEY-1) { offsetu = (MYSUB-2)*nvmxsub; offsetue = (MYSUB+1)*nvmxsub2 + NVARS; for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; } /* If isubx = 0, copy y-line 2 of u to uext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*nvmxsub + NVARS; offsetue = (ly+1)*nvmxsub2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = (ly+1)*nvmxsub - 2*NVARS; offsetue = (ly+2)*nvmxsub2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* Make local copies of problem variables, for efficiency */ dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Set diurnal rate coefficients as functions of t, and save q4 in data block for use by preconditioner evaluation routine */ s = sin((data->om)*t); if (s > RCONST(0.0)) { q3 = EXP(-A3/s); q4coef = EXP(-A4/s); } else { q3 = RCONST(0.0); q4coef = RCONST(0.0); } data->q4 = q4coef; /* Loop over all grid points in local subgrid */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; /* Extract c1 and c2, and set kinetic rate terms */ offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2; c1 = uext[offsetue]; c2 = uext[offsetue+1]; qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + RCONST(2.0)*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms */ c1dn = uext[offsetue-nvmxsub2]; c2dn = uext[offsetue-nvmxsub2+1]; c1up = uext[offsetue+nvmxsub2]; c2up = uext[offsetue+nvmxsub2+1]; vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms */ c1lt = uext[offsetue-2]; c2lt = uext[offsetue-1]; c1rt = uext[offsetue+2]; c2rt = uext[offsetue+3]; hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt); hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into dudata */ offsetu = lx*NVARS + ly*nvmxsub; dudata[offsetu] = vertd1 + hord1 + horad1 + rkin1; dudata[offsetu+1] = vertd2 + hord2 + horad2 + rkin2; } } } /***************** Functions Called by the Solver *************************/ /* f routine. Evaluate f(t,y). First call ucomm to do communication of subgrid boundary data into uext. Then calculate f by a call to fcalc. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype *udata, *dudata; UserData data; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); data = (UserData) user_data; /* Call ucomm to do inter-processor communication */ ucomm(t, u, data); /* Call fcalc to calculate all right-hand sides */ fcalc(t, udata, dudata, data); return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MYSUB], **(*Jbd)[MYSUB]; int nvmxsub, ier, offset; long int *(*pivot)[MYSUB]; int lx, ly, jx, jy, isubx, isuby; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, pointer to u's data, and PE index pair */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_P(u); isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseCopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + RCONST(2.0)*hordco); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; offset = lx*NVARS + ly*nvmxsub; c1 = udata[offset]; c2 = udata[offset+1]; j = Jbd[lx][ly]; a = P[lx][ly]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NVARS, NVARS); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseScale(-gamma, P[lx][ly], NVARS, NVARS); /* Add identity matrix and do LU decompositions on blocks in place */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { denseAddIdentity(P[lx][ly], NVARS); ier = denseGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MYSUB]; int nvmxsub; long int *(*pivot)[MYSUB]; int lx, ly; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data */ data = (UserData) user_data; P = data->P; pivot = data->pivot; /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. First copy vector r to z. */ N_VScale(RCONST(1.0), r, z); nvmxsub = data->nvmxsub; zdata = NV_DATA_P(z); for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { v = &(zdata[lx*NVARS + ly*nvmxsub]); denseGETRS(P[lx][ly], NVARS, pivot[lx][ly], v); } } return(0); } /*********************** Private Helper Function ************************/ /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/parallel/cvDiurnal_kry_bbd_p.out0000600000175000017500000001230011741421121025405 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem 10 by 10 mesh on 4 processors Using CVBBDPRE preconditioner module Difference-quotient half-bandwidths are mudq = 10, mldq = 10 Retained band block half-bandwidths are mukeep = 2, mlkeep = 2 Preconditioner type is: jpre = PREC_LEFT t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.61e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 221 order = 5 stepsize = 3.85e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 247 order = 5 stepsize = 3.00e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 272 order = 4 stepsize = 4.05e+02 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 309 order = 4 stepsize = 7.53e+01 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 377 order = 4 stepsize = 4.02e+02 At bottom left: c1, c2 = 1.908e-07 3.382e+11 At top right: c1, c2 = 2.345e-07 3.804e+11 t = 5.04e+04 no. steps = 392 order = 5 stepsize = 3.67e+02 At bottom left: c1, c2 = -6.408e-10 3.358e+11 At top right: c1, c2 = -6.654e-10 3.864e+11 t = 5.76e+04 no. steps = 403 order = 5 stepsize = 4.72e+02 At bottom left: c1, c2 = 2.017e-08 3.320e+11 At top right: c1, c2 = 3.353e-08 3.909e+11 t = 6.48e+04 no. steps = 415 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = -2.502e-10 3.313e+11 At top right: c1, c2 = 2.005e-10 3.963e+11 t = 7.20e+04 no. steps = 424 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 4.217e-12 3.330e+11 At top right: c1, c2 = -2.693e-12 4.039e+11 t = 7.92e+04 no. steps = 434 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 2.779e-12 3.334e+11 At top right: c1, c2 = -1.865e-12 4.120e+11 t = 8.64e+04 no. steps = 444 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 2.331e-13 3.352e+11 At top right: c1, c2 = -1.599e-13 4.163e+11 Final Statistics: lenrw = 2089 leniw = 120 lenrwls = 2046 leniwls = 80 nst = 444 nfe = 581 nfels = 526 nni = 577 nli = 526 nsetups = 75 netf = 28 npe = 8 nps = 1057 ncfn = 0 ncfl = 0 In CVBBDPRE: real/integer local work space sizes = 600, 50 no. flocal evals. = 176 ------------------------------------------------------------------- Preconditioner type is: jpre = PREC_RIGHT t = 7.20e+03 no. steps = 191 order = 5 stepsize = 1.22e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 223 order = 5 stepsize = 2.79e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 249 order = 5 stepsize = 4.31e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 314 order = 3 stepsize = 9.38e+01 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 350 order = 5 stepsize = 9.78e+01 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 403 order = 4 stepsize = 3.87e+02 At bottom left: c1, c2 = 1.504e-09 3.382e+11 At top right: c1, c2 = 1.683e-09 3.804e+11 t = 5.04e+04 no. steps = 416 order = 5 stepsize = 5.91e+02 At bottom left: c1, c2 = -1.137e-11 3.358e+11 At top right: c1, c2 = -1.439e-11 3.864e+11 t = 5.76e+04 no. steps = 432 order = 5 stepsize = 1.73e+02 At bottom left: c1, c2 = 1.293e-09 3.320e+11 At top right: c1, c2 = 2.448e-10 3.909e+11 t = 6.48e+04 no. steps = 447 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = 7.963e-13 3.313e+11 At top right: c1, c2 = -2.943e-13 3.963e+11 t = 7.20e+04 no. steps = 459 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = -2.414e-12 3.330e+11 At top right: c1, c2 = 2.797e-13 4.039e+11 t = 7.92e+04 no. steps = 470 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = -1.059e-13 3.334e+11 At top right: c1, c2 = 3.557e-14 4.120e+11 t = 8.64e+04 no. steps = 481 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = 6.045e-15 3.352e+11 At top right: c1, c2 = -2.016e-15 4.163e+11 Final Statistics: lenrw = 2089 leniw = 120 lenrwls = 2046 leniwls = 80 nst = 481 nfe = 622 nfels = 769 nni = 618 nli = 769 nsetups = 104 netf = 33 npe = 9 nps = 1281 ncfn = 0 ncfl = 0 In CVBBDPRE: real/integer local work space sizes = 600, 50 no. flocal evals. = 198 sundials-2.5.0/examples/cvode/parallel/cvAdvDiff_non_p.out0000600000175000017500000000135511741421121024500 0ustar sylvestresylvestre 1-D advection-diffusion equation, mesh size = 10 Number of PEs = 4 At t = 0.00 max.norm(u) = 1.569909e+01 nst = 0 At t = 0.50 max.norm(u) = 3.052881e+00 nst = 113 At t = 1.00 max.norm(u) = 8.753188e-01 nst = 191 At t = 1.50 max.norm(u) = 2.494926e-01 nst = 265 At t = 2.00 max.norm(u) = 7.109707e-02 nst = 339 At t = 2.50 max.norm(u) = 2.026223e-02 nst = 418 At t = 3.00 max.norm(u) = 5.777332e-03 nst = 486 At t = 3.50 max.norm(u) = 1.650483e-03 nst = 563 At t = 4.00 max.norm(u) = 4.754357e-04 nst = 646 At t = 4.50 max.norm(u) = 1.374222e-04 nst = 715 At t = 5.00 max.norm(u) = 3.937469e-05 nst = 795 Final Statistics: nst = 795 nfe = 1465 nni = 1461 ncfn = 146 netf = 5 sundials-2.5.0/examples/cvode/parallel/cvDiurnal_kry_p.out0000600000175000017500000000454211741421121024607 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 307 order = 4 stepsize = 1.98e+02 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 335 order = 5 stepsize = 1.17e+02 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 388 order = 4 stepsize = 4.48e+02 At bottom left: c1, c2 = -5.732e-07 3.382e+11 At top right: c1, c2 = -6.367e-07 3.804e+11 t = 5.04e+04 no. steps = 406 order = 5 stepsize = 3.97e+02 At bottom left: c1, c2 = -4.317e-09 3.358e+11 At top right: c1, c2 = -8.233e-09 3.864e+11 t = 5.76e+04 no. steps = 418 order = 5 stepsize = 4.74e+02 At bottom left: c1, c2 = -2.576e-09 3.320e+11 At top right: c1, c2 = -1.259e-09 3.909e+11 t = 6.48e+04 no. steps = 428 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 3.451e-09 3.313e+11 At top right: c1, c2 = 2.081e-09 3.963e+11 t = 7.20e+04 no. steps = 437 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 1.630e-11 3.330e+11 At top right: c1, c2 = 1.843e-11 4.039e+11 t = 7.92e+04 no. steps = 447 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = -1.704e-11 3.334e+11 At top right: c1, c2 = -1.131e-11 4.120e+11 t = 8.64e+04 no. steps = 456 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 1.496e-12 3.352e+11 At top right: c1, c2 = 8.085e-13 4.163e+11 Final Statistics: lenrw = 2089 leniw = 120 lenrwls = 2046 leniwls = 80 nst = 456 nfe = 586 nfels = 619 nni = 582 nli = 619 nsetups = 73 netf = 25 npe = 8 nps = 1149 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvode/parallel/cvAdvDiff_non_p.c0000600000175000017500000002645111741421121024117 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:28 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, George Byrne, * and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the program for * its solution by CVODE. The problem is the semi-discrete * form of the advection-diffusion equation in 1-D: * du/dt = d^2 u / dx^2 + .5 du/dx * on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. * Homogeneous Dirichlet boundary conditions are posed, and the * initial condition is the following: * u(x,t=0) = x(2-x)exp(2x) . * The PDE is discretized on a uniform grid of size MX+2 with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX. * This program solves the problem with the option for nonstiff * systems: ADAMS method and functional iteration. * It uses scalar relative and absolute tolerances. * Output is printed at t = .5, 1.0, ..., 5. * Run statistics (optional outputs) are printed at the end. * * This version uses MPI for user routines. * Execute with Number of Processors = N, with 1 <= N <= MX. * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* definition of N_Vector and macros */ #include /* definition of realtype */ #include /* definition of EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define ZERO RCONST(0.0) #define XMAX RCONST(2.0) /* domain boundary */ #define MX 10 /* mesh dimension */ #define NEQ MX /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 ZERO /* initial time */ #define T1 RCONST(0.5) /* first output time */ #define DTOUT RCONST(0.5) /* output time increment */ #define NOUT 10 /* number of output times */ /* Type : UserData contains grid constants, parallel machine parameters, work array. */ typedef struct { realtype dx, hdcoef, hacoef; int npes, my_pe; MPI_Comm comm; realtype z[100]; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base); static void PrintIntro(int npes); static void PrintData(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { realtype dx, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int local_N, nperpe, nrem, my_base, nst; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; /* Get processor number, total number of pe's, and my_pe. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); /* Set local vector length. */ nperpe = NEQ/npes; nrem = NEQ - npes*nperpe; local_N = (my_pe < nrem) ? nperpe+1 : nperpe; my_base = (my_pe < nrem) ? my_pe*local_N : my_pe*nperpe + nrem; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->comm = comm; data->npes = npes; data->my_pe = my_pe; u = N_VNew_Parallel(comm, local_N, NEQ); /* Allocate u vector */ if(check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; dx = data->dx = XMAX/((realtype)(MX+1)); /* Set grid coefficients in data */ data->hdcoef = RCONST(1.0)/(dx*dx); data->hacoef = RCONST(0.5)/(RCONST(2.0)*dx); SetIC(u, dx, local_N, my_base); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Adams-Moulton LMM and the use of a functional iteration */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); if (my_pe == 0) PrintIntro(npes); umax = N_VMaxNorm(u); if (my_pe == 0) { t = T0; PrintData(t, umax, 0); } /* In loop over output points, call CVode, print results, test for error */ for (iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); if (my_pe == 0) PrintData(t, umax, nst); } if (my_pe == 0) PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Parallel(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free user data */ MPI_Finalize(); return(0); } /************************ Private Helper Functions ***********************/ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base) { int i; long int iglobal; realtype x; realtype *udata; /* Set pointer to data array and get local length of u. */ udata = NV_DATA_P(u); my_length = NV_LOCLENGTH_P(u); /* Load initial profile into u vector */ for (i=1; i<=my_length; i++) { iglobal = my_base + i; x = iglobal*dx; udata[i-1] = x*(XMAX - x)*EXP(RCONST(2.0)*x); } } /* Print problem introduction */ static void PrintIntro(int npes) { printf("\n 1-D advection-diffusion equation, mesh size =%3d \n", MX); printf("\n Number of PEs = %3d \n\n", npes); return; } /* Print data */ static void PrintData(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst =%4ld \n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst =%4ld \n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst =%4ld \n", t, umax, nst); #endif return; } /* Print some final statistics located in the iopt array */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nni, ncfn, netf; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); printf("\nFinal Statistics: \n\n"); printf("nst = %-6ld nfe = %-6ld ", nst, nfe); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); } /***************** Function Called by the Solver ***********************/ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype ui, ult, urt, hordc, horac, hdiff, hadv; realtype *udata, *dudata, *z; int i; int npes, my_pe, my_length, my_pe_m1, my_pe_p1, last_pe, my_last; UserData data; MPI_Status status; MPI_Comm comm; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); /* Extract needed problem constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; /* Extract parameters for parallel computation. */ comm = data->comm; npes = data->npes; /* Number of processes. */ my_pe = data->my_pe; /* Current process number. */ my_length = NV_LOCLENGTH_P(u); /* Number of local elements of u. */ z = data->z; /* Compute related parameters. */ my_pe_m1 = my_pe - 1; my_pe_p1 = my_pe + 1; last_pe = npes - 1; my_last = my_length - 1; /* Store local segment of u in the working array z. */ for (i = 1; i <= my_length; i++) z[i] = udata[i - 1]; /* Pass needed data to processes before and after current process. */ if (my_pe != 0) MPI_Send(&z[1], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm); if (my_pe != last_pe) MPI_Send(&z[my_length], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm); /* Receive needed data from processes before and after current process. */ if (my_pe != 0) MPI_Recv(&z[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status); else z[0] = ZERO; if (my_pe != last_pe) MPI_Recv(&z[my_length+1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status); else z[my_length + 1] = ZERO; /* Loop over all grid points in current process. */ for (i=1; i<=my_length; i++) { /* Extract u at x_i and two neighboring points */ ui = z[i]; ult = z[i-1]; urt = z[i+1]; /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - RCONST(2.0)*ui + urt); hadv = horac*(urt - ult); dudata[i-1] = hdiff + hadv; } return(0); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/parallel/README0000600000175000017500000000117211741421121021577 0ustar sylvestresylvestreList of parallel CVODE examples cvAdvDiff_non_p : 1-D advection-diffusion (nonstiff) cvDiurnal_kry_bbd_p : 2-D 2-species diurnal advection-diffusion with BBD preconditioner cvDiurnal_kry_p : 2-D 2-species diurnal advection-diffusion Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/cvode/serial/0000755000175000017500000000000011767174700020431 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/serial/cvRoberts_dns_uw.out0000600000175000017500000000233611741421121024466 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158010e-01 9.185084e-06 2.841898e-01 At t = 4.0000e+02 y = 4.504693e-01 3.222618e-06 5.495275e-01 At t = 4.0000e+03 y = 1.832127e-01 8.943456e-07 8.167865e-01 At t = 4.0000e+04 y = 3.899386e-02 1.622228e-07 9.610060e-01 At t = 4.0000e+05 y = 4.937166e-03 1.984537e-08 9.950628e-01 At t = 4.0000e+06 y = 5.167725e-04 2.068146e-09 9.994832e-01 At t = 2.0792e+07 y = 1.000000e-04 4.000399e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.201944e-05 2.080885e-10 9.999480e-01 At t = 4.0000e+08 y = 5.222674e-06 2.089080e-11 9.999948e-01 At t = 4.0000e+09 y = 5.206257e-07 2.082504e-12 9.999995e-01 At t = 4.0000e+10 y = 4.244776e-08 1.697910e-13 1.000000e-00 Final Statistics: nst = 545 nfe = 773 nsetups = 117 nfeLS = 0 nje = 12 nni = 769 ncfn = 0 netf = 30 nge = 573 sundials-2.5.0/examples/cvode/serial/cvDiurnal_kry_bp.out0000600000175000017500000001362711741421121024440 0ustar sylvestresylvestre2-species diurnal advection-diffusion problem, 10 by 10 mesh SPGMR solver; band preconditioner; mu = 2, ml = 2 Preconditioner type is: jpre = PREC_LEFT t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.61e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 221 order = 5 stepsize = 3.83e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 246 order = 5 stepsize = 2.78e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 291 order = 4 stepsize = 1.14e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 331 order = 4 stepsize = 8.86e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 402 order = 4 stepsize = 4.15e+02 c1 (bot.left/middle/top rt.) = -5.769e-09 3.421e-09 -3.866e-09 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 415 order = 5 stepsize = 4.58e+02 c1 (bot.left/middle/top rt.) = -4.979e-18 -7.193e-15 -2.653e-15 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 430 order = 4 stepsize = 2.19e+02 c1 (bot.left/middle/top rt.) = 1.611e-17 4.587e-16 -4.704e-18 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 444 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 9.505e-16 1.154e-14 -2.316e-16 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 457 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 3.910e-16 -4.848e-14 2.545e-15 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 469 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = -2.903e-15 2.152e-13 3.551e-16 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 481 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 2.358e-23 2.316e-18 -6.007e-16 c2 (bot.left/middle/top rt.) = 3.352e+11 9.108e+11 4.162e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwls = 2046 leniwls = 10 lenrwbp = 2400 leniwbp = 200 nst = 481 nfe = 620 nfetot = 1226 nfeLS = 561 nfeBP = 45 nni = 616 nli = 561 nsetups = 88 netf = 28 npe = 9 nps = 1096 ncfn = 0 ncfl = 0 ------------------------------------------------------------------- Preconditioner type is: jpre = PREC_RIGHT t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.55e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.59e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 279 order = 5 stepsize = 3.58e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 2.40e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 330 order = 5 stepsize = 1.31e+02 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 381 order = 4 stepsize = 3.91e+02 c1 (bot.left/middle/top rt.) = 3.125e-10 2.750e-10 3.496e-10 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 395 order = 5 stepsize = 4.06e+02 c1 (bot.left/middle/top rt.) = -3.259e-14 -1.715e-12 -6.477e-14 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 408 order = 5 stepsize = 4.57e+02 c1 (bot.left/middle/top rt.) = 2.382e-14 5.871e-12 6.950e-14 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 420 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = 1.493e-18 1.862e-17 -7.080e-16 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 430 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = -1.345e-20 1.847e-18 -6.157e-16 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 440 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = 3.617e-20 -3.355e-18 -7.407e-16 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 450 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = -5.505e-20 3.704e-18 -2.929e-15 c2 (bot.left/middle/top rt.) = 3.352e+11 9.106e+11 4.163e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwls = 2046 leniwls = 10 lenrwbp = 2400 leniwbp = 200 nst = 450 nfe = 564 nfetot = 1319 nfeLS = 670 nfeBP = 85 nni = 560 nli = 670 nsetups = 71 netf = 21 npe = 8 nps = 1140 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvode/serial/cvDiurnal_kry_bp.c0000600000175000017500000004444311741421121024053 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODE, with the BDF/GMRES * method (i.e. using the CVSPGMR linear solver) and a banded * preconditioner, generated by difference quotients, using the * module CVBANDPRE. The problem is solved with left and right * preconditioning. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* prototypes & constants for CVBANDPRE module */ #include /* serial N_Vector types, fct. and macros */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static void InitUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintIntro(long int mu, long int ml); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Function Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int flag, iout, jpre; long int ml, mu; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate and initialize u, and set problem data and tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* Call CVBandPreInit to initialize band preconditioner */ ml = mu = 2; flag = CVBandPrecInit(cvode_mem, NEQ, mu, ml); if(check_flag(&flag, "CVBandPrecInit", 0)) return(1); PrintIntro(mu, ml); /* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { /* On second run, re-initialize u, the solver, and CVSPGMR */ if (jpre == PREC_RIGHT) { SetInitialProfiles(u, data->dx, data->dy); flag = CVodeReInit(cvode_mem, T0, u); if(check_flag(&flag, "CVodeReInit", 1)) return(1); flag = CVSpilsSetPrecType(cvode_mem, PREC_RIGHT); check_flag(&flag, "CVSpilsSetPrecType", 1); printf("\n\n-------------------------------------------------------"); printf("------------\n"); } printf("\n\nPreconditioner type is: jpre = %s\n\n", (jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT"); /* In loop over output points, call CVode, print results, test for error */ for (iout = 1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); PrintOutput(cvode_mem, u, t); if (flag != CV_SUCCESS) { break; } } /* Print final statistics */ PrintFinalStats(cvode_mem); } /* End of jpre loop */ /* Free memory */ N_VDestroy_Serial(u); free(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy = 0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx = 0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } static void PrintIntro(long int mu, long int ml) { printf("2-species diurnal advection-diffusion problem, %d by %d mesh\n", MX, MY); printf("SPGMR solver; band preconditioner; mu = %d, ml = %d\n\n", mu, ml); return; } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u,realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int lenrwBP, leniwBP; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; long int nfeBP; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); flag = CVBandPrecGetWorkSpace(cvode_mem, &lenrwBP, &leniwBP); check_flag(&flag, "CVBandPrecGetWorkSpace", 1); flag = CVBandPrecGetNumRhsEvals(cvode_mem, &nfeBP); check_flag(&flag, "CVBandPrecGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("lenrwbp = %5ld leniwbp = %5ld\n", lenrwBP, leniwBP); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfetot = %5ld\n" , nfe, nfe+nfeLS+nfeBP); printf("nfeLS = %5ld nfeBP = %5ld\n" , nfeLS, nfeBP); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Function called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot,void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int idn, iup, ileft, iright, jx, jy; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy = 0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx = 0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } sundials-2.5.0/examples/cvode/serial/CMakeLists.txt0000600000175000017500000001021211741421121023135 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for CVODE serial examples # Add variable CVODE_examples with the names of the serial CVODE examples SET(CVODE_examples cvAdvDiff_bnd cvDirectDemo_ls cvDiurnal_kry_bp cvDiurnal_kry cvKrylovDemo_ls cvKrylovDemo_prec cvRoberts_dns cvRoberts_dns_uw ) # Add variable CVODE_examples_BL with the names of the serial CVODE examples # that use Lapack SET(CVODE_examples_BL cvAdvDiff_bndL cvRoberts_dnsL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_static) SET(NVECS_LIB sundials_nvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_shared) SET(NVECS_LIB sundials_nvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${CVODE_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each CVODE example FOREACH(example ${CVODE_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODE_examples}) # Add the build and install targets for each Lapack CVODE example (if needed) IF(LAPACK_FOUND) FOREACH(example ${CVODE_examples_BL}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODE_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODE") SET(SOLVER_LIB "sundials_cvode") LIST2STRING(CVODE_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(CVODE_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvode/serial/Makefile.in0000600000175000017500000001073311741421121022452 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for CVODE serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ SHARED_LIBS = @SHARED_LIBS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/cvode/libsundials_cvode.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = cvAdvDiff_bnd \ cvDirectDemo_ls \ cvDiurnal_kry_bp \ cvDiurnal_kry \ cvKrylovDemo_ls \ cvKrylovDemo_prec \ cvRoberts_dns \ cvRoberts_dns_uw EXAMPLES_BL = cvAdvDiff_bndL \ cvRoberts_dnsL OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/cvode/serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvode/serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvode/serial/README $(EXS_INSTDIR)/cvode/serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/serial/$${i}.c $(EXS_INSTDIR)/cvode/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/serial/$${i}.out $(EXS_INSTDIR)/cvode/serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/serial/$${i}.c $(EXS_INSTDIR)/cvode/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/serial/$${i}.out $(EXS_INSTDIR)/cvode/serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/cvode/serial/Makefile rm -f $(EXS_INSTDIR)/cvode/serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvode/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvode/serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/cvode/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvode/serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/cvode/serial $(rminstalldirs) $(EXS_INSTDIR)/cvode clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvode/serial/cvAdvDiff_bndL.c0000600000175000017500000003215211741421121023343 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem with a banded Jacobian, * with the program for its solution by CVODE. * The problem is the semi-discrete form of the advection-diffusion * equation in 2-D: * du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 * on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time * interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions * are posed, and the initial condition is * u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). * The PDE is discretized on a uniform MX+2 by MY+2 grid with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX*MY. * This program solves the problem with the BDF method, Newton * iteration with the LAPACK band linear solver, and a user-supplied * Jacobian routine. * It uses scalar relative and absolute tolerances. * Output is printed at t = .1, .2, ..., 1. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include #include #include /* Header files with a description of contents used in cvbanx.c */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVLapackBand */ #include /* serial N_Vector types, fcts., and macros */ #include /* definition of ABS and EXP */ /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundaries */ #define YMAX RCONST(1.0) #define MX 10 /* mesh dimensions */ #define MY 5 #define NEQ MX*MY /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.1) /* first output time */ #define DTOUT RCONST(0.1) /* output time increment */ #define NOUT 10 /* number of output times */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FIVE RCONST(5.0) /* User-defined vector access macro IJth */ /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= MX, 1 <= j <= MY. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*MY]) /* Type : UserData (contains grid constants) */ typedef struct { realtype dx, dy, hdcoef, hacoef, vdcoef; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, UserData data); static void PrintHeader(realtype reltol, realtype abstol, realtype umax); static void PrintOutput(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype dx, dy, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag; long int nst; u = NULL; data = NULL; cvode_mem = NULL; /* Create a serial vector */ u = N_VNew_Serial(NEQ); /* Allocate u vector */ if(check_flag((void*)u, "N_VNew_Serial", 0)) return(1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2)) return(1); dx = data->dx = XMAX/(MX+1); /* Set grid coefficients in data */ dy = data->dy = YMAX/(MY+1); data->hdcoef = ONE/(dx*dx); data->hacoef = HALF/(TWO*dx); data->vdcoef = ONE/(dy*dy); SetIC(u, data); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerance */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVLapackBand to specify the CVBAND band linear solver */ flag = CVLapackBand(cvode_mem, NEQ, MY, MY); if(check_flag(&flag, "CVLapackBand", 1)) return(1); /* Set the user-supplied Jacobian routine Jac */ flag = CVDlsSetBandJacFn(cvode_mem, Jac); if(check_flag(&flag, "CVDlsSetBandJacFn", 1)) return(1); /* In loop over output points: call CVode, print results, test for errors */ umax = N_VMaxNorm(u); PrintHeader(reltol, abstol, umax); for(iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); PrintOutput(t, umax, nst); } PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Serial(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free the user data */ return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u,N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); } /* Jacobian routine. Compute J(t,u). */ static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* * The components of f = udot that depend on u(i,j) are * f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with * df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) * df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) * df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) * df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) * df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* set non-zero Jacobian entries */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*EXP(FIVE*x*y); } } } /* Print first lines of output (problem description) */ static void PrintHeader(realtype reltol, realtype abstol, realtype umax) { printf("\n2-D Advection-Diffusion Equation\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Total system size = %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: reltol = %Lg abstol = %Lg\n\n", reltol, abstol); printf("At t = %Lg max.norm(u) =%14.6Le \n", T0, umax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: reltol = %lg abstol = %lg\n\n", reltol, abstol); printf("At t = %lg max.norm(u) =%14.6le \n", T0, umax); #else printf("Tolerance parameters: reltol = %g abstol = %g\n\n", reltol, abstol); printf("At t = %g max.norm(u) =%14.6e \n", T0, umax); #endif return; } /* Print current value */ static void PrintOutput(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst = %4ld\n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst = %4ld\n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst = %4ld\n", t, umax, nst); #endif return; } /* Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { int flag; long int nst, nfe, nsetups, netf, nni, ncfn, nje, nfeLS; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvDirectDemo_ls.c0000600000175000017500000006163411741421121023625 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Demonstration program for CVODE - direct linear solvers. * Two separate problems are solved using both the CV_ADAMS and CV_BDF * linear multistep methods in combination with CV_FUNCTIONAL and * CV_NEWTON iterations: * * Problem 1: Van der Pol oscillator * xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0. * This second-order ODE is converted to a first-order system by * defining y0 = x and y1 = xdot. * The NEWTON iteration cases use the following types of Jacobian * approximation: (1) dense, user-supplied, (2) dense, difference * quotient approximation, (3) diagonal approximation. * * Problem 2: ydot = A * y, where A is a banded lower triangular * matrix derived from 2-D advection PDE. * The NEWTON iteration cases use the following types of Jacobian * approximation: (1) band, user-supplied, (2) band, difference * quotient approximation, (3) diagonal approximation. * * For each problem, in the series of eight runs, CVodeInit is * called only once, for the first run, whereas CVodeReInit is * called for each of the remaining seven runs. * * Notes: This program demonstrates the usage of the sequential * macros NV_Ith_S, NV_DATA_S, DENSE_ELEM, BAND_COL, and * BAND_COL_ELEM. The NV_Ith_S macro is used to reference the * components of an N_Vector. It works for any size N=NEQ, but * due to efficiency concerns it should only by used when the * problem size is small. The Problem 1 right hand side and * Jacobian functions f1 and Jac1 both use NV_Ith_S. The NV_DATA_S * macro gives the user access to the memory used for the component * storage of an N_Vector. In the sequential case, the user may * assume that this is one contiguous array of reals. The NV_DATA_S * macro gives a more efficient means (than the NV_Ith_S macro) to * access the components of an N_Vector and should be used when the * problem size is large. The Problem 2 right hand side function f2 * uses the NV_DATA_S macro. The DENSE_ELEM macro used in Jac1 * gives access to an element of a dense matrix of type DlsMat. * It should be used only when the problem size is small (the size * of a DlsMat is NEQ x NEQ) due to efficiency concerns. For * larger problem sizes, the macro DENSE_COL can be used in order * to work directly with a column of a DlsMat. The BAND_COL and * BAND_COL_ELEM allow efficient columnwise access to the elements * of a band matrix of type DlsMat. These macros are used in the * Jac2 function. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* use CVDENSE linear solver */ #include /* use CVBAND linear solver */ #include /* use CVDIAG linear solver */ #include /* serial N_Vector types, fct. and macros */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP*/ /* Shared Problem Constants */ #define ATOL RCONST(1.0e-6) #define RTOL RCONST(0.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define THIRTY RCONST(30.0) /* Problem #1 Constants */ #define P1_NEQ 2 #define P1_ETA RCONST(3.0) #define P1_NOUT 4 #define P1_T0 RCONST(0.0) #define P1_T1 RCONST(1.39283880203) #define P1_DTOUT RCONST(2.214773875) #define P1_TOL_FACTOR RCONST(1.0e4) /* Problem #2 Constants */ #define P2_MESHX 5 #define P2_MESHY 5 #define P2_NEQ P2_MESHX*P2_MESHY #define P2_ALPH1 RCONST(1.0) #define P2_ALPH2 RCONST(1.0) #define P2_NOUT 5 #define P2_ML 5 #define P2_MU 0 #define P2_T0 RCONST(0.0) #define P2_T1 RCONST(0.01) #define P2_TOUT_MULT RCONST(10.0) #define P2_TOL_FACTOR RCONST(1.0e3) /* Linear Solver Options */ enum {FUNC, DENSE_USER, DENSE_DQ, DIAG, BAND_USER, BAND_DQ}; /* Private Helper Functions */ static int Problem1(void); static void PrintIntro1(void); static void PrintHeader1(void); static void PrintOutput1(realtype t, realtype y0, realtype y1, int qu, realtype hu); static int Problem2(void); static void PrintIntro2(void); static void PrintHeader2(void); static void PrintOutput2(realtype t, realtype erm, int qu, realtype hu); static realtype MaxError(N_Vector y, realtype t); static int PrepareNextRun(void *cvode_mem, int lmm, int miter, long int mu, long int ml); static void PrintErrOutput(realtype tol_factor); static void PrintFinalStats(void *cvode_mem, int miter, realtype ero); static void PrintErrInfo(int nerr); /* Functions Called by the Solver */ static int f1(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac1(long int N, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int f2(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac2(long int N, long int mu, long int ml, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Implementation */ int main(void) { int nerr; nerr = Problem1(); nerr += Problem2(); PrintErrInfo(nerr); return(0); } static int Problem1(void) { realtype reltol=RTOL, abstol=ATOL, t, tout, ero, er; int miter, flag, temp_flag, iout, nerr=0; N_Vector y; void *cvode_mem; booleantype firstrun; int qu; realtype hu; y = NULL; cvode_mem = NULL; y = N_VNew_Serial(P1_NEQ); if(check_flag((void *)y, "N_VNew_Serial", 0)) return(1); PrintIntro1(); cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= DIAG; miter++) { ero = ZERO; NV_Ith_S(y,0) = TWO; NV_Ith_S(y,1) = ZERO; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f1, P1_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P1_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_ADAMS, miter, 0, 0); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader1(); for(iout=1, tout=P1_T1; iout <= P1_NOUT; iout++, tout += P1_DTOUT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput1(t, NV_Ith_S(y,0), NV_Ith_S(y,1), qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } if (iout%2 == 0) { er = ABS(NV_Ith_S(y,0)) / abstol; if (er > ero) ero = er; if (er > P1_TOL_FACTOR) { nerr++; PrintErrOutput(P1_TOL_FACTOR); } } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); cvode_mem = CVodeCreate(CV_BDF, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= DIAG; miter++) { ero = ZERO; NV_Ith_S(y,0) = TWO; NV_Ith_S(y,1) = ZERO; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f1, P1_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P1_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_BDF, miter, 0, 0); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader1(); for(iout=1, tout=P1_T1; iout <= P1_NOUT; iout++, tout += P1_DTOUT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput1(t, NV_Ith_S(y,0), NV_Ith_S(y,1), qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } if (iout%2 == 0) { er = ABS(NV_Ith_S(y,0)) / abstol; if (er > ero) ero = er; if (er > P1_TOL_FACTOR) { nerr++; PrintErrOutput(P1_TOL_FACTOR); } } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); N_VDestroy_Serial(y); return(nerr); } static void PrintIntro1(void) { printf("Demonstration program for CVODE package - direct linear solvers\n"); printf("\n\n"); printf("Problem 1: Van der Pol oscillator\n"); printf(" xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" neq = %d, reltol = %.2Lg, abstol = %.2Lg", P1_NEQ, RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" neq = %d, reltol = %.2lg, abstol = %.2lg", P1_NEQ, RTOL, ATOL); #else printf(" neq = %d, reltol = %.2g, abstol = %.2g", P1_NEQ, RTOL, ATOL); #endif } static void PrintHeader1(void) { printf("\n t x xdot qu hu \n"); return; } static void PrintOutput1(realtype t, realtype y0, realtype y1, int qu, realtype hu) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.5Lf %12.5Le %12.5Le %2d %6.4Le\n", t, y0, y1, qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.5f %12.5le %12.5le %2d %6.4le\n", t, y0, y1, qu, hu); #else printf("%10.5f %12.5e %12.5e %2d %6.4e\n", t, y0, y1, qu, hu); #endif return; } static int f1(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y0, y1; y0 = NV_Ith_S(y,0); y1 = NV_Ith_S(y,1); NV_Ith_S(ydot,0) = y1; NV_Ith_S(ydot,1) = (ONE - SQR(y0))* P1_ETA * y1 - y0; return(0); } static int Jac1(long int N, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y0, y1; y0 = NV_Ith_S(y,0); y1 = NV_Ith_S(y,1); DENSE_ELEM(J,0,1) = ONE; DENSE_ELEM(J,1,0) = -TWO * P1_ETA * y0 * y1 - ONE; DENSE_ELEM(J,1,1) = P1_ETA * (ONE - SQR(y0)); return(0); } static int Problem2(void) { realtype reltol=RTOL, abstol=ATOL, t, tout, er, erm, ero; int miter, flag, temp_flag, nerr=0; N_Vector y; void *cvode_mem; booleantype firstrun; int qu, iout; realtype hu; y = NULL; cvode_mem = NULL; y = N_VNew_Serial(P2_NEQ); if(check_flag((void *)y, "N_VNew_Serial", 0)) return(1); PrintIntro2(); cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= BAND_DQ; miter++) { if ((miter==DENSE_USER) || (miter==DENSE_DQ)) continue; ero = ZERO; N_VConst(ZERO, y); NV_Ith_S(y,0) = ONE; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f2, P2_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P2_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_ADAMS, miter, P2_MU, P2_ML); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader2(); for(iout=1, tout=P2_T1; iout <= P2_NOUT; iout++, tout*=P2_TOUT_MULT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); erm = MaxError(y, t); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput2(t, erm, qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } er = erm / abstol; if (er > ero) ero = er; if (er > P2_TOL_FACTOR) { nerr++; PrintErrOutput(P2_TOL_FACTOR); } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); cvode_mem = CVodeCreate(CV_BDF, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= BAND_DQ; miter++) { if ((miter==DENSE_USER) || (miter==DENSE_DQ)) continue; ero = ZERO; N_VConst(ZERO, y); NV_Ith_S(y,0) = ONE; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f2, P2_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P2_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_BDF, miter, P2_MU, P2_ML); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader2(); for(iout=1, tout=P2_T1; iout <= P2_NOUT; iout++, tout*=P2_TOUT_MULT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); erm = MaxError(y, t); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput2(t, erm, qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } er = erm / abstol; if (er > ero) ero = er; if (er > P2_TOL_FACTOR) { nerr++; PrintErrOutput(P2_TOL_FACTOR); } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); N_VDestroy_Serial(y); return(nerr); } static void PrintIntro2(void) { printf("\n\n-------------------------------------------------------------"); printf("\n-------------------------------------------------------------"); printf("\n\nProblem 2: ydot = A * y, where A is a banded lower\n"); printf("triangular matrix derived from 2-D advection PDE\n\n"); printf(" neq = %d, ml = %d, mu = %d\n", P2_NEQ, P2_ML, P2_MU); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" itol = %s, reltol = %.2Lg, abstol = %.2Lg", "CV_SS", RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" itol = %s, reltol = %.2lg, abstol = %.2lg", "CV_SS", RTOL, ATOL); #else printf(" itol = %s, reltol = %.2g, abstol = %.2g", "CV_SS", RTOL, ATOL); #endif printf("\n t max.err qu hu \n"); } static void PrintHeader2(void) { printf("\n t max.err qu hu \n"); return; } static void PrintOutput2(realtype t, realtype erm, int qu, realtype hu) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.3Lf %12.4Le %2d %12.4Le\n", t, erm, qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.3f %12.4le %2d %12.4le\n", t, erm, qu, hu); #else printf("%10.3f %12.4e %2d %12.4e\n", t, erm, qu, hu); #endif return; } static int f2(realtype t, N_Vector y, N_Vector ydot, void *user_data) { long int i, j, k; realtype d, *ydata, *dydata; ydata = NV_DATA_S(y); dydata = NV_DATA_S(ydot); /* Excluding boundaries, ydot = f = -2 y + alpha1 * y + alpha2 * y i,j i,j i,j i-1,j i,j-1 */ for (j=0; j < P2_MESHY; j++) { for (i=0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; d = -TWO*ydata[k]; if (i != 0) d += P2_ALPH1 * ydata[k-1]; if (j != 0) d += P2_ALPH2 * ydata[k-P2_MESHX]; dydata[k] = d; } } return(0); } static int Jac2(long int N, long int mu, long int ml, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol; /* The components of f(t,y) which depend on y are i,j f , f , and f : i,j i+1,j i,j+1 f = -2 y + alpha1 * y + alpha2 * y i,j i,j i-1,j i,j-1 f = -2 y + alpha1 * y + alpha2 * y i+1,j i+1,j i,j i+1,j-1 f = -2 y + alpha1 * y + alpha2 * y i,j+1 i,j+1 i-1,j+1 i,j */ for (j=0; j < P2_MESHY; j++) { for (i=0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; kthCol = BAND_COL(J,k); BAND_COL_ELEM(kthCol,k,k) = -TWO; if (i != P2_MESHX-1) BAND_COL_ELEM(kthCol,k+1,k) = P2_ALPH1; if (j != P2_MESHY-1) BAND_COL_ELEM(kthCol,k+P2_MESHX,k) = P2_ALPH2; } } return(0); } static realtype MaxError(N_Vector y, realtype t) { long int i, j, k; realtype *ydata, er, ex=ZERO, yt, maxError=ZERO, ifact_inv, jfact_inv=ONE; if (t == ZERO) return(ZERO); ydata = NV_DATA_S(y); if (t <= THIRTY) ex = EXP(-TWO*t); for (j = 0; j < P2_MESHY; j++) { ifact_inv = ONE; for (i = 0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; yt = RPowerI(t,i+j) * ex * ifact_inv * jfact_inv; er = ABS(ydata[k] - yt); if (er > maxError) maxError = er; ifact_inv /= (i+1); } jfact_inv /= (j+1); } return(maxError); } static int PrepareNextRun(void *cvode_mem, int lmm, int miter, long int mu, long int ml) { int flag = CV_SUCCESS; printf("\n\n-------------------------------------------------------------"); printf("\n\nLinear Multistep Method : "); if (lmm == CV_ADAMS) { printf("ADAMS\n"); } else { printf("BDF\n"); } printf("Iteration : "); if (miter == FUNC) { printf("FUNCTIONAL\n"); } else { printf("NEWTON\n"); printf("Linear Solver : "); switch(miter) { case DENSE_USER : printf("Dense, User-Supplied Jacobian\n"); flag = CVDense(cvode_mem, P1_NEQ); check_flag(&flag, "CVDense", 1); if(flag != CV_SUCCESS) break; flag = CVDlsSetDenseJacFn(cvode_mem, Jac1); check_flag(&flag, "CVDlsSetDenseJacFn", 1); break; case DENSE_DQ : printf("Dense, Difference Quotient Jacobian\n"); flag = CVDlsSetDenseJacFn(cvode_mem, NULL); check_flag(&flag, "CVDlsSetDenseJacFn", 1); break; case DIAG : printf("Diagonal Jacobian\n"); flag = CVDiag(cvode_mem); check_flag(&flag, "CVDiag", 1); break; case BAND_USER : printf("Band, User-Supplied Jacobian\n"); flag = CVBand(cvode_mem, P2_NEQ, mu, ml); check_flag(&flag, "CVBand", 1); if(flag != CV_SUCCESS) break; flag = CVDlsSetBandJacFn(cvode_mem, Jac2); check_flag(&flag, "CVDlsSetBandJacFn", 1); break; case BAND_DQ : printf("Band, Difference Quotient Jacobian\n"); flag = CVDlsSetBandJacFn(cvode_mem, NULL); check_flag(&flag, "CVDlsSetBandJacFn", 1); break; } } return(flag); } static void PrintErrOutput(realtype tol_factor) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("\n\n Error exceeds %Lg * tolerance \n\n", tol_factor); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("\n\n Error exceeds %lg * tolerance \n\n", tol_factor); #else printf("\n\n Error exceeds %g * tolerance \n\n", tol_factor); #endif return; } static void PrintFinalStats(void *cvode_mem, int miter, realtype ero) { long int lenrw, leniw, nst, nfe, nsetups, nni, ncfn, netf; long int lenrwLS, leniwLS, nje, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); printf("\n Final statistics for this run:\n\n"); printf(" CVode real workspace length = %4ld \n", lenrw); printf(" CVode integer workspace length = %4ld \n", leniw); printf(" Number of steps = %4ld \n", nst); printf(" Number of f-s = %4ld \n", nfe); printf(" Number of setups = %4ld \n", nsetups); printf(" Number of nonlinear iterations = %4ld \n", nni); printf(" Number of nonlinear convergence failures = %4ld \n", ncfn); printf(" Number of error test failures = %4ld \n\n",netf); if (miter != FUNC) { switch(miter) { case DENSE_USER : case DENSE_DQ : flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVDlsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDlsGetWorkSpace", 1); break; case BAND_USER : case BAND_DQ : flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVDlsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDlsGetWorkSpace", 1); break; case DIAG : nje = nsetups; flag = CVDiagGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDiagGetNumRhsEvals", 1); flag = CVDiagGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDiagGetWorkSpace", 1); break; } printf(" Linear solver real workspace length = %4ld \n", lenrwLS); printf(" Linear solver integer workspace length = %4ld \n", leniwLS); printf(" Number of Jacobian evaluations = %4ld \n", nje); printf(" Number of f evals. in linear solver = %4ld \n\n", nfeLS); } #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" Error overrun = %.3Lf \n", ero); #else printf(" Error overrun = %.3f \n", ero); #endif } static void PrintErrInfo(int nerr) { printf("\n\n-------------------------------------------------------------"); printf("\n-------------------------------------------------------------"); printf("\n\n Number of errors encountered = %d \n", nerr); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvRoberts_dns.c0000600000175000017500000002614411741421121023371 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the CVDENSE dense linear solver, and a * user-supplied Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts., consts. */ #include /* serial N_Vector types, fcts., macros */ #include /* prototype for CVDense */ #include /* definitions DlsMat DENSE_ELEM */ #include /* definition of type realtype */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype reltol, t, tout; N_Vector y, abstol; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = abstol = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. and abstol */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); abstol = N_VNew_Serial(NEQ); if (check_flag((void *)abstol, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Set the scalar relative tolerance */ reltol = RTOL; /* Set the vector absolute tolerance */ Ith(abstol,1) = ATOL1; Ith(abstol,2) = ATOL2; Ith(abstol,3) = ATOL3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSVtolerances to specify the scalar relative tolerance * and vector absolute tolerances */ flag = CVodeSVtolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSVtolerances", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVDense to specify the CVDENSE dense linear solver */ flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); if (check_flag(&flagr, "CVodeGetRootInfo", 1)) return(1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y and abstol vectors */ N_VDestroy_Serial(y); N_VDestroy_Serial(abstol); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvKrylovDemo_prec.out0000600000175000017500000006353411741421121024602 0ustar sylvestresylvestre Demonstration program for CVODE - CVSPGMR linear solver Food web problem with ns species, ns = 6 Predator-prey interaction and diffusion on a 2-D square Matrix parameters: a = 1 e = 1e+04 g = 5e-07 b parameter = 1 Diffusion coefficients: Dprey = 1 Dpred = 0.5 Rate parameter alpha = 1 Mesh dimensions (mx,my) are 6, 6. Total system size is neq = 216 Tolerances: itol = CV_SS, reltol = 1e-05, abstol = 1e-05 Preconditioning uses a product of: (1) Gauss-Seidel iterations with itmax = 5 iterations, and (2) interaction-only block-diagonal matrix with block-grouping Number of diagonal block groups = ngrp = 4 (ngx by ngy, ngx = 2, ngy = 2) ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_LEFT Gram-Schmidt method type is gstype = MODIFIED_GS c values at t = 0: Species 1 10 10 10 10 10 10 10 10.1678 10.3775 10.3775 10.1678 10 10 10.3775 10.8493 10.8493 10.3775 10 10 10.3775 10.8493 10.8493 10.3775 10 10 10.1678 10.3775 10.3775 10.1678 10 10 10 10 10 10 10 Species 2 10 10 10 10 10 10 10 10.3355 10.755 10.755 10.3355 10 10 10.755 11.6987 11.6987 10.755 10 10 10.755 11.6987 11.6987 10.755 10 10 10.3355 10.755 10.755 10.3355 10 10 10 10 10 10 10 Species 3 10 10 10 10 10 10 10 10.5033 11.1325 11.1325 10.5033 10 10 11.1325 12.548 12.548 11.1325 10 10 11.1325 12.548 12.548 11.1325 10 10 10.5033 11.1325 11.1325 10.5033 10 10 10 10 10 10 10 Species 4 10 10 10 10 10 10 10 10.6711 11.5099 11.5099 10.6711 10 10 11.5099 13.3974 13.3974 11.5099 10 10 11.5099 13.3974 13.3974 11.5099 10 10 10.6711 11.5099 11.5099 10.6711 10 10 10 10 10 10 10 Species 5 10 10 10 10 10 10 10 10.8389 11.8874 11.8874 10.8389 10 10 11.8874 14.2467 14.2467 11.8874 10 10 11.8874 14.2467 14.2467 11.8874 10 10 10.8389 11.8874 11.8874 10.8389 10 10 10 10 10 10 10 Species 6 10 10 10 10 10 10 10 11.0066 12.2649 12.2649 11.0066 10 10 12.2649 15.0961 15.0961 12.2649 10 10 12.2649 15.0961 15.0961 12.2649 10 10 11.0066 12.2649 12.2649 11.0066 10 10 10 10 10 10 10 t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 c values at t = 1e-06: Species 1 9.99991 9.99992 9.99993 9.99993 9.99993 9.99992 9.99992 10.1677 10.3774 10.3774 10.1677 9.99993 9.99993 10.3774 10.8492 10.8492 10.3774 9.99993 9.99993 10.3774 10.8492 10.8492 10.3774 9.99993 9.99992 10.1677 10.3774 10.3774 10.1677 9.99992 9.99991 9.99992 9.99993 9.99993 9.99992 9.99991 Species 2 9.99991 9.99993 9.99995 9.99995 9.99993 9.99992 9.99993 10.3355 10.7549 10.7549 10.3355 9.99993 9.99995 10.7549 11.6985 11.6985 10.7549 9.99995 9.99995 10.7549 11.6985 11.6985 10.7549 9.99995 9.99993 10.3355 10.7549 10.7549 10.3355 9.99993 9.99991 9.99993 9.99995 9.99995 9.99993 9.99991 Species 3 9.99991 9.99994 9.99997 9.99997 9.99994 9.99992 9.99994 10.5032 11.1323 11.1323 10.5032 9.99994 9.99997 11.1323 12.5478 12.5478 11.1323 9.99997 9.99997 11.1323 12.5478 12.5478 11.1323 9.99997 9.99994 10.5032 11.1323 11.1323 10.5032 9.99994 9.99991 9.99994 9.99997 9.99997 9.99994 9.99991 Species 4 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 14.5506 15.8932 15.8932 14.5506 13.499 13.499 15.8932 19.0308 19.0308 15.8932 13.499 13.499 15.8932 19.0308 19.0308 15.8932 13.499 13.499 14.5506 15.8932 15.8932 14.5506 13.499 13.499 13.499 13.499 13.499 13.499 13.499 Species 5 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 14.7794 16.4145 16.4145 14.7794 13.499 13.499 16.4145 20.2373 20.2373 16.4145 13.499 13.499 16.4145 20.2373 20.2373 16.4145 13.499 13.499 14.7794 16.4145 16.4145 14.7794 13.499 13.499 13.499 13.499 13.499 13.499 13.499 Species 6 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 15.0082 16.9357 16.9357 15.0082 13.499 13.499 16.9357 21.4437 21.4437 16.9357 13.499 13.499 16.9357 21.4437 21.4437 16.9357 13.499 13.499 15.0082 16.9357 16.9357 15.0082 13.499 13.499 13.499 13.499 13.499 13.499 13.499 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 116 nfe = 137 nni = 133 qu = 5 hu = 5.51e-06 t = 1.00e-03 nst = 135 nfe = 156 nni = 152 qu = 2 hu = 3.53e-04 c values at t = 0.001: Species 1 9.90702 9.91664 9.92836 9.93033 9.92253 9.91674 9.91472 10.0746 10.2769 10.2785 10.0795 9.92253 9.92446 10.2748 10.7181 10.7194 10.2785 9.93033 9.92445 10.2744 10.7173 10.7181 10.2769 9.92836 9.91469 10.0734 10.2744 10.2748 10.0746 9.91664 9.90697 9.91469 9.92445 9.92446 9.91472 9.90702 Species 2 9.90741 9.92474 9.94623 9.9482 9.93064 9.91713 9.92282 10.2412 10.644 10.6457 10.2461 9.93064 9.94232 10.6419 11.5267 11.5281 10.6457 9.9482 9.94231 10.6415 11.5258 11.5267 10.644 9.94623 9.92279 10.24 10.6415 10.6419 10.2412 9.92474 9.90737 9.92279 9.94231 9.94232 9.92282 9.90741 Species 3 9.90781 9.93284 9.96408 9.96606 9.93874 9.91752 9.93092 10.4078 11.0109 11.0127 10.4127 9.93874 9.96017 11.0088 12.3339 12.3354 11.0127 9.96606 9.96016 11.0083 12.3329 12.3339 11.0109 9.96408 9.93089 10.4065 11.0083 11.0088 10.4078 9.93284 9.90776 9.93089 9.96016 9.96017 9.93092 9.90781 Species 4 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 Species 5 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 Species 6 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 t = 1.00e-02 nst = 143 nfe = 166 nni = 162 qu = 3 hu = 1.37e-03 t = 1.00e-01 nst = 165 nfe = 191 nni = 187 qu = 5 hu = 6.02e-03 t = 1.00e+00 nst = 235 nfe = 265 nni = 261 qu = 4 hu = 2.49e-02 c values at t = 1: Species 1 1.58853 1.59926 1.62153 1.64766 1.67038 1.68151 1.58535 1.59505 1.61549 1.63954 1.66035 1.67038 1.57758 1.58549 1.60241 1.62237 1.63954 1.64766 1.56822 1.57414 1.58708 1.60241 1.61549 1.62153 1.5605 1.56465 1.57414 1.58549 1.59505 1.59926 1.55734 1.5605 1.56822 1.57758 1.58535 1.58853 Species 2 1.59068 1.60143 1.62373 1.64989 1.67263 1.68377 1.5875 1.59721 1.61768 1.64175 1.66259 1.67263 1.57973 1.58764 1.60458 1.62456 1.64175 1.64989 1.57036 1.57628 1.58923 1.60458 1.61768 1.62373 1.56263 1.56678 1.57628 1.58764 1.59721 1.60143 1.55947 1.56263 1.57036 1.57973 1.5875 1.59068 Species 3 1.59272 1.60347 1.6258 1.65199 1.67476 1.68591 1.58953 1.59926 1.61975 1.64384 1.6647 1.67476 1.58175 1.58968 1.60664 1.62664 1.64384 1.65199 1.57237 1.5783 1.59127 1.60664 1.61975 1.6258 1.56464 1.56879 1.5783 1.58968 1.59926 1.60347 1.56147 1.56464 1.57237 1.58175 1.58953 1.59272 Species 4 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 Species 5 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 Species 6 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 t = 2.00e+00 nst = 272 nfe = 305 nni = 301 qu = 3 hu = 3.81e-02 t = 3.00e+00 nst = 288 nfe = 322 nni = 318 qu = 3 hu = 6.58e-02 t = 4.00e+00 nst = 303 nfe = 338 nni = 334 qu = 3 hu = 6.58e-02 c values at t = 4: Species 1 1.19535 1.20368 1.2211 1.24158 1.25935 1.268 1.19281 1.20035 1.21636 1.23523 1.25154 1.25935 1.18657 1.19274 1.20603 1.22174 1.23523 1.24158 1.17905 1.18368 1.1939 1.20603 1.21636 1.2211 1.17285 1.17613 1.18368 1.19274 1.20035 1.20368 1.17033 1.17285 1.17905 1.18657 1.19281 1.19535 Species 2 1.19539 1.20372 1.22113 1.24161 1.25939 1.26804 1.19284 1.20039 1.2164 1.23527 1.25158 1.25939 1.18661 1.19277 1.20606 1.22177 1.23527 1.24161 1.17908 1.18372 1.19393 1.20606 1.2164 1.22113 1.17288 1.17616 1.18372 1.19277 1.20039 1.20372 1.17036 1.17288 1.17908 1.18661 1.19284 1.19539 Species 3 1.19542 1.20375 1.22117 1.24164 1.25942 1.26807 1.19287 1.20042 1.21643 1.2353 1.25161 1.25942 1.18664 1.1928 1.20609 1.2218 1.2353 1.24164 1.17911 1.18375 1.19396 1.20609 1.21643 1.22117 1.17291 1.17619 1.18375 1.1928 1.20042 1.20375 1.17039 1.17291 1.17911 1.18664 1.19287 1.19542 Species 4 35860.6 36110.4 36632.5 37246.5 37779.6 38038.7 35784.4 36010.4 36490.5 37056.4 37545.4 37779.6 35597.3 35782.1 36180.7 36651.7 37056.4 37246.5 35371.5 35510.5 35816.7 36180.7 36490.5 36632.5 35185.6 35283.8 35510.5 35782.1 36010.4 36110.4 35109.8 35185.6 35371.5 35597.3 35784.4 35860.6 Species 5 35860.7 36110.3 36632.5 37246.5 37779.6 38038.7 35784.4 36010.5 36490.5 37056.5 37545.4 37779.6 35597.3 35782.1 36180.7 36651.7 37056.5 37246.5 35371.5 35510.5 35816.7 36180.7 36490.5 36632.5 35185.6 35283.8 35510.5 35782.1 36010.5 36110.3 35109.8 35185.6 35371.5 35597.3 35784.4 35860.7 Species 6 35860.7 36110.3 36632.6 37246.5 37779.6 38038.7 35784.3 36010.5 36490.5 37056.5 37545.4 37779.6 35597.4 35782.1 36180.7 36651.6 37056.5 37246.5 35371.4 35510.5 35816.7 36180.7 36490.5 36632.6 35185.6 35283.8 35510.5 35782.1 36010.5 36110.3 35109.8 35185.6 35371.4 35597.4 35784.3 35860.7 t = 5.00e+00 nst = 316 nfe = 351 nni = 347 qu = 3 hu = 1.10e-01 t = 6.00e+00 nst = 325 nfe = 361 nni = 357 qu = 3 hu = 1.10e-01 t = 7.00e+00 nst = 334 nfe = 371 nni = 367 qu = 3 hu = 1.10e-01 c values at t = 7: Species 1 1.18854 1.19682 1.21415 1.23453 1.25221 1.26082 1.186 1.19351 1.20944 1.22822 1.24444 1.25221 1.1798 1.18593 1.19916 1.21479 1.22822 1.23453 1.17231 1.17692 1.18708 1.19916 1.20944 1.21415 1.16614 1.1694 1.17692 1.18593 1.19351 1.19682 1.16363 1.16614 1.17231 1.1798 1.186 1.18854 Species 2 1.18854 1.19683 1.21415 1.23453 1.25222 1.26082 1.186 1.19351 1.20944 1.22822 1.24444 1.25222 1.1798 1.18594 1.19916 1.21479 1.22822 1.23453 1.17231 1.17692 1.18709 1.19916 1.20944 1.21415 1.16614 1.1694 1.17692 1.18594 1.19351 1.19683 1.16363 1.16614 1.17231 1.1798 1.186 1.18854 Species 3 1.18854 1.19683 1.21416 1.23453 1.25222 1.26082 1.18601 1.19351 1.20944 1.22822 1.24444 1.25222 1.1798 1.18594 1.19916 1.21479 1.22822 1.23453 1.17231 1.17692 1.18709 1.19916 1.20944 1.21416 1.16614 1.1694 1.17692 1.18594 1.19351 1.19683 1.16363 1.16614 1.17231 1.1798 1.18601 1.18854 Species 4 35655.3 35903.6 36423.2 37034.1 37564.4 37822.3 35579.3 35804.2 36281.9 36844.9 37331.5 37564.4 35393.1 35577 35973.5 36442.3 36844.9 37034.1 35168.4 35306.6 35611.4 35973.5 36281.9 36423.2 34983.3 35081.2 35306.6 35577 35804.2 35903.6 34907.9 34983.3 35168.4 35393.1 35579.3 35655.3 Species 5 35655.3 35903.6 36423.2 37034.1 37564.4 37822.3 35579.3 35804.3 36281.9 36844.9 37331.5 37564.4 35393.1 35577 35973.5 36442.2 36844.9 37034.1 35168.4 35306.7 35611.4 35973.5 36281.9 36423.2 34983.3 35081.1 35306.7 35577 35804.3 35903.6 34907.9 34983.3 35168.4 35393.1 35579.3 35655.3 Species 6 35655.4 35903.6 36423.2 37034.1 37564.5 37822.3 35579.2 35804.3 36281.9 36845 37331.5 37564.5 35393.2 35576.9 35973.5 36442.2 36845 37034.1 35168.3 35306.7 35611.4 35973.5 36281.9 36423.2 34983.3 35081.1 35306.7 35576.9 35804.3 35903.6 34907.9 34983.3 35168.3 35393.2 35579.2 35655.4 t = 8.00e+00 nst = 342 nfe = 381 nni = 377 qu = 2 hu = 3.67e-01 t = 9.00e+00 nst = 344 nfe = 383 nni = 379 qu = 2 hu = 3.67e-01 t = 1.00e+01 nst = 346 nfe = 385 nni = 381 qu = 2 hu = 5.82e-01 c values at t = 10: Species 1 1.18838 1.19667 1.21399 1.23436 1.25205 1.26065 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23436 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 2 1.18838 1.19667 1.21399 1.23436 1.25205 1.26065 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23436 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 3 1.18838 1.19667 1.21399 1.23436 1.25205 1.26065 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23436 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 4 35651.1 35898.4 36418.5 37029 37559.3 37817.3 35574.1 35799.8 36276.8 36840.1 37326.6 37559.3 35388.6 35571.9 35968.9 36437.2 36840.1 37029 35163.6 35302 35606.4 35968.9 36276.8 36418.5 34978.4 35076.6 35302 35571.9 35799.8 35898.4 34903.2 34978.4 35163.6 35388.6 35574.1 35651.1 Species 5 35650.8 35898.7 36418.2 37029.3 37559 37817.7 35574.5 35799.4 36277.2 36839.8 37326.9 37559 35388.3 35572.3 35968.6 36437.6 36839.8 37029.3 35163.9 35301.7 35606.8 35968.6 36277.2 36418.2 34978 35077 35301.7 35572.3 35799.4 35898.7 34903.6 34978 35163.9 35388.3 35574.5 35650.8 Species 6 35650.4 35899 36417.9 37029.6 37558.7 37818 35574.8 35799.1 36277.5 36839.5 37327.3 37558.7 35388 35572.6 35968.2 36437.9 36839.5 37029.6 35164.2 35301.3 35607.1 35968.2 36277.5 36417.9 34977.7 35077.3 35301.3 35572.6 35799.1 35899 34903.9 34977.7 35164.2 35388 35574.8 35650.4 Final statistics for this run: CVode real workspace length = 2249 CVode integer workspace length = 50 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 346 Number of f-s = 385 Number of f-s (SPGMR) = 550 Number of f-s (TOTAL) = 935 Number of setups = 46 Number of nonlinear iterations = 381 Number of linear iterations = 550 Number of preconditioner evaluations = 46 Number of preconditioner solves = 915 Number of error test failures = 1 Number of nonlinear conv. failures = 0 Number of linear convergence failures = 0 Average Krylov subspace dimension = 1.444 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_LEFT Gram-Schmidt method type is gstype = CLASSICAL_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 116 nfe = 137 nni = 133 qu = 5 hu = 5.51e-06 t = 1.00e-03 nst = 135 nfe = 156 nni = 152 qu = 2 hu = 3.53e-04 t = 1.00e-02 nst = 143 nfe = 166 nni = 162 qu = 3 hu = 1.37e-03 t = 1.00e-01 nst = 165 nfe = 191 nni = 187 qu = 5 hu = 6.02e-03 t = 1.00e+00 nst = 235 nfe = 265 nni = 261 qu = 4 hu = 2.49e-02 t = 2.00e+00 nst = 272 nfe = 305 nni = 301 qu = 3 hu = 3.80e-02 t = 3.00e+00 nst = 288 nfe = 322 nni = 318 qu = 3 hu = 6.59e-02 t = 4.00e+00 nst = 303 nfe = 337 nni = 333 qu = 3 hu = 6.59e-02 t = 5.00e+00 nst = 313 nfe = 349 nni = 345 qu = 3 hu = 1.26e-01 t = 6.00e+00 nst = 321 nfe = 357 nni = 353 qu = 3 hu = 1.26e-01 t = 7.00e+00 nst = 329 nfe = 366 nni = 362 qu = 3 hu = 1.26e-01 t = 8.00e+00 nst = 337 nfe = 374 nni = 370 qu = 3 hu = 1.26e-01 t = 9.00e+00 nst = 345 nfe = 382 nni = 378 qu = 3 hu = 1.26e-01 t = 1.00e+01 nst = 353 nfe = 391 nni = 387 qu = 3 hu = 1.26e-01 Final statistics for this run: CVode real workspace length = 2249 CVode integer workspace length = 50 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 353 Number of f-s = 391 Number of f-s (SPGMR) = 581 Number of f-s (TOTAL) = 972 Number of setups = 43 Number of nonlinear iterations = 387 Number of linear iterations = 581 Number of preconditioner evaluations = 43 Number of preconditioner solves = 952 Number of error test failures = 1 Number of nonlinear conv. failures = 0 Number of linear convergence failures = 0 Average Krylov subspace dimension = 1.501 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_RIGHT Gram-Schmidt method type is gstype = MODIFIED_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 118 nfe = 138 nni = 134 qu = 5 hu = 6.64e-06 t = 1.00e-03 nst = 138 nfe = 163 nni = 159 qu = 2 hu = 4.17e-04 t = 1.00e-02 nst = 146 nfe = 174 nni = 170 qu = 3 hu = 1.64e-03 t = 1.00e-01 nst = 169 nfe = 200 nni = 196 qu = 5 hu = 9.35e-03 t = 1.00e+00 nst = 207 nfe = 247 nni = 243 qu = 5 hu = 5.17e-02 t = 2.00e+00 nst = 220 nfe = 262 nni = 258 qu = 5 hu = 7.91e-02 t = 3.00e+00 nst = 228 nfe = 271 nni = 267 qu = 5 hu = 1.32e-01 t = 4.00e+00 nst = 235 nfe = 278 nni = 274 qu = 5 hu = 1.32e-01 t = 5.00e+00 nst = 240 nfe = 284 nni = 280 qu = 4 hu = 2.06e-01 t = 6.00e+00 nst = 246 nfe = 294 nni = 290 qu = 4 hu = 8.61e-02 t = 7.00e+00 nst = 254 nfe = 306 nni = 302 qu = 2 hu = 2.67e-01 t = 8.00e+00 nst = 257 nfe = 310 nni = 306 qu = 3 hu = 4.13e-01 t = 9.00e+00 nst = 260 nfe = 315 nni = 311 qu = 3 hu = 4.61e-01 t = 1.00e+01 nst = 262 nfe = 321 nni = 317 qu = 3 hu = 2.25e-01 Final statistics for this run: CVode real workspace length = 2249 CVode integer workspace length = 50 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 262 Number of f-s = 321 Number of f-s (SPGMR) = 637 Number of f-s (TOTAL) = 958 Number of setups = 55 Number of nonlinear iterations = 317 Number of linear iterations = 637 Number of preconditioner evaluations = 55 Number of preconditioner solves = 918 Number of error test failures = 3 Number of nonlinear conv. failures = 4 Number of linear convergence failures = 48 Average Krylov subspace dimension = 2.009 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_RIGHT Gram-Schmidt method type is gstype = CLASSICAL_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 118 nfe = 138 nni = 134 qu = 5 hu = 6.64e-06 t = 1.00e-03 nst = 138 nfe = 163 nni = 159 qu = 2 hu = 4.17e-04 t = 1.00e-02 nst = 146 nfe = 174 nni = 170 qu = 3 hu = 1.64e-03 t = 1.00e-01 nst = 169 nfe = 200 nni = 196 qu = 5 hu = 9.35e-03 t = 1.00e+00 nst = 207 nfe = 247 nni = 243 qu = 5 hu = 5.18e-02 t = 2.00e+00 nst = 219 nfe = 263 nni = 259 qu = 5 hu = 1.23e-01 t = 3.00e+00 nst = 227 nfe = 271 nni = 267 qu = 5 hu = 1.23e-01 t = 4.00e+00 nst = 234 nfe = 279 nni = 275 qu = 5 hu = 1.90e-01 t = 5.00e+00 nst = 239 nfe = 284 nni = 280 qu = 5 hu = 1.90e-01 t = 6.00e+00 nst = 244 nfe = 289 nni = 285 qu = 5 hu = 1.90e-01 t = 7.00e+00 nst = 259 nfe = 311 nni = 307 qu = 4 hu = 1.53e-01 t = 8.00e+00 nst = 265 nfe = 319 nni = 315 qu = 3 hu = 2.48e-01 t = 9.00e+00 nst = 268 nfe = 322 nni = 318 qu = 3 hu = 3.76e-01 t = 1.00e+01 nst = 270 nfe = 324 nni = 320 qu = 2 hu = 5.81e-01 Final statistics for this run: CVode real workspace length = 2249 CVode integer workspace length = 50 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 270 Number of f-s = 324 Number of f-s (SPGMR) = 626 Number of f-s (TOTAL) = 950 Number of setups = 50 Number of nonlinear iterations = 320 Number of linear iterations = 626 Number of preconditioner evaluations = 50 Number of preconditioner solves = 908 Number of error test failures = 3 Number of nonlinear conv. failures = 2 Number of linear convergence failures = 43 Average Krylov subspace dimension = 1.956 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- sundials-2.5.0/examples/cvode/serial/cvRoberts_dns_uw.c0000600000175000017500000002641011741421121024100 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the CVDENSE dense linear solver, and a * user-supplied Jacobian routine. * It uses a user-supplied function to compute the error weights * required for the WRMS norm calculations. * Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used here */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVDense */ #include /* serial N_Vector types, functions, and macros */ #include /* definitions DlsMat and DENSE_ELEM */ #include /* definition of type realtype */ #include /* definition of ABS */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int ewt(N_Vector y, N_Vector w, void *user_data); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype t, tout; N_Vector y; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Use private function to compute error weights */ flag = CVodeWFtolerances(cvode_mem, ewt); if (check_flag(&flag, "CVodeSetEwtFn", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVDense to specify the CVDENSE dense linear solver */ flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); check_flag(&flagr, "CVodeGetRootInfo", 1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y vector */ N_VDestroy_Serial(y); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; return(0); } /* * EwtSet function. Computes the error weights at the current solution. */ static int ewt(N_Vector y, N_Vector w, void *user_data) { int i; realtype yy, ww, rtol, atol[3]; rtol = RTOL; atol[0] = ATOL1; atol[1] = ATOL2; atol[2] = ATOL3; for (i=1; i<=3; i++) { yy = Ith(y,i); ww = rtol * ABS(yy) + atol[i-1]; if (ww <= 0.0) return (-1); Ith(w,i) = 1.0/ww; } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvAdvDiff_bnd.c0000600000175000017500000003240711741421121023232 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem with a banded Jacobian, * with the program for its solution by CVODE. * The problem is the semi-discrete form of the advection-diffusion * equation in 2-D: * du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 * on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time * interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions * are posed, and the initial condition is * u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). * The PDE is discretized on a uniform MX+2 by MY+2 grid with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX*MY. * This program solves the problem with the BDF method, Newton * iteration with the CVBAND band linear solver, and a user-supplied * Jacobian routine. * It uses scalar relative and absolute tolerances. * Output is printed at t = .1, .2, ..., 1. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include #include #include /* Header files with a description of contents used in cvbanx.c */ #include /* prototypes for CVODE fcts., consts. */ #include /* prototype for CVBand */ #include /* serial N_Vector types, fcts., macros */ #include /* definitions of type DlsMat and macros */ #include /* definition of type realtype */ #include /* definition of ABS and EXP */ /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundaries */ #define YMAX RCONST(1.0) #define MX 10 /* mesh dimensions */ #define MY 5 #define NEQ MX*MY /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.1) /* first output time */ #define DTOUT RCONST(0.1) /* output time increment */ #define NOUT 10 /* number of output times */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FIVE RCONST(5.0) /* User-defined vector access macro IJth */ /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= MX, 1 <= j <= MY. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*MY]) /* Type : UserData (contains grid constants) */ typedef struct { realtype dx, dy, hdcoef, hacoef, vdcoef; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, UserData data); static void PrintHeader(realtype reltol, realtype abstol, realtype umax); static void PrintOutput(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype dx, dy, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag; long int nst; u = NULL; data = NULL; cvode_mem = NULL; /* Create a serial vector */ u = N_VNew_Serial(NEQ); /* Allocate u vector */ if(check_flag((void*)u, "N_VNew_Serial", 0)) return(1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2)) return(1); dx = data->dx = XMAX/(MX+1); /* Set grid coefficients in data */ dy = data->dy = YMAX/(MY+1); data->hdcoef = ONE/(dx*dx); data->hacoef = HALF/(TWO*dx); data->vdcoef = ONE/(dy*dy); SetIC(u, data); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerance */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVBand to specify the CVBAND band linear solver */ flag = CVBand(cvode_mem, NEQ, MY, MY); if(check_flag(&flag, "CVBand", 1)) return(1); /* Set the user-supplied Jacobian routine Jac */ flag = CVDlsSetBandJacFn(cvode_mem, Jac); if(check_flag(&flag, "CVDlsSetBandJacFn", 1)) return(1); /* In loop over output points: call CVode, print results, test for errors */ umax = N_VMaxNorm(u); PrintHeader(reltol, abstol, umax); for(iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); PrintOutput(t, umax, nst); } PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Serial(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free the user data */ return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u,N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); } /* Jacobian routine. Compute J(t,u). */ static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* The components of f = udot that depend on u(i,j) are f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*EXP(FIVE*x*y); } } } /* Print first lines of output (problem description) */ static void PrintHeader(realtype reltol, realtype abstol, realtype umax) { printf("\n2-D Advection-Diffusion Equation\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Total system size = %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: reltol = %Lg abstol = %Lg\n\n", reltol, abstol); printf("At t = %Lg max.norm(u) =%14.6Le \n", T0, umax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: reltol = %lg abstol = %lg\n\n", reltol, abstol); printf("At t = %lg max.norm(u) =%14.6le \n", T0, umax); #else printf("Tolerance parameters: reltol = %g abstol = %g\n\n", reltol, abstol); printf("At t = %g max.norm(u) =%14.6e \n", T0, umax); #endif return; } /* Print current value */ static void PrintOutput(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst = %4ld\n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst = %4ld\n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst = %4ld\n", t, umax, nst); #endif return; } /* Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { int flag; long int nst, nfe, nsetups, netf, nni, ncfn, nje, nfeLS; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvKrylovDemo_ls.c0000600000175000017500000005740111741421121023676 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * * This example loops through the available iterative linear solvers: * SPGMR, SPBCG and SPTFQMR. * * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODE, with the BDF/GMRES, * BDF/Bi-CGStab, and BDF/TFQMR methods (i.e. using the CVSPGMR, * CVSPBCG and CVSPTFQMR linear solvers) and the block-diagonal * part of the Newton matrix as a left preconditioner. A copy of * the block-diagonal part of the Jacobian is saved and * conditionally reused within the Precond routine. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* prototypes & constants for CVSPBCG solver */ #include /* prototypes & constants for CVSPTFQMR solver */ #include /* serial N_Vector types, fct. and macros */ #include /* use generic DENSE solver in preconditioning */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* Linear Solver Loop Constants */ #define USE_SPGMR 0 #define USE_SPBCG 1 #define USE_SPTFQMR 2 /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY], **Jbd[MX][MY]; long int *pivot[MX][MY]; realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem, int linsolver); static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int linsolver, iout, flag; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = AllocUserData(); if(check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol=ATOL; reltol=RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ for (linsolver = 0; linsolver < 3; ++linsolver) { if (linsolver != 0) { /* Re-initialize user data */ InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); /* Re-initialize CVode for the solution of the same problem, but using a different linear solver module */ flag = CVodeReInit(cvode_mem, T0, u); if (check_flag(&flag, "CVodeReInit", 1)) return(1); } /* Attach a linear solver module */ switch(linsolver) { /* (a) SPGMR */ case(USE_SPGMR): /* Print header */ printf(" -------"); printf(" \n| SPGMR |\n"); printf(" -------\n"); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* Set modified Gram-Schmidt orthogonalization, preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetGSType(cvode_mem, MODIFIED_GS); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); break; /* (b) SPBCG */ case(USE_SPBCG): /* Print header */ printf(" -------"); printf(" \n| SPBCG |\n"); printf(" -------\n"); /* Call CVSpbcg to specify the linear solver CVSPBCG with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpbcg(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpbcg", 1)) return(1); break; /* (c) SPTFQMR */ case(USE_SPTFQMR): /* Print header */ printf(" ---------"); printf(" \n| SPTFQMR |\n"); printf(" ---------\n"); /* Call CVSptfqmr to specify the linear solver CVSPTFQMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSptfqmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSptfqmr", 1)) return(1); break; } /* Set preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* In loop over output points, call CVode, print results, test for error */ printf(" \n2-species diurnal advection-diffusion problem\n\n"); for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); PrintOutput(cvode_mem, u, t); if(check_flag(&flag, "CVode", 1)) break; } PrintFinalStats(cvode_mem, linsolver); } /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ /* Free memory */ N_VDestroy_Serial(u); FreeUserData(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Allocate memory for data structure of type UserData */ static UserData AllocUserData(void) { int jx, jy; UserData data; data = (UserData) malloc(sizeof *data); for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { (data->P)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->Jbd)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } return(data); } /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyMat((data->Jbd)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy=0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx=0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u, realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem, int linsolver) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwLS = %5ld leniwLS = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfeLS = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); if (linsolver < 2) printf("======================================================================\n\n"); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute RHS function f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int jx, jy, idn, iup, ileft, iright; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MY], **(*Jbd)[MY]; long int *(*pivot)[MY], ier; int jx, jy; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, and of pointer to u's data */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jy=0; jy < MY; jy++) { ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + TWO*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); j = Jbd[jx][jy]; a = P[jx][jy]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NUM_SPECIES, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseScale(-gamma, P[jx][jy], NUM_SPECIES, NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { denseAddIdentity(P[jx][jy], NUM_SPECIES); ier =denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MY]; long int *(*pivot)[MY]; int jx, jy; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data. */ data = (UserData) user_data; P = data->P; pivot = data->pivot; zdata = NV_DATA_S(z); N_VScale(ONE, r, z); /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { v = &(IJKth(zdata, 1, jx, jy)); denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v); } } return(0); } sundials-2.5.0/examples/cvode/serial/cvDiurnal_kry.c0000600000175000017500000006227511741421121023375 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODE, with the BDF/GMRES * method (i.e. using the CVSPGMR linear solver) and the * block-diagonal part of the Newton matrix as a left * preconditioner. A copy of the block-diagonal part of the * Jacobian is saved and conditionally reused within the Precond * routine. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR */ #include /* serial N_Vector types, fct., macros */ #include /* use generic dense solver in precond. */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY], **Jbd[MX][MY]; long int *pivot[MX][MY]; realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int jtv(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = AllocUserData(); if(check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol=ATOL; reltol=RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR * with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* set the JAcobian-times-vector function */ flag = CVSpilsSetJacTimesVecFn(cvode_mem, jtv); if(check_flag(&flag, "CVSpilsSetJacTimesVecFn", 1)) return(1); /* Set modified Gram-Schmidt orthogonalization */ flag = CVSpilsSetGSType(cvode_mem, MODIFIED_GS); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); /* Set the preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* In loop over output points, call CVode, print results, test for error */ printf(" \n2-species diurnal advection-diffusion problem\n\n"); for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); PrintOutput(cvode_mem, u, t); if(check_flag(&flag, "CVode", 1)) break; } PrintFinalStats(cvode_mem); /* Free memory */ N_VDestroy_Serial(u); FreeUserData(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Allocate memory for data structure of type UserData */ static UserData AllocUserData(void) { int jx, jy; UserData data; data = (UserData) malloc(sizeof *data); for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { (data->P)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->Jbd)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } return(data); } /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyMat((data->Jbd)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy=0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx=0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u, realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwLS = %5ld leniwLS = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfeLS = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute RHS function f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int jx, jy, idn, iup, ileft, iright; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Jacobian-times-vector routine. */ static int jtv(N_Vector v, N_Vector Jv, realtype t, N_Vector u, N_Vector fu, void *user_data, N_Vector tmp) { realtype c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt, c1rt, c2rt; realtype v1, v2, v1dn, v2dn, v1up, v2up, v1lt, v2lt, v1rt, v2rt; realtype Jv1, Jv2; realtype cydn, cyup; realtype s, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int jx, jy, idn, iup, ileft, iright; realtype *udata, *vdata, *Jvdata; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); vdata = NV_DATA_S(v); Jvdata = NV_DATA_S(Jv); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { data->q4 = EXP(-A4/s); } else { data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { Jv1 = ZERO; Jv2 = ZERO; /* Extract c1 and c2 at the current location and at neighbors */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); v1 = IJKth(vdata,1,jx,jy); v2 = IJKth(vdata,2,jx,jy); c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); v1dn = IJKth(vdata,1,jx,jy+idn); v2dn = IJKth(vdata,2,jx,jy+idn); v1up = IJKth(vdata,1,jx,jy+iup); v2up = IJKth(vdata,2,jx,jy+iup); ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); v1lt = IJKth(vdata,1,jx+ileft,jy); v2lt = IJKth(vdata,2,jx+ileft,jy); v1rt = IJKth(vdata,1,jx+iright,jy); v2rt = IJKth(vdata,2,jx+iright,jy); /* Set kinetic rate terms. */ //rkin1 = -Q1*C3 * c1 - Q2 * c1*c2 + q4coef * c2 + TWO*C3*q3; //rkin2 = Q1*C3 * c1 - Q2 * c1*c2 - q4coef * c2; Jv1 += -(Q1*C3 + Q2*c2) * v1 + (q4coef - Q2*c1) * v2; Jv2 += (Q1*C3 - Q2*c2) * v1 - (q4coef + Q2*c1) * v2; /* Set vertical diffusion terms. */ //vertd1 = -(cyup+cydn) * c1 + cyup * c1up + cydn * c1dn; //vertd2 = -(cyup+cydn) * c2 + cyup * c2up + cydn * c2dn; Jv1 += -(cyup+cydn) * v1 + cyup * v1up + cydn * v1dn; Jv2 += -(cyup+cydn) * v2 + cyup * v2up + cydn * v2dn; /* Set horizontal diffusion and advection terms. */ //hord1 = hordco*(c1rt - TWO*c1 + c1lt); //hord2 = hordco*(c2rt - TWO*c2 + c2lt); Jv1 += hordco*(v1rt - TWO*v1 + v1lt); Jv2 += hordco*(v2rt - TWO*v2 + v2lt); //horad1 = horaco*(c1rt - c1lt); //horad2 = horaco*(c2rt - c2lt); Jv1 += horaco*(v1rt - v1lt); Jv2 += horaco*(v2rt - v2lt); /* Load two components of J*v */ //IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; //IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; IJKth(Jvdata, 1, jx, jy) = Jv1; IJKth(Jvdata, 2, jx, jy) = Jv2; } } return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MY], **(*Jbd)[MY]; long int *(*pivot)[MY], ier; int jx, jy; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, and of pointer to u's data */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jy=0; jy < MY; jy++) { ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + TWO*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); j = Jbd[jx][jy]; a = P[jx][jy]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NUM_SPECIES, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseScale(-gamma, P[jx][jy], NUM_SPECIES, NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { denseAddIdentity(P[jx][jy], NUM_SPECIES); ier = denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MY]; long int *(*pivot)[MY]; int jx, jy; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data. */ data = (UserData) user_data; P = data->P; pivot = data->pivot; zdata = NV_DATA_S(z); N_VScale(ONE, r, z); /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { v = &(IJKth(zdata, 1, jx, jy)); denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v); } } return(0); } sundials-2.5.0/examples/cvode/serial/cvRoberts_dnsL.c0000600000175000017500000002577711741421121023520 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the LAPACK dense linear solver, and a * user-supplied Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVLapackDense */ #include /* serial N_Vector types, fcts., and macros */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ #define ZERO RCONST(0.0) /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype reltol, t, tout; N_Vector y, abstol; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = abstol = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. and abstol */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); abstol = N_VNew_Serial(NEQ); if (check_flag((void *)abstol, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Set the scalar relative tolerance */ reltol = RTOL; /* Set the vector absolute tolerance */ Ith(abstol,1) = ATOL1; Ith(abstol,2) = ATOL2; Ith(abstol,3) = ATOL3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSVtolerances to specify the scalar relative tolerance * and vector absolute tolerances */ flag = CVodeSVtolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSVtolerances", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVLapackDense to specify the LAPACK dense linear solver */ flag = CVLapackDense(cvode_mem, NEQ); if (check_flag(&flag, "CVLapackDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. * Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); if (check_flag(&flagr, "CVodeGetRootInfo", 1)) return(1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y vector */ N_VDestroy_Serial(y); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,1) = ZERO; IJth(J,3,2) = RCONST(6.0e7)*y2; IJth(J,3,3) = ZERO; return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvKrylovDemo_prec.c0000600000175000017500000011000011741421121024172 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:51:32 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * -------------------------------------------------------------------- * Demonstration program for CVODE - Krylov linear solver. * ODE system from ns-species interaction PDE in 2 dimensions. * * This program solves a stiff ODE system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) * * and the PDEs are as follows: * * i i i * dc /dt = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c *(b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2*np, with the first np being prey * and the last np being predators. The coefficients a(i,j), b(i), * d(i) are: * * a(i,i) = -a (all i) * a(i,j) = -g (i <= np, j > np) * a(i,j) = e (i > np, j <= np) * b(i) = b*(1 + alpha*x*y) (i <= np) * b(i) = -b*(1 + alpha*x*y) (i > np) * d(i) = Dprey (i <= np) * d(i) = Dpred (i > np) * * The spatial domain is the unit square. The final time is 10. * The boundary conditions are: normal derivative = 0. * A polynomial in x and y is used to set the initial conditions. * * The PDEs are discretized by central differencing on an MX by MY mesh. * * The resulting ODE system is stiff. * * The ODE system is solved using Newton iteration and the CVSPGMR * linear solver (scaled preconditioned GMRES). * * The preconditioner matrix used is the product of two matrices: * (1) A matrix, only defined implicitly, based on a fixed number * of Gauss-Seidel iterations using the diffusion terms only. * (2) A block-diagonal matrix based on the partial derivatives * of the interaction terms f only, using block-grouping (computing * only a subset of the ns by ns blocks). * * Four different runs are made for this problem. * The product preconditoner is applied on the left and on the * right. In each case, both the modified and classical Gram-Schmidt * options are tested. * In the series of runs, CVodeInit and CVSpgmr are called only * for the first run, whereas CVodeReInit and CVReInitSpgmr are * called for each of the remaining three runs. * * A problem description, performance statistics at selected output * times, and final statistics are written to standard output. * On the first run, solution values are also printed at output * times. Error and warning messages are written to standard error, * but there should be no such messages. * * Note: This program requires the dense linear solver functions * newDenseMat, newLintArray, denseAddIdentity, denseGETRF, denseGETRS, * destroyMat and destroyArray. * * Note: This program assumes the sequential implementation for the * type N_Vector and uses the NV_DATA_S macro to gain access to the * contiguous array of components of an N_Vector. * -------------------------------------------------------------------- * Reference: Peter N. Brown and Alan C. Hindmarsh, Reduced Storage * Matrix Methods in Stiff ODE Systems, J. Appl. Math. & Comp., 31 * (1989), pp. 40-91. Also available as Lawrence Livermore National * Laboratory Report UCRL-95088, Rev. 1, June 1987. * -------------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* serial N_Vector types, fct. and macros */ #include /* use generic DENSE solver in preconditioning */ #include /* definition of realtype */ #include /* contains the macros ABS and SQR */ /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Problem Specification Constants */ #define AA ONE /* AA = a */ #define EE RCONST(1.0e4) /* EE = e */ #define GG RCONST(0.5e-6) /* GG = g */ #define BB ONE /* BB = b */ #define DPREY ONE #define DPRED RCONST(0.5) #define ALPH ONE #define NP 3 #define NS (2*NP) /* Method Constants */ #define MX 6 #define MY 6 #define MXNS (MX*NS) #define AX ONE #define AY ONE #define DX (AX/(realtype)(MX-1)) #define DY (AY/(realtype)(MY-1)) #define MP NS #define MQ (MX*MY) #define MXMP (MX*MP) #define NGX 2 #define NGY 2 #define NGRP (NGX*NGY) #define ITMAX 5 /* CVodeInit Constants */ #define NEQ (NS*MX*MY) #define T0 ZERO #define RTOL RCONST(1.0e-5) #define ATOL RCONST(1.0e-5) /* CVSpgmr Constants */ #define MAXL 0 /* => use default = MIN(NEQ, 5) */ #define DELT ZERO /* => use default = 0.05 */ /* Output Constants */ #define T1 RCONST(1.0e-8) #define TOUT_MULT RCONST(10.0) #define DTOUT ONE #define NOUT 18 /* Note: The value for species i at mesh point (j,k) is stored in */ /* component number (i-1) + j*NS + k*NS*MX of an N_Vector, */ /* where 1 <= i <= NS, 0 <= j < MX, 0 <= k < MY. */ /* Structure for user data */ typedef struct { realtype **P[NGRP]; long int *pivot[NGRP]; int ns, mxns; int mp, mq, mx, my, ngrp, ngx, ngy, mxmp; int jgx[NGX+1], jgy[NGY+1], jigx[MX], jigy[MY]; int jxr[NGX], jyr[NGY]; realtype acoef[NS][NS], bcoef[NS], diff[NS]; realtype cox[NS], coy[NS], dx, dy, srur; realtype fsave[NEQ]; N_Vector rewt; void *cvode_mem; } *WebData; /* Private Helper Functions */ static WebData AllocUserData(void); static void InitUserData(WebData wdata); static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]); static void CInit(N_Vector c, WebData wdata); static void PrintIntro(void); static void PrintHeader(int jpre, int gstype); static void PrintAllSpecies(N_Vector c, int ns, int mxns, realtype t); static void PrintOutput(void *cvode_mem, realtype t); static void PrintFinalStats(void *cvode_mem); static void FreeUserData(WebData wdata); static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata); static void fblock (realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata); static void GSIter(realtype gamma, N_Vector z, N_Vector x,WebData wdata); /* Small Vector Kernels */ static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n); static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n); static void v_prod(realtype u[], realtype v[], realtype w[], int n); static void v_zero(realtype u[], int n); /* Functions Called By The Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Precond(realtype tn, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Implementation */ int main() { realtype abstol=ATOL, reltol=RTOL, t, tout; N_Vector c; WebData wdata; void *cvode_mem; booleantype firstrun; int jpre, gstype, flag; int ns, mxns, iout; c = NULL; wdata = NULL; cvode_mem = NULL; /* Initializations */ c = N_VNew_Serial(NEQ); if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1); wdata = AllocUserData(); if(check_flag((void *)wdata, "AllocUserData", 2)) return(1); InitUserData(wdata); ns = wdata->ns; mxns = wdata->mxns; /* Print problem description */ PrintIntro(); /* Loop over jpre and gstype (four cases) */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) { /* Initialize c and print heading */ CInit(c, wdata); PrintHeader(jpre, gstype); /* Call CVodeInit or CVodeReInit, then CVSpgmr to set up problem */ firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS); if (firstrun) { cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); wdata->cvode_mem = cvode_mem; flag = CVodeSetUserData(cvode_mem, wdata); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeInit(cvode_mem, f, T0, c); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); flag = CVSpgmr(cvode_mem, jpre, MAXL); if(check_flag(&flag, "CVSpgmr", 1)) return(1); flag = CVSpilsSetGSType(cvode_mem, gstype); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); flag = CVSpilsSetEpsLin(cvode_mem, DELT); if(check_flag(&flag, "CVSpilsSetEpsLin", 1)) return(1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); } else { flag = CVodeReInit(cvode_mem, T0, c); if(check_flag(&flag, "CVodeReInit", 1)) return(1); flag = CVSpilsSetPrecType(cvode_mem, jpre); check_flag(&flag, "CVSpilsSetPrecType", 1); flag = CVSpilsSetGSType(cvode_mem, gstype); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); } /* Print initial values */ if (firstrun) PrintAllSpecies(c, ns, mxns, T0); /* Loop over output points, call CVode, print sample solution values. */ tout = T1; for (iout = 1; iout <= NOUT; iout++) { flag = CVode(cvode_mem, tout, c, &t, CV_NORMAL); PrintOutput(cvode_mem, t); if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t); if(check_flag(&flag, "CVode", 1)) break; if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT; } /* Print final statistics, and loop for next case */ PrintFinalStats(cvode_mem); } } /* Free all memory */ CVodeFree(&cvode_mem); N_VDestroy_Serial(c); FreeUserData(wdata); return(0); } static WebData AllocUserData(void) { int i, ngrp = NGRP; long int ns = NS; WebData wdata; wdata = (WebData) malloc(sizeof *wdata); for(i=0; i < ngrp; i++) { (wdata->P)[i] = newDenseMat(ns, ns); (wdata->pivot)[i] = newLintArray(ns); } wdata->rewt = N_VNew_Serial(NEQ); return(wdata); } static void InitUserData(WebData wdata) { int i, j, ns; realtype *bcoef, *diff, *cox, *coy, dx, dy; realtype (*acoef)[NS]; acoef = wdata->acoef; bcoef = wdata->bcoef; diff = wdata->diff; cox = wdata->cox; coy = wdata->coy; ns = wdata->ns = NS; for (j = 0; j < NS; j++) { for (i = 0; i < NS; i++) acoef[i][j] = 0.; } for (j = 0; j < NP; j++) { for (i = 0; i < NP; i++) { acoef[NP+i][j] = EE; acoef[i][NP+j] = -GG; } acoef[j][j] = -AA; acoef[NP+j][NP+j] = -AA; bcoef[j] = BB; bcoef[NP+j] = -BB; diff[j] = DPREY; diff[NP+j] = DPRED; } /* Set remaining problem parameters */ wdata->mxns = MXNS; dx = wdata->dx = DX; dy = wdata->dy = DY; for (i = 0; i < ns; i++) { cox[i] = diff[i]/SQR(dx); coy[i] = diff[i]/SQR(dy); } /* Set remaining method parameters */ wdata->mp = MP; wdata->mq = MQ; wdata->mx = MX; wdata->my = MY; wdata->srur = SQRT(UNIT_ROUNDOFF); wdata->mxmp = MXMP; wdata->ngrp = NGRP; wdata->ngx = NGX; wdata->ngy = NGY; SetGroups(MX, NGX, wdata->jgx, wdata->jigx, wdata->jxr); SetGroups(MY, NGY, wdata->jgy, wdata->jigy, wdata->jyr); } /* This routine sets arrays jg, jig, and jr describing a uniform partition of (0,1,2,...,m-1) into ng groups. The arrays set are: jg = length ng+1 array of group boundaries. Group ig has indices j = jg[ig],...,jg[ig+1]-1. jig = length m array of group indices vs node index. Node index j is in group jig[j]. jr = length ng array of indices representing the groups. The index for group ig is j = jr[ig]. */ static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]) { int ig, j, len1, mper, ngm1; mper = m/ng; /* does integer division */ for (ig=0; ig < ng; ig++) jg[ig] = ig*mper; jg[ng] = m; ngm1 = ng - 1; len1 = ngm1*mper; for (j = 0; j < len1; j++) jig[j] = j/mper; for (j = len1; j < m; j++) jig[j] = ngm1; for (ig = 0; ig < ngm1; ig++) jr[ig] = ((2*ig+1)*mper-1)/2; jr[ngm1] = (ngm1*mper+m-1)/2; } /* This routine computes and loads the vector of initial values. */ static void CInit(N_Vector c, WebData wdata) { int jx, jy, ns, mxns, ioff, iyoff, i, ici; realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata; cdata = NV_DATA_S(c); ns = wdata->ns; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; x_factor = RCONST(4.0)/SQR(AX); y_factor = RCONST(4.0)/SQR(AY); for (jy = 0; jy < MY; jy++) { y = jy*dy; argy = SQR(y_factor*y*(AY-y)); iyoff = mxns*jy; for (jx = 0; jx < MX; jx++) { x = jx*dx; argx = SQR(x_factor*x*(AX-x)); ioff = iyoff + ns*jx; for (i = 1; i <= ns; i++) { ici = ioff + i-1; cdata[ici] = RCONST(10.0) + i*argx*argy; } } } } static void PrintIntro(void) { printf("\n\nDemonstration program for CVODE - CVSPGMR linear solver\n\n"); printf("Food web problem with ns species, ns = %d\n", NS); printf("Predator-prey interaction and diffusion on a 2-D square\n\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Matrix parameters: a = %.2Lg e = %.2Lg g = %.2Lg\n", AA, EE, GG); printf("b parameter = %.2Lg\n", BB); printf("Diffusion coefficients: Dprey = %.2Lg Dpred = %.2Lg\n", DPREY, DPRED); printf("Rate parameter alpha = %.2Lg\n\n", ALPH); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Matrix parameters: a = %.2lg e = %.2lg g = %.2lg\n", AA, EE, GG); printf("b parameter = %.2lg\n", BB); printf("Diffusion coefficients: Dprey = %.2lg Dpred = %.2lg\n", DPREY, DPRED); printf("Rate parameter alpha = %.2lg\n\n", ALPH); #else printf("Matrix parameters: a = %.2g e = %.2g g = %.2g\n", AA, EE, GG); printf("b parameter = %.2g\n", BB); printf("Diffusion coefficients: Dprey = %.2g Dpred = %.2g\n", DPREY, DPRED); printf("Rate parameter alpha = %.2g\n\n", ALPH); #endif printf("Mesh dimensions (mx,my) are %d, %d. ", MX, MY); printf("Total system size is neq = %d \n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerances: reltol = %.2Lg, abstol = %.2Lg \n\n", RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerances: reltol = %.2lg, abstol = %.2lg \n\n", RTOL, ATOL); #else printf("Tolerances: reltol = %.2g, abstol = %.2g \n\n", RTOL, ATOL); #endif printf("Preconditioning uses a product of:\n"); printf(" (1) Gauss-Seidel iterations with "); printf("itmax = %d iterations, and\n", ITMAX); printf(" (2) interaction-only block-diagonal matrix "); printf("with block-grouping\n"); printf(" Number of diagonal block groups = ngrp = %d", NGRP); printf(" (ngx by ngy, ngx = %d, ngy = %d)\n", NGX, NGY); printf("\n\n--------------------------------------------------------------"); printf("--------------\n"); } static void PrintHeader(int jpre, int gstype) { if(jpre == PREC_LEFT) printf("\n\nPreconditioner type is jpre = %s\n", "PREC_LEFT"); else printf("\n\nPreconditioner type is jpre = %s\n", "PREC_RIGHT"); if(gstype == MODIFIED_GS) printf("\nGram-Schmidt method type is gstype = %s\n\n\n", "MODIFIED_GS"); else printf("\nGram-Schmidt method type is gstype = %s\n\n\n", "CLASSICAL_GS"); } static void PrintAllSpecies(N_Vector c, int ns, int mxns, realtype t) { int i, jx ,jy; realtype *cdata; cdata = NV_DATA_S(c); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("c values at t = %Lg:\n\n", t); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("c values at t = %lg:\n\n", t); #else printf("c values at t = %g:\n\n", t); #endif for (i=1; i <= ns; i++) { printf("Species %d\n", i); for (jy=MY-1; jy >= 0; jy--) { for (jx=0; jx < MX; jx++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-10.6Lg", cdata[(i-1) + jx*ns + jy*mxns]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-10.6lg", cdata[(i-1) + jx*ns + jy*mxns]); #else printf("%-10.6g", cdata[(i-1) + jx*ns + jy*mxns]); #endif } printf("\n"); } printf("\n"); } } static void PrintOutput(void *cvode_mem, realtype t) { long int nst, nfe, nni; int qu, flag; realtype hu; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %10.2Le nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2Le\n\n", qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %10.2le nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2le\n\n", qu, hu); #else printf("t = %10.2e nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2e\n\n", qu, hu); #endif } static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; realtype avdim; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\n\n Final statistics for this run:\n\n"); printf(" CVode real workspace length = %4ld \n", lenrw); printf(" CVode integer workspace length = %4ld \n", leniw); printf(" CVSPGMR real workspace length = %4ld \n", lenrwLS); printf(" CVSPGMR integer workspace length = %4ld \n", leniwLS); printf(" Number of steps = %4ld \n", nst); printf(" Number of f-s = %4ld \n", nfe); printf(" Number of f-s (SPGMR) = %4ld \n", nfeLS); printf(" Number of f-s (TOTAL) = %4ld \n", nfe + nfeLS); printf(" Number of setups = %4ld \n", nsetups); printf(" Number of nonlinear iterations = %4ld \n", nni); printf(" Number of linear iterations = %4ld \n", nli); printf(" Number of preconditioner evaluations = %4ld \n", npe); printf(" Number of preconditioner solves = %4ld \n", nps); printf(" Number of error test failures = %4ld \n", netf); printf(" Number of nonlinear conv. failures = %4ld \n", ncfn); printf(" Number of linear convergence failures = %4ld \n", ncfl); avdim = (nni > 0) ? ((realtype)nli)/((realtype)nni) : ZERO; #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" Average Krylov subspace dimension = %.3Lf \n", avdim); #else printf(" Average Krylov subspace dimension = %.3f \n", avdim); #endif printf("\n\n--------------------------------------------------------------"); printf("--------------\n"); printf( "--------------------------------------------------------------"); printf("--------------\n"); } static void FreeUserData(WebData wdata) { int i, ngrp; ngrp = wdata->ngrp; for(i=0; i < ngrp; i++) { destroyMat((wdata->P)[i]); destroyArray((wdata->pivot)[i]); } N_VDestroy_Serial(wdata->rewt); free(wdata); } /* This routine computes the right-hand side of the ODE system and returns it in cdot. The interaction rates are computed by calls to WebRates, and these are saved in fsave for use in preconditioning. */ static int f(realtype t, N_Vector c, N_Vector cdot,void *user_data) { int i, ic, ici, idxl, idxu, jx, ns, mxns, iyoff, jy, idyu, idyl; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy; realtype *cdata, *cdotdata; WebData wdata; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cdotdata = NV_DATA_S(cdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRates(x, y, t, cdata+ic, fsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cdata[ici] - cdata[ici-idyl]; dcyui = cdata[ici+idyu] - cdata[ici]; /* Do differencing in x. */ dcxli = cdata[ici] - cdata[ici-idxl]; dcxui = cdata[ici+idxu] - cdata[ici]; /* Collect terms and load cdot elements. */ cdotdata[ici] = coy[i-1]*(dcyui - dcyli) + cox[i-1]*(dcxui - dcxli) + fsave[ici]; } } } return(0); } /* This routine computes the interaction rates for the species c_1, ... ,c_ns (stored in c[0],...,c[ns-1]), at one spatial point and at time t. */ static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; for (i = 0; i < ns; i++) rate[i] = ZERO; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += c[j] * acoef[i][j]; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = c[i]*(bcoef[i]*fac + rate[i]); } /* This routine generates the block-diagonal part of the Jacobian corresponding to the interaction rates, multiplies by -gamma, adds the identity matrix, and calls denseGETRF to do the LU decomposition of each diagonal block. The computation of the diagonal blocks uses the preset block and grouping information. One block per group is computed. The Jacobian elements are generated by difference quotients using calls to the routine fblock. This routine can be regarded as a prototype for the general case of a block-diagonal preconditioner. The blocks are of size mp, and there are ngrp=ngx*ngy blocks computed in the block-grouping scheme. */ static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype ***P; int ier; long int **pivot; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag; long int mp; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; WebData wdata; void *cvode_mem; N_Vector rewt; wdata = (WebData) user_data; cvode_mem = wdata->cvode_mem; cdata = NV_DATA_S(c); rewt = wdata->rewt; flag = CVodeGetErrWeights(cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fc, rewt); r0 = RCONST(1000.0)*ABS(gamma)*uround*NEQ*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = -gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][j][i] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* This routine computes one block of the interaction terms of the system, namely block (jx,jy), for use in preconditioning. Here jx and jy count from 0. */ static void fblock(realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata) { int iblok, ic; realtype x, y; iblok = jx + jy*(wdata->mx); y = jy*(wdata->dy); x = jx*(wdata->dx); ic = (wdata->ns)*(iblok); WebRates(x, y, t, cdata+ic, cdotdata, wdata); } /* This routine applies two inverse preconditioner matrices to the vector r, using the interaction-only block-diagonal Jacobian with block-grouping, denoted Jr, and Gauss-Seidel applied to the diffusion contribution to the Jacobian, denoted Jd. It first calls GSIter for a Gauss-Seidel approximation to ((I - gamma*Jd)-inverse)*r, and stores the result in z. Then it computes ((I - gamma*Jr)-inverse)*z, using LU factors of the blocks in P, and pivot information in pivot, and returns the result in z. */ static int PSolve(realtype tn, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx; long int mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations */ GSIter(gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } return(0); } /* This routine performs ITMAX=5 Gauss-Seidel iterations to compute an approximation to (P-inverse)*z, where P = I - gamma*Jd, and Jd represents the diffusion contributions to the Jacobian. The answer is stored in z on return, and x is a temporary vector. The dimensions below assume a global constant NS >= ns. Some inner loops of length ns are implemented with the small vector kernels v_sum_prods, v_prod, v_inc_by_prod. */ static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata) { int jx, jy, mx, my, x_loc, y_loc; int ns, mxns, i, iyoff, ic, iter; realtype beta[NS], beta2[NS], cof1[NS], gam[NS], gam2[NS]; realtype temp, *cox, *coy, *xd, *zd; xd = NV_DATA_S(x); zd = NV_DATA_S(z); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; cox = wdata->cox; coy = wdata->coy; /* Write matrix as P = D - L - U. Load local arrays beta, beta2, gam, gam2, and cof1. */ for (i = 0; i < ns; i++) { temp = ONE/(ONE + RCONST(2.0)*gamma*(cox[i] + coy[i])); beta[i] = gamma*cox[i]*temp; beta2[i] = RCONST(2.0)*beta[i]; gam[i] = gamma*coy[i]*temp; gam2[i] = RCONST(2.0)*gam[i]; cof1[i] = temp; } /* Begin iteration loop. Load vector x with (D-inverse)*z for first iteration. */ for (jy = 0; jy < my; jy++) { iyoff = mxns*jy; for (jx = 0; jx < mx; jx++) { ic = iyoff + ns*jx; v_prod(xd+ic, cof1, zd+ic, ns); /* x[ic+i] = cof1[i]z[ic+i] */ } } N_VConst(ZERO, z); /* Looping point for iterations. */ for (iter=1; iter <= ITMAX; iter++) { /* Calculate (D-inverse)*U*x if not the first iteration. */ if (iter > 1) { for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] = gam2[i]x[ic+mxns+i] */ v_prod(xd+ic, gam2, xd+ic+mxns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] = gam[i]x[ic+mxns+i] */ v_prod(xd+ic, gam, xd+ic+mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] = beta2[i]x[ic+ns+i] */ v_prod(xd+ic, beta2, xd+ic+ns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] = beta[i]x[ic+ns+i] */ v_prod(xd+ic, beta, xd+ic+ns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] = 0.0 */ v_zero(xd+ic, ns); break; } } } } /* end if (iter > 1) */ /* Overwrite x with [(I - (D-inverse)*L)-inverse]*x. */ for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] += beta[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] += beta2[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] += gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] += gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; } } } /* Add increment x to z : z <- z+x */ N_VLinearSum(ONE, z, ONE, x, z); } } static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] += v[i]*w[i]; } static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = p[i]*q[i] + v[i]*w[i]; } static void v_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = v[i]*w[i]; } static void v_zero(realtype u[], int n) { int i; for (i=0; i < n; i++) u[i] = ZERO; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvode/serial/cvRoberts_dnsL.out0000600000175000017500000000233611741421121024067 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158009e-01 9.185098e-06 2.841900e-01 At t = 4.0000e+02 y = 4.505440e-01 3.223217e-06 5.494528e-01 At t = 4.0000e+03 y = 1.831964e-01 8.942051e-07 8.168027e-01 At t = 4.0000e+04 y = 3.898104e-02 1.621656e-07 9.610188e-01 At t = 4.0000e+05 y = 4.938681e-03 1.985174e-08 9.950613e-01 At t = 4.0000e+06 y = 5.170501e-04 2.069253e-09 9.994829e-01 At t = 2.0809e+07 y = 1.000000e-04 4.000397e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.205557e-05 2.082332e-10 9.999479e-01 At t = 4.0000e+08 y = 5.207434e-06 2.082985e-11 9.999948e-01 At t = 4.0000e+09 y = 5.231265e-07 2.092507e-12 9.999995e-01 At t = 4.0000e+10 y = 5.009148e-08 2.003659e-13 9.999999e-01 Final Statistics: nst = 577 nfe = 838 nsetups = 125 nfeLS = 0 nje = 12 nni = 834 ncfn = 0 netf = 33 nge = 612 sundials-2.5.0/examples/cvode/serial/cvKrylovDemo_ls.out0000600000175000017500000002116111741421121024255 0ustar sylvestresylvestre ------- | SPGMR | ------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 3.87e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 343 order = 3 stepsize = 2.34e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 421 order = 4 stepsize = 5.26e+02 c1 (bot.left/middle/top rt.) = -4.385e-06 -1.528e-06 -4.905e-06 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 445 order = 3 stepsize = 1.98e+02 c1 (bot.left/middle/top rt.) = 4.461e-07 1.869e-07 4.842e-07 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 462 order = 5 stepsize = 2.35e+02 c1 (bot.left/middle/top rt.) = 3.204e-09 1.203e-09 3.555e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 474 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -1.066e-09 -3.409e-10 -1.206e-09 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 486 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 2.614e-09 9.722e-10 2.904e-09 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 498 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 4.649e-11 1.729e-11 5.161e-11 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 510 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -8.856e-14 -3.348e-14 -9.785e-14 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwLS = 2046 leniwLS = 10 nst = 510 nfe = 675 nfeLS = 641 nni = 671 nli = 641 nsetups = 94 netf = 36 npe = 9 nps = 1243 ncfn = 0 ncfl = 0 ====================================================================== ------- | SPBCG | ------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.58e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 222 order = 5 stepsize = 3.81e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 246 order = 5 stepsize = 4.34e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 282 order = 4 stepsize = 1.71e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 317 order = 5 stepsize = 9.48e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 369 order = 4 stepsize = 5.46e+02 c1 (bot.left/middle/top rt.) = -1.286e-09 -1.138e-09 -1.297e-09 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 385 order = 4 stepsize = 3.54e+02 c1 (bot.left/middle/top rt.) = 3.396e-14 2.448e-11 -2.220e-14 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 399 order = 5 stepsize = 3.72e+02 c1 (bot.left/middle/top rt.) = 1.607e-14 -1.589e-11 2.156e-13 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 410 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -3.759e-13 -7.684e-12 -3.258e-13 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 421 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -9.205e-14 -1.287e-11 2.328e-13 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 433 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -3.952e-21 9.479e-19 -3.924e-20 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 444 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = 1.131e-26 -2.041e-22 -7.893e-29 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwLS = 1800 leniwLS = 9 nst = 444 nfe = 573 nfeLS = 968 nni = 569 nli = 484 nsetups = 76 netf = 27 npe = 8 nps = 1457 ncfn = 0 ncfl = 0 ====================================================================== --------- | SPTFQMR | --------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 218 order = 5 stepsize = 1.44e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 250 order = 5 stepsize = 3.27e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 275 order = 5 stepsize = 3.49e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 309 order = 4 stepsize = 1.92e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 337 order = 5 stepsize = 1.24e+02 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 388 order = 4 stepsize = 5.10e+02 c1 (bot.left/middle/top rt.) = 9.865e-08 1.252e-05 1.407e-07 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 405 order = 4 stepsize = 2.84e+02 c1 (bot.left/middle/top rt.) = -1.668e-09 5.311e-07 -6.632e-09 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 419 order = 5 stepsize = 5.07e+02 c1 (bot.left/middle/top rt.) = -1.792e-09 6.186e-07 -7.318e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 431 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 1.682e-11 -9.299e-09 8.107e-11 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 441 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 1.919e-15 -3.196e-13 6.625e-15 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 450 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 2.380e-19 -4.543e-16 1.071e-18 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 459 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = -8.763e-21 5.632e-16 -4.431e-21 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwLS = 2200 leniwLS = 11 nst = 459 nfe = 582 nfeLS = 1248 nni = 578 nli = 520 nsetups = 71 netf = 23 npe = 8 nps = 1910 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvode/serial/cvRoberts_dns.out0000600000175000017500000000233611741421121023753 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158009e-01 9.185098e-06 2.841900e-01 At t = 4.0000e+02 y = 4.505440e-01 3.223217e-06 5.494528e-01 At t = 4.0000e+03 y = 1.831964e-01 8.942051e-07 8.168027e-01 At t = 4.0000e+04 y = 3.898104e-02 1.621656e-07 9.610188e-01 At t = 4.0000e+05 y = 4.938672e-03 1.985172e-08 9.950613e-01 At t = 4.0000e+06 y = 5.166093e-04 2.067499e-09 9.994834e-01 At t = 2.0800e+07 y = 1.000000e-04 4.000395e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.206409e-05 2.082671e-10 9.999479e-01 At t = 4.0000e+08 y = 5.211241e-06 2.084507e-11 9.999948e-01 At t = 4.0000e+09 y = 5.200520e-07 2.080209e-12 9.999995e-01 At t = 4.0000e+10 y = 5.699485e-08 2.279794e-13 9.999999e-01 Final Statistics: nst = 579 nfe = 817 nsetups = 118 nfeLS = 0 nje = 12 nni = 813 ncfn = 0 netf = 31 nge = 615 sundials-2.5.0/examples/cvode/serial/cvDiurnal_kry.out0000600000175000017500000000545411741421121023756 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 3.87e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 343 order = 3 stepsize = 2.34e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 421 order = 4 stepsize = 5.26e+02 c1 (bot.left/middle/top rt.) = -4.385e-06 -1.528e-06 -4.905e-06 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 445 order = 3 stepsize = 1.98e+02 c1 (bot.left/middle/top rt.) = 4.461e-07 1.869e-07 4.842e-07 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 462 order = 5 stepsize = 2.35e+02 c1 (bot.left/middle/top rt.) = 3.204e-09 1.203e-09 3.555e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 474 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -1.066e-09 -3.409e-10 -1.206e-09 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 486 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 2.614e-09 9.722e-10 2.904e-09 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 498 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 4.649e-11 1.729e-11 5.161e-11 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 510 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -8.856e-14 -3.348e-14 -9.785e-14 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2089 leniw = 50 lenrwLS = 2046 leniwLS = 10 nst = 510 nfe = 675 nfeLS = 641 nni = 671 nli = 641 nsetups = 94 netf = 36 npe = 9 nps = 1243 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvode/serial/cvDirectDemo_ls.out0000600000175000017500000004251511741421121024207 0ustar sylvestresylvestreDemonstration program for CVODE package - direct linear solvers Problem 1: Van der Pol oscillator xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0 neq = 2, itol = CV_SS, reltol = 0, abstol = 1e-06 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : FUNCTIONAL t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 9.8626e-02 3.60761 -2.12392e-05 -3.16877e+00 5 2.2756e-02 5.82239 -1.68010e+00 2.91060e-01 4 1.4079e-01 8.03716 9.57611e-05 3.16900e+00 5 2.0348e-02 Final statistics for this run: CVode real workspace length = 123 CVode integer workspace length = 57 Number of steps = 196 Number of f-s = 391 Number of setups = 0 Number of nonlinear iterations = 387 Number of nonlinear convergence failures = 0 Number of error test failures = 15 Error overrun = 95.761 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Dense, User-Supplied Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 7 6.5178e-02 3.60761 2.42943e-06 -3.16870e+00 7 2.0626e-02 5.82239 -1.68010e+00 2.91062e-01 7 1.3038e-01 8.03716 1.99078e-05 3.16879e+00 7 2.3923e-02 Final statistics for this run: CVode real workspace length = 123 CVode integer workspace length = 57 Number of steps = 266 Number of f-s = 366 Number of setups = 46 Number of nonlinear iterations = 362 Number of nonlinear convergence failures = 0 Number of error test failures = 23 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 5 Number of f evals. in linear solver = 0 Error overrun = 19.908 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Dense, Difference Quotient Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 6.5835e-02 3.60761 -2.28046e-05 -3.16879e+00 6 3.1773e-02 5.82239 -1.68010e+00 2.91059e-01 6 9.3514e-02 8.03716 -9.84768e-06 3.16869e+00 6 2.8096e-02 Final statistics for this run: CVode real workspace length = 123 CVode integer workspace length = 57 Number of steps = 195 Number of f-s = 268 Number of setups = 34 Number of nonlinear iterations = 264 Number of nonlinear convergence failures = 0 Number of error test failures = 15 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 4 Number of f evals. in linear solver = 8 Error overrun = 22.805 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Diagonal Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91054e-01 6 5.9553e-02 3.60761 6.36071e-05 -3.16853e+00 6 2.8912e-02 5.82239 -1.68011e+00 2.91057e-01 5 9.8123e-02 8.03716 -8.21358e-05 3.16848e+00 6 2.2328e-02 Final statistics for this run: CVode real workspace length = 123 CVode integer workspace length = 57 Number of steps = 241 Number of f-s = 340 Number of setups = 42 Number of nonlinear iterations = 336 Number of nonlinear convergence failures = 0 Number of error test failures = 20 Linear solver real workspace length = 6 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 42 Number of f evals. in linear solver = 42 Error overrun = 82.136 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : FUNCTIONAL t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 4 9.6100e-02 3.60761 -1.35636e-04 -3.16912e+00 5 1.5675e-02 5.82239 -1.68009e+00 2.91063e-01 5 1.1210e-01 8.03716 2.20969e-04 3.16937e+00 5 1.4732e-02 Final statistics for this run: CVode real workspace length = 109 CVode integer workspace length = 50 Number of steps = 262 Number of f-s = 498 Number of setups = 0 Number of nonlinear iterations = 494 Number of nonlinear convergence failures = 0 Number of error test failures = 22 Error overrun = 220.969 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Dense, User-Supplied Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 1.1991e-01 3.60761 -5.46907e-05 -3.16886e+00 5 1.6403e-02 5.82239 -1.68010e+00 2.91061e-01 4 1.0146e-01 8.03716 1.54312e-04 3.16917e+00 4 9.5378e-03 Final statistics for this run: CVode real workspace length = 109 CVode integer workspace length = 50 Number of steps = 265 Number of f-s = 358 Number of setups = 40 Number of nonlinear iterations = 354 Number of nonlinear convergence failures = 0 Number of error test failures = 18 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 5 Number of f evals. in linear solver = 0 Error overrun = 154.312 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Dense, Difference Quotient Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91058e-01 4 8.1067e-02 3.60761 -5.84200e-05 -3.16886e+00 4 1.1360e-02 5.82239 -1.68010e+00 2.91062e-01 5 6.4941e-02 8.03716 9.61737e-05 3.16899e+00 5 1.5216e-02 Final statistics for this run: CVode real workspace length = 109 CVode integer workspace length = 50 Number of steps = 276 Number of f-s = 367 Number of setups = 40 Number of nonlinear iterations = 363 Number of nonlinear convergence failures = 0 Number of error test failures = 17 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 6 Number of f evals. in linear solver = 12 Error overrun = 96.174 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Diagonal Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 1.1430e-01 3.60761 -9.83501e-05 -3.16900e+00 5 1.6712e-02 5.82239 -1.68009e+00 2.91063e-01 4 8.1261e-02 8.03716 1.66644e-04 3.16920e+00 4 1.0547e-02 Final statistics for this run: CVode real workspace length = 109 CVode integer workspace length = 50 Number of steps = 266 Number of f-s = 360 Number of setups = 39 Number of nonlinear iterations = 356 Number of nonlinear convergence failures = 0 Number of error test failures = 17 Linear solver real workspace length = 6 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 39 Number of f evals. in linear solver = 39 Error overrun = 166.644 ------------------------------------------------------------- ------------------------------------------------------------- Problem 2: ydot = A * y, where A is a banded lower triangular matrix derived from 2-D advection PDE neq = 25, ml = 5, mu = 0 itol = CV_SS, reltol = 0, abstol = 1e-06 t max.err qu hu ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : FUNCTIONAL t max.err qu hu 0.010 1.4690e-07 3 1.1459e-02 0.100 5.2543e-07 4 4.1413e-02 1.000 1.2207e-06 5 6.8243e-02 10.000 9.7711e-07 3 2.8481e-01 100.000 1.5230e-07 1 6.0816e-01 Final statistics for this run: CVode real workspace length = 514 CVode integer workspace length = 57 Number of steps = 341 Number of f-s = 601 Number of setups = 0 Number of nonlinear iterations = 597 Number of nonlinear convergence failures = 79 Number of error test failures = 0 Error overrun = 1.221 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Diagonal Jacobian t max.err qu hu 0.010 1.3734e-07 3 1.0327e-02 0.100 2.4956e-06 3 2.3048e-02 1.000 4.2328e-06 4 4.3778e-02 10.000 9.7335e-07 4 3.1286e-01 100.000 8.2265e-10 1 3.9630e+02 Final statistics for this run: CVode real workspace length = 514 CVode integer workspace length = 57 Number of steps = 154 Number of f-s = 219 Number of setups = 33 Number of nonlinear iterations = 215 Number of nonlinear convergence failures = 0 Number of error test failures = 5 Linear solver real workspace length = 75 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 33 Number of f evals. in linear solver = 33 Error overrun = 4.233 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Band, User-Supplied Jacobian t max.err qu hu 0.010 1.3670e-07 3 1.2164e-02 0.100 4.7920e-07 4 4.2115e-02 1.000 2.5077e-07 6 1.0365e-01 10.000 6.0790e-07 4 4.7206e-01 100.000 5.7390e-08 2 1.0750e+01 Final statistics for this run: CVode real workspace length = 514 CVode integer workspace length = 57 Number of steps = 149 Number of f-s = 184 Number of setups = 32 Number of nonlinear iterations = 180 Number of nonlinear convergence failures = 0 Number of error test failures = 6 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 0 Error overrun = 0.608 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Band, Difference Quotient Jacobian t max.err qu hu 0.010 1.4285e-07 3 1.3840e-02 0.100 5.7337e-07 4 4.2111e-02 1.000 7.3281e-07 5 6.3684e-02 10.000 3.8507e-07 5 2.6026e-01 100.000 4.1035e-12 1 6.2591e+01 Final statistics for this run: CVode real workspace length = 514 CVode integer workspace length = 57 Number of steps = 124 Number of f-s = 142 Number of setups = 24 Number of nonlinear iterations = 138 Number of nonlinear convergence failures = 0 Number of error test failures = 1 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 18 Error overrun = 0.733 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : FUNCTIONAL t max.err qu hu 0.010 5.5931e-07 2 8.1257e-03 0.100 5.2896e-06 3 1.7769e-02 1.000 2.3209e-06 5 7.5291e-02 10.000 1.2861e-06 5 2.7791e-01 100.000 1.6770e-08 1 8.7560e-01 Final statistics for this run: CVode real workspace length = 339 CVode integer workspace length = 50 Number of steps = 377 Number of f-s = 698 Number of setups = 0 Number of nonlinear iterations = 694 Number of nonlinear convergence failures = 56 Number of error test failures = 1 Error overrun = 5.290 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Diagonal Jacobian t max.err qu hu 0.010 5.6365e-07 2 8.1241e-03 0.100 7.9753e-07 4 1.8910e-02 1.000 5.9100e-06 5 5.1976e-02 10.000 1.1253e-05 4 9.7523e-02 100.000 1.1182e-09 1 8.7300e+01 Final statistics for this run: CVode real workspace length = 339 CVode integer workspace length = 50 Number of steps = 202 Number of f-s = 315 Number of setups = 63 Number of nonlinear iterations = 311 Number of nonlinear convergence failures = 5 Number of error test failures = 7 Linear solver real workspace length = 75 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 63 Number of f evals. in linear solver = 63 Error overrun = 11.253 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Band, User-Supplied Jacobian t max.err qu hu 0.010 5.6372e-07 2 8.1246e-03 0.100 5.2784e-06 3 1.7819e-02 1.000 1.8169e-06 5 6.0110e-02 10.000 5.4997e-07 5 4.1661e-01 100.000 1.7764e-09 2 2.9748e+01 Final statistics for this run: CVode real workspace length = 339 CVode integer workspace length = 50 Number of steps = 119 Number of f-s = 144 Number of setups = 25 Number of nonlinear iterations = 140 Number of nonlinear convergence failures = 0 Number of error test failures = 2 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 0 Error overrun = 5.278 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Band, Difference Quotient Jacobian t max.err qu hu 0.010 5.6492e-07 2 8.1361e-03 0.100 5.9968e-06 3 1.7105e-02 1.000 1.6902e-06 5 8.7628e-02 10.000 5.2314e-07 5 3.1091e-01 100.000 1.4380e-09 2 2.1635e+01 Final statistics for this run: CVode real workspace length = 339 CVode integer workspace length = 50 Number of steps = 121 Number of f-s = 145 Number of setups = 24 Number of nonlinear iterations = 141 Number of nonlinear convergence failures = 0 Number of error test failures = 1 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 18 Error overrun = 5.997 ------------------------------------------------------------- ------------------------------------------------------------- Number of errors encountered = 0 sundials-2.5.0/examples/cvode/serial/cvAdvDiff_bnd.out0000600000175000017500000000152211741421121023611 0ustar sylvestresylvestre 2-D Advection-Diffusion Equation Mesh dimensions = 10 X 5 Total system size = 50 Tolerance parameters: reltol = 0 abstol = 1e-05 At t = 0 max.norm(u) = 8.954716e+01 At t = 0.10 max.norm(u) = 4.132889e+00 nst = 85 At t = 0.20 max.norm(u) = 1.039294e+00 nst = 103 At t = 0.30 max.norm(u) = 2.979829e-01 nst = 113 At t = 0.40 max.norm(u) = 8.765774e-02 nst = 120 At t = 0.50 max.norm(u) = 2.625637e-02 nst = 126 At t = 0.60 max.norm(u) = 7.830425e-03 nst = 130 At t = 0.70 max.norm(u) = 2.329387e-03 nst = 134 At t = 0.80 max.norm(u) = 6.953434e-04 nst = 137 At t = 0.90 max.norm(u) = 2.115983e-04 nst = 140 At t = 1.00 max.norm(u) = 6.556853e-05 nst = 142 Final Statistics: nst = 142 nfe = 174 nsetups = 23 nfeLS = 0 nje = 3 nni = 170 ncfn = 0 netf = 3 sundials-2.5.0/examples/cvode/serial/cvAdvDiff_bndL.out0000600000175000017500000000152211741421121023725 0ustar sylvestresylvestre 2-D Advection-Diffusion Equation Mesh dimensions = 10 X 5 Total system size = 50 Tolerance parameters: reltol = 0 abstol = 1e-05 At t = 0 max.norm(u) = 8.954716e+01 At t = 0.10 max.norm(u) = 4.132889e+00 nst = 85 At t = 0.20 max.norm(u) = 1.039294e+00 nst = 103 At t = 0.30 max.norm(u) = 2.979829e-01 nst = 113 At t = 0.40 max.norm(u) = 8.765774e-02 nst = 120 At t = 0.50 max.norm(u) = 2.625637e-02 nst = 126 At t = 0.60 max.norm(u) = 7.830425e-03 nst = 130 At t = 0.70 max.norm(u) = 2.329387e-03 nst = 134 At t = 0.80 max.norm(u) = 6.953434e-04 nst = 137 At t = 0.90 max.norm(u) = 2.115983e-04 nst = 140 At t = 1.00 max.norm(u) = 6.556853e-05 nst = 142 Final Statistics: nst = 142 nfe = 174 nsetups = 23 nfeLS = 0 nje = 3 nni = 170 ncfn = 0 netf = 3 sundials-2.5.0/examples/cvode/serial/README0000600000175000017500000000201111741421121021253 0ustar sylvestresylvestreList of serial CVODE examples cvAdvDiff_bnd : banded example cvAdvDiff_bndL : banded example (Lapack) cvDirectDemo_ls : demonstration program for direct methods cvDiurnal_kry_bp : Krylov example with banded preconditioner cvDiurnal_kry : Krylov example cvKrylovDemo_ls : demonstration program with 3 Krylov solvers cvKrylovDemo_prec : demonstration program for Krylov methods cvRoberts_dns : dense example cvRoberts_dnsL : dense example (Lapack) cvRoberts_dns_uw : dense example with user ewt function Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=g77 CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --with-blas-lapack-libs="-L/home/radu/apps/lib -lSimTKlapack" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 The SimTKlapack library provides ATLAS-tunned Blas and Lapack functionssundials-2.5.0/examples/cvode/fcmix_serial/0000755000175000017500000000000011767174700021617 5ustar sylvestresylvestresundials-2.5.0/examples/cvode/fcmix_serial/fcvDiurnal_kry.out0000600000175000017500000000570711741421121025313 0ustar sylvestresylvestreKrylov example problem: Kinetics-transport, NEQ = 200 t = 0.720E+04 nst = 219 q = 5 h = 0.158696E+03 c1 (bot.left/middle/top rt.) = 0.104683E+05 0.296373E+05 0.111853E+05 c2 (bot.left/middle/top rt.) = 0.252672E+12 0.715376E+12 0.269977E+12 t = 0.144E+05 nst = 251 q = 5 h = 0.377205E+03 c1 (bot.left/middle/top rt.) = 0.665902E+07 0.531602E+07 0.730081E+07 c2 (bot.left/middle/top rt.) = 0.258192E+12 0.205680E+12 0.283286E+12 t = 0.216E+05 nst = 277 q = 5 h = 0.274587E+03 c1 (bot.left/middle/top rt.) = 0.266498E+08 0.103636E+08 0.293077E+08 c2 (bot.left/middle/top rt.) = 0.299279E+12 0.102810E+12 0.331344E+12 t = 0.288E+05 nst = 312 q = 4 h = 0.367517E+03 c1 (bot.left/middle/top rt.) = 0.870209E+07 0.129197E+08 0.965002E+07 c2 (bot.left/middle/top rt.) = 0.338035E+12 0.502929E+12 0.375096E+12 t = 0.360E+05 nst = 350 q = 4 h = 0.683836E+02 c1 (bot.left/middle/top rt.) = 0.140404E+05 0.202903E+05 0.156090E+05 c2 (bot.left/middle/top rt.) = 0.338677E+12 0.489443E+12 0.376517E+12 t = 0.432E+05 nst = 407 q = 4 h = 0.383863E+03 c1 (bot.left/middle/top rt.) = 0.803367E-06 0.363858E-06 0.889797E-06 c2 (bot.left/middle/top rt.) = 0.338233E+12 0.135487E+12 0.380352E+12 t = 0.504E+05 nst = 436 q = 3 h = 0.215343E+03 c1 (bot.left/middle/top rt.) = 0.375001E-05 0.665499E-06 0.454113E-05 c2 (bot.left/middle/top rt.) = 0.335816E+12 0.493028E+12 0.386445E+12 t = 0.576E+05 nst = 454 q = 5 h = 0.428080E+03 c1 (bot.left/middle/top rt.) = 0.112301E-08 0.194567E-09 0.136087E-08 c2 (bot.left/middle/top rt.) = 0.332031E+12 0.964985E+12 0.390900E+12 t = 0.648E+05 nst = 466 q = 5 h = 0.690422E+03 c1 (bot.left/middle/top rt.) = 0.353041E-08 0.590752E-09 0.428410E-08 c2 (bot.left/middle/top rt.) = 0.331303E+12 0.892184E+12 0.396342E+12 t = 0.720E+05 nst = 476 q = 5 h = 0.690422E+03 c1 (bot.left/middle/top rt.) = -0.121418E-09 -0.206756E-10 -0.147240E-09 c2 (bot.left/middle/top rt.) = 0.332972E+12 0.618620E+12 0.403885E+12 t = 0.792E+05 nst = 487 q = 5 h = 0.690422E+03 c1 (bot.left/middle/top rt.) = -0.341376E-11 -0.568210E-12 -0.414339E-11 c2 (bot.left/middle/top rt.) = 0.333441E+12 0.666893E+12 0.412026E+12 t = 0.864E+05 nst = 497 q = 5 h = 0.690422E+03 c1 (bot.left/middle/top rt.) = 0.309841E-12 0.526192E-13 0.375773E-12 c2 (bot.left/middle/top rt.) = 0.335178E+12 0.910652E+12 0.416251E+12 Final statistics: number of steps = 497 number of f evals. = 651 number of prec. setups = 91 number of prec. evals. = 9 number of prec. solves = 1233 number of nonl. iters. = 647 number of lin. iters. = 652 average Krylov subspace dimension (NLI/NNI) = 0.100773E+01 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 34 sundials-2.5.0/examples/cvode/fcmix_serial/fcvRoberts_dnsL.out0000600000175000017500000000256311741421121025425 0ustar sylvestresylvestreDense example problem: Robertson kinetics, NEQ = 3 At t = 0.2639E+00 y = 0.989965E+00 0.347056E-04 0.100000E-01 Above is a root, INFO() = 0 1 At t = 0.4000E+00 y = 0.985164E+00 0.338624E-04 0.148020E-01 At t = 0.4000E+01 y = 0.905510E+00 0.224034E-04 0.944679E-01 At t = 0.4000E+02 y = 0.715801E+00 0.918510E-05 0.284190E+00 At t = 0.4000E+03 y = 0.450544E+00 0.322322E-05 0.549453E+00 At t = 0.4000E+04 y = 0.183196E+00 0.894205E-06 0.816803E+00 At t = 0.4000E+05 y = 0.389810E-01 0.162166E-06 0.961019E+00 At t = 0.4000E+06 y = 0.493868E-02 0.198517E-07 0.995061E+00 At t = 0.4000E+07 y = 0.517050E-03 0.206925E-08 0.999483E+00 At t = 0.2081E+08 y = 0.100000E-03 0.400040E-09 0.999900E+00 Above is a root, INFO() = -1 0 At t = 0.4000E+08 y = 0.520556E-04 0.208233E-09 0.999948E+00 At t = 0.4000E+09 y = 0.520743E-05 0.208298E-10 0.999995E+00 At t = 0.4000E+10 y = 0.523126E-06 0.209251E-11 0.999999E+00 At t = 0.4000E+11 y = 0.500915E-07 0.200366E-12 0.100000E+01 Final value of ydot = -0.227814E-17 -0.911257E-23 0.227815E-17 Final statistics: No. steps = 577 No. f-s = 838 No. J-s = 12 No. LU-s = 125 No. nonlinear iterations = 834 No. nonlinear convergence failures = 0 No. error test failures = 33 No. root function evals = 612 sundials-2.5.0/examples/cvode/fcmix_serial/CMakeLists.txt0000600000175000017500000001056311741421121024334 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FCVODE serial examples # Add variable FCVODE_examples with the names of the serial FCVODE examples SET(FCVODE_examples fcvAdvDiff_bnd fcvDiurnal_kry_bp fcvDiurnal_kry fcvRoberts_dns ) # Add variable fcvode_bl_examples with the names of the serial FCVODE examples # that use Lapack SET(FCVODE_examples_BL fcvRoberts_dnsL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_static) SET(NVECS_LIB sundials_nvecserial_static) SET(FNVECS_LIB sundials_fnvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODE_LIB sundials_cvode_shared) SET(NVECS_LIB sundials_nvecserial_shared) SET(FNVECS_LIB sundials_fnvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FCVODE_LIB sundials_fcvode_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FCVODE_LIB} ${CVODE_LIB} ${FNVECS_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each FCVODE example FOREACH(example ${FCVODE_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FCVODE_examples}) # Add the build and install targets for each Lapack FCVODE example (if needed) IF(LAPACK_FOUND) FOREACH(example ${FCVODE_examples_BL}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FCVODE_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODE") SET(SOLVER_LIB "sundials_cvode") SET(SOLVER_FLIB "sundials_fcvode") LIST2STRING(FCVODE_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(FCVODE_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvode/fcmix_serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvode/fcmix_serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvode/fcmix_serial/Makefile.in0000600000175000017500000001125211741421121023635 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.11 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FCVODE serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ F77 = @F77@ FFLAGS = @FFLAGS@ F77_LNKR = @F77_LNKR@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/cvode/fcmix/libsundials_fcvode.la \ $(top_builddir)/src/cvode/libsundials_cvode.la \ $(top_builddir)/src/nvec_ser/libsundials_fnvecserial.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fcvAdvDiff_bnd \ fcvDiurnal_kry_bp \ fcvDiurnal_kry \ fcvRoberts_dns EXAMPLES_BL = fcvRoberts_dnsL OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/cvode/fcmix_serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvode/fcmix_serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_serial/README $(EXS_INSTDIR)/cvode/fcmix_serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_serial/$${i}.f $(EXS_INSTDIR)/cvode/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_serial/$${i}.out $(EXS_INSTDIR)/cvode/fcmix_serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_serial/$${i}.f $(EXS_INSTDIR)/cvode/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvode/fcmix_serial/$${i}.out $(EXS_INSTDIR)/cvode/fcmix_serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/Makefile rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/cvode/fcmix_serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/cvode/fcmix_serial $(rminstalldirs) $(EXS_INSTDIR)/cvode clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvode/fcmix_serial/fcvRoberts_dnsL.f0000600000175000017500000001475611741421121025052 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2007/10/25 20:03:27 $ C ---------------------------------------------------------------- C FCVODE Example Problem: Robertson kinetics, Lapack linear solver C with dense user Jacobian. C C The following is a simple example problem, with the coding C needed for its solution by CVODE. The problem is from chemical C kinetics, and consists of the following three rate equations: C C dy1/dt = -.04*y1 + 1.e4*y2*y3 C dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2 C dy3/dt = 3.e7*y2**2 C C on the interval from t = 0.0 to t = 4.e10, with initial C conditions: C C y1 = 1.0, y2 = y3 = 0. C C The problem is stiff. While integrating the system, we also C employ the root finding feature to find the points at which C y1 = 1.e-4 or at which y3 = 0.01. The following coding solves C this problem with CVODE, using the Fortran/C interface routine C package. This solution uses the BDF method and a user-supplied C Jacobian routine, and prints results at t = .4, 4., ..., 4.e10. C It uses ITOL = 2 and ATOL much smaller for y2 than y1 or y3 C because y2 has much smaller values. At the end of the run, C various counters of interest are printed. C ---------------------------------------------------------------- C IMPLICIT NONE C INTEGER IER, I INTEGER LNST, LNFE, LNSETUP, LNNI, LNCF, LNETF, LNJE, LNGE INTEGER METH, ITMETH, ITOL, ITASK, JOUT, NOUT, IERROOT INTEGER INFO(2) INTEGER*4 IOUT(25), IPAR INTEGER NEQ DOUBLE PRECISION RTOL, T, T0, TOUT DOUBLE PRECISION Y(3), ATOL(3), ROUT(10), RPAR C DATA LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, LNNI/7/, LNSETUP/8/, 1 LNGE/12/, LNJE/17/ C NEQ = 3 T0 = 0.0D0 Y(1) = 1.0D0 Y(2) = 0.0D0 Y(3) = 0.0D0 METH = 2 ITMETH = 2 ITOL = 2 RTOL = 1.0D-4 ATOL(1) = 1.0D-8 ATOL(2) = 1.0D-14 ATOL(3) = 1.0D-6 TOUT = 0.4D0 ITASK = 1 JOUT = 0 NOUT = 12 C WRITE(6,10) NEQ 10 FORMAT('Dense example problem:'// 1 ' Robertson kinetics, NEQ = ', I2//) C CALL FNVINITS(1, NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITS returned IER = ', I5) STOP ENDIF C CALL FCVMALLOC(T0, Y, METH, ITMETH, ITOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) STOP ENDIF C CALL FCVROOTINIT(2, IER) IF (IER .NE. 0) THEN WRITE(6,45) IER 45 FORMAT(///' SUNDIALS_ERROR: FCVROOTINIT returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVLAPACKDENSE(NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,40) IER 40 FORMAT(///' SUNDIALS_ERROR: FCVLAPACKDENSE returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVLAPACKDENSESETJAC(1, IER) C DO WHILE(JOUT .LT. NOUT) C CALL FCVODE(TOUT, T, Y, ITASK, IER) C WRITE(6,50) T, Y(1), Y(2), Y(3) 50 FORMAT('At t = ', E12.4, ' y = ', 3E14.6) C IF (IER .LT. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, 1 ' Linear Solver returned IER = ', I5) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF C IF (IER .EQ. 2) THEN CALL FCVROOTINFO(2, INFO, IERROOT) IF (IERROOT .LT. 0) THEN WRITE(6,65) IER 65 FORMAT(///' SUNDIALS_ERROR: FCVROOTINFO returned IER = ', 1 I5) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF WRITE(6,70) (INFO(I), I = 1, 2) 70 FORMAT(5X, 'Above is a root, INFO() = ', 2I3) ENDIF C IF (IER .EQ. 0) THEN TOUT = TOUT * 10.0D0 JOUT = JOUT + 1 ENDIF C ENDDO C CALL FCVDKY(T, 1, Y, IER) IF (IER .NE. 0) THEN WRITE(6,80) IER 80 FORMAT(///' SUNDIALS_ERROR: FCVDKY returned IER = ', I4) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF WRITE(6,85) Y(1), Y(2), Y(3) 85 FORMAT(/'Final value of ydot = ', 3E14.6) C WRITE(6,90) IOUT(LNST), IOUT(LNFE), IOUT(LNJE), IOUT(LNSETUP), 1 IOUT(LNNI), IOUT(LNCF), IOUT(LNETF), IOUT(LNGE) 90 FORMAT(//'Final statistics:'// 1 ' No. steps = ', I4, ' No. f-s = ', I4, 2 ' No. J-s = ', I4, ' No. LU-s = ', I4/ 3 ' No. nonlinear iterations = ', I4/ 4 ' No. nonlinear convergence failures = ', I4/ 5 ' No. error test failures = ', I4/ 6 ' No. root function evals = ', I4) C CALL FCVROOTFREE CALL FCVFREE C STOP END C ---------------------------------------------------------------- SUBROUTINE FCVFUN(T, Y, YDOT, IPAR, RPAR, IER) C Fortran routine for right-hand side function. IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, Y(*), YDOT(*), RPAR(*) C YDOT(1) = -0.04D0 * Y(1) + 1.0D4 * Y(2) * Y(3) YDOT(3) = 3.0D7 * Y(2) * Y(2) YDOT(2) = -YDOT(1) - YDOT(3) C IER = 0 C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVROOTFN(T, Y, G, IPAR, RPAR, IER) C Fortran routine for root finding IMPLICIT NONE C DOUBLE PRECISION T, Y(*), G(*), RPAR(*) INTEGER*4 IPAR(*), IER C G(1) = Y(1) - 1.0D-4 G(2) = Y(3) - 1.0D-2 C IER = 0 RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVDJAC(N, T, Y, FY, JAC, H, IPAR, RPAR, 1 V1, V2, V3, IER) C Fortran routine for dense user-supplied Jacobian. IMPLICIT NONE C INTEGER N, IER INTEGER*4 IPAR(*) DOUBLE PRECISION T, Y(*), FY(*), JAC(N,*), H, RPAR(*) DOUBLE PRECISION V1(*), V2(*), V3(*) C DOUBLE PRECISION Y1, Y2, Y3 C Y1 = Y(1) Y2 = Y(2) Y3 = Y(3) JAC(1,1) = -0.04D0 JAC(1,2) = 1.0D4 * Y3 JAC(1,3) = 1.0D4 * Y2 JAC(2,1) = 0.04D0 JAC(2,2) = -1.0D4 * Y3 - 6.0D7 * Y2 JAC(2,3) = -1.0D4 * Y2 JAC(3,3) = 0.0D0 JAC(3,2) = 6.0D7 * Y2 JAC(3,3) = 0.0D0 C IER = 0 C RETURN END sundials-2.5.0/examples/cvode/fcmix_serial/fcvRoberts_dns.f0000600000175000017500000001455311741421121024731 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2007/10/25 20:03:27 $ C ---------------------------------------------------------------- C FCVODE Example Problem: Robertson kinetics, dense user Jacobian. C C The following is a simple example problem, with the coding C needed for its solution by CVODE. The problem is from chemical C kinetics, and consists of the following three rate equations: C C dy1/dt = -.04*y1 + 1.e4*y2*y3 C dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2 C dy3/dt = 3.e7*y2**2 C C on the interval from t = 0.0 to t = 4.e10, with initial C conditions: C C y1 = 1.0, y2 = y3 = 0. C C The problem is stiff. While integrating the system, we also C enable the root finding feature to find the points at which C y1 = 1.e-4 or at which y3 = 0.01. The following coding solves C this problem with CVODE, using the Fortran/C interface routine C package. This solution uses the BDF method and a user-supplied C Jacobian routine, and prints results at t = .4, 4., ..., 4.e10. C It uses ITOL = 2 and ATOL much smaller for y2 than y1 or y3 C because y2 has much smaller values. At the end of the run, C various counters of interest are printed. C ---------------------------------------------------------------- C IMPLICIT NONE C INTEGER IER, I INTEGER LNST, LNFE, LNSETUP, LNNI, LNCF, LNETF, LNJE, LNGE INTEGER METH, ITMETH, ITOL, ITASK, JOUT, NOUT, IERROOT INTEGER INFO(2) INTEGER*4 IOUT(25), IPAR INTEGER*4 NEQ DOUBLE PRECISION RTOL, T, T0, TOUT DOUBLE PRECISION Y(3), ATOL(3), ROUT(10), RPAR C DATA LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, LNNI/7/, LNSETUP/8/, 1 LNGE/12/, LNJE/17/ C NEQ = 3 T0 = 0.0D0 Y(1) = 1.0D0 Y(2) = 0.0D0 Y(3) = 0.0D0 METH = 2 ITMETH = 2 ITOL = 2 RTOL = 1.0D-4 ATOL(1) = 1.0D-8 ATOL(2) = 1.0D-14 ATOL(3) = 1.0D-6 TOUT = 0.4D0 ITASK = 1 JOUT = 0 NOUT = 12 C WRITE(6,10) NEQ 10 FORMAT('Dense example problem:'// 1 ' Robertson kinetics, NEQ = ', I2//) C CALL FNVINITS(1, NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITS returned IER = ', I5) STOP ENDIF C CALL FCVMALLOC(T0, Y, METH, ITMETH, ITOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) STOP ENDIF C CALL FCVROOTINIT(2, IER) IF (IER .NE. 0) THEN WRITE(6,45) IER 45 FORMAT(///' SUNDIALS_ERROR: FCVROOTINIT returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVDENSE(NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,40) IER 40 FORMAT(///' SUNDIALS_ERROR: FCVDENSE returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVDENSESETJAC(1, IER) C DO WHILE(JOUT .LT. NOUT) C CALL FCVODE(TOUT, T, Y, ITASK, IER) C WRITE(6,50) T, Y(1), Y(2), Y(3) 50 FORMAT('At t = ', E12.4, ' y = ', 3E14.6) C IF (IER .LT. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, 1 ' Linear Solver returned IER = ', I5) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF C IF (IER .EQ. 2) THEN CALL FCVROOTINFO(2, INFO, IERROOT) IF (IERROOT .LT. 0) THEN WRITE(6,65) IER 65 FORMAT(///' SUNDIALS_ERROR: FCVROOTINFO returned IER = ', 1 I5) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF WRITE(6,70) (INFO(I), I = 1, 2) 70 FORMAT(5X, 'Above is a root, INFO() = ', 2I3) ENDIF C IF (IER .EQ. 0) THEN TOUT = TOUT * 10.0D0 JOUT = JOUT + 1 ENDIF C ENDDO C CALL FCVDKY(T, 1, Y, IER) IF (IER .NE. 0) THEN WRITE(6,80) IER 80 FORMAT(///' SUNDIALS_ERROR: FCVDKY returned IER = ', I4) CALL FCVROOTFREE CALL FCVFREE STOP ENDIF WRITE(6,85) Y(1), Y(2), Y(3) 85 FORMAT(/'Final value of ydot = ', 3E14.6) C WRITE(6,90) IOUT(LNST), IOUT(LNFE), IOUT(LNJE), IOUT(LNSETUP), 1 IOUT(LNNI), IOUT(LNCF), IOUT(LNETF), IOUT(LNGE) 90 FORMAT(//'Final statistics:'// 1 ' No. steps = ', I4, ' No. f-s = ', I4, 2 ' No. J-s = ', I4, ' No. LU-s = ', I4/ 3 ' No. nonlinear iterations = ', I4/ 4 ' No. nonlinear convergence failures = ', I4/ 5 ' No. error test failures = ', I4/ 6 ' No. root function evals = ', I4) C CALL FCVROOTFREE CALL FCVFREE C STOP END C ---------------------------------------------------------------- SUBROUTINE FCVFUN(T, Y, YDOT, IPAR, RPAR, IER) C Fortran routine for right-hand side function. IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, Y(*), YDOT(*), RPAR(*) C YDOT(1) = -0.04D0 * Y(1) + 1.0D4 * Y(2) * Y(3) YDOT(3) = 3.0D7 * Y(2) * Y(2) YDOT(2) = -YDOT(1) - YDOT(3) C IER = 0 C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVROOTFN(T, Y, G, IPAR, RPAR, IER) C Fortran routine for root finding IMPLICIT NONE C DOUBLE PRECISION T, Y(*), G(*), RPAR(*) INTEGER*4 IPAR(*), IER C G(1) = Y(1) - 1.0D-4 G(2) = Y(3) - 1.0D-2 C IER = 0 RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVDJAC(N, T, Y, FY, JAC, H, IPAR, RPAR, 1 V1, V2, V3, IER) C Fortran routine for dense user-supplied Jacobian. IMPLICIT NONE C INTEGER*4 N, IPAR(*), IER DOUBLE PRECISION T, Y(*), FY(*), JAC(N,*), H, RPAR(*) DOUBLE PRECISION V1(*), V2(*), V3(*) C DOUBLE PRECISION Y1, Y2, Y3 C Y1 = Y(1) Y2 = Y(2) Y3 = Y(3) JAC(1,1) = -0.04D0 JAC(1,2) = 1.0D4 * Y3 JAC(1,3) = 1.0D4 * Y2 JAC(2,1) = 0.04D0 JAC(2,2) = -1.0D4 * Y3 - 6.0D7 * Y2 JAC(2,3) = -1.0D4 * Y2 JAC(3,2) = 6.0D7 * Y2 C IER = 0 C RETURN END sundials-2.5.0/examples/cvode/fcmix_serial/fcvAdvDiff_bnd.out0000600000175000017500000000154411741421121025151 0ustar sylvestresylvestreBand example problem: Advection-diffusion, NEQ = 50 At t = 0.00 max.norm(u) = 0.895472E+02 At t = 0.10 max.norm(u) = 0.413289E+01 NST = 85 At t = 0.20 max.norm(u) = 0.103929E+01 NST = 103 At t = 0.30 max.norm(u) = 0.297983E+00 NST = 113 At t = 0.40 max.norm(u) = 0.876577E-01 NST = 120 At t = 0.50 max.norm(u) = 0.262564E-01 NST = 126 At t = 0.60 max.norm(u) = 0.783042E-02 NST = 130 At t = 0.70 max.norm(u) = 0.232939E-02 NST = 134 At t = 0.80 max.norm(u) = 0.695343E-03 NST = 137 At t = 0.90 max.norm(u) = 0.211598E-03 NST = 140 At t = 1.00 max.norm(u) = 0.655685E-04 NST = 142 Final statistics: No. steps = 142 No. f-s = 174 No. J-s = 3 No. LU-s = 23 No. nonlinear iterations = 170 No. nonlinear convergence failures = 0 No. error test failures = 3 sundials-2.5.0/examples/cvode/fcmix_serial/fcvDiurnal_kry_bp.f0000600000175000017500000002540411741421121025406 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2007/10/25 20:03:27 $ C ---------------------------------------------------------------- C FCVODE Example Problem: 2D kinetics-transport, C precond. Krylov solver. C C An ODE system is generated from the following 2-species diurnal C kinetics advection-diffusion PDE system in 2 space dimensions: C C dc(i)/dt = Kh*(d/dx)**2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) C + Ri(c1,c2,t) for i = 1,2, where C R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , C R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , C Kv(y) = Kv0*exp(y/5) , C Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) C vary diurnally. C C The problem is posed on the square C 0 .le. x .le. 20, 30 .le. y .le. 50 (all in km), C with homogeneous Neumann boundary conditions, and for time t in C 0 .le. t .le. 86400 sec (1 day). C C The PDE system is treated by central differences on a uniform C 10 x 10 mesh, with simple polynomial initial profiles. C The problem is solved with CVODE, with the BDF/GMRES method and C using the FCVBP banded preconditioner C C The second and third dimensions of U here must match the values of C MX and MY, for consistency with the output statements below. C ---------------------------------------------------------------- C IMPLICIT NONE C INTEGER*4 MX, MY, NEQ PARAMETER (MX=10, MY=10) PARAMETER (NEQ=2*MX*MY) C INTEGER LNST, LNFE, LNSETUP, LNNI, LNCF, LNPE, LNLI, LNPS INTEGER LNCFL, LH, LQ, METH, ITMETH, IATOL, ITASK INTEGER LNETF, IER, MAXL, JPRETYPE, IGSTYPE, JOUT INTEGER LLENRW, LLENIW, LLENRWLS, LLENIWLS INTEGER*4 IOUT(25), IPAR(4) INTEGER*4 NST, NFE, NPSET, NPE, NPS, NNI INTEGER*4 NLI, NCFN, NCFL, NETF, MU, ML INTEGER*4 LENRW, LENIW, LENRWLS, LENIWLS, LENRWBP, LENIWBP, NFEBP DOUBLE PRECISION ATOL, AVDIM, DELT, FLOOR, RTOL, T, TOUT, TWOHR DOUBLE PRECISION ROUT(10), U(2,MX,MY), RPAR(12) C DATA TWOHR/7200.0D0/, RTOL/1.0D-5/, FLOOR/100.0D0/, 1 JPRETYPE/1/, IGSTYPE/1/, MAXL/0/, DELT/0.0D0/ DATA LLENRW/1/, LLENIW/2/, LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, 1 LNNI/7/, LNSETUP/8/, LQ/9/, LLENRWLS/13/, LLENIWLS/14/, 1 LNPE/18/, LNLI/20/, LNPS/19/, LNCFL/21/ DATA LH/2/ C C Load IPAR, RPAR, and initial values CALL INITKX(MX, MY, U, IPAR, RPAR) C C Set other input arguments. T = 0.0D0 METH = 2 ITMETH = 2 IATOL = 1 ATOL = RTOL * FLOOR ITASK = 1 C WRITE(6,10) NEQ 10 FORMAT('Krylov example problem:'// 1 ' Kinetics-transport, NEQ = ', I4/) C C Initialize vector specification CALL FNVINITS(1, NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITS returned IER = ', I5) STOP ENDIF C C Initialize CVODE CALL FCVMALLOC(T, U, METH, ITMETH, IATOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) STOP ENDIF C C Initialize SPGMR solver CALL FCVSPGMR(JPRETYPE, IGSTYPE, MAXL, DELT, IER) IF (IER .NE. 0) THEN WRITE(6,45) IER 45 FORMAT(///' SUNDIALS_ERROR: FCVSPGMR returned IER = ', I5) CALL FCVFREE STOP ENDIF C C Initialize band preconditioner MU = 2 ML = 2 CALL FCVBPINIT(NEQ, MU, ML, IER) IF (IER .NE. 0) THEN WRITE(6,40) IER 40 FORMAT(///' SUNDIALS_ERROR: FCVBPINIT returned IER = ', I5) CALL FCVFREE STOP ENDIF C C Loop over output points, call FCVODE, print sample solution values. TOUT = TWOHR DO 70 JOUT = 1, 12 C CALL FCVODE(TOUT, T, U, ITASK, IER) C WRITE(6,50) T, IOUT(LNST), IOUT(LQ), ROUT(LH) 50 FORMAT(/' t = ', E14.6, 5X, 'no. steps = ', I5, 1 ' order = ', I3, ' stepsize = ', E14.6) WRITE(6,55) U(1,1,1), U(1,5,5), U(1,10,10), 1 U(2,1,1), U(2,5,5), U(2,10,10) 55 FORMAT(' c1 (bot.left/middle/top rt.) = ', 3E14.6/ 1 ' c2 (bot.left/middle/top rt.) = ', 3E14.6) C IF (IER .NE. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, 1 ' Linear Solver returned IER = ', I5) CALL FCVFREE STOP ENDIF C TOUT = TOUT + TWOHR 70 CONTINUE C Print final statistics. NST = IOUT(LNST) NFE = IOUT(LNFE) NPSET = IOUT(LNSETUP) NPE = IOUT(LNPE) NPS = IOUT(LNPS) NNI = IOUT(LNNI) NLI = IOUT(LNLI) AVDIM = DBLE(NLI) / DBLE(NNI) NCFN = IOUT(LNCF) NCFL = IOUT(LNCFL) NETF = IOUT(LNETF) LENRW = IOUT(LLENRW) LENIW = IOUT(LLENIW) LENRWLS = IOUT(LLENRWLS) LENIWLS = IOUT(LLENIWLS) WRITE(6,80) NST, NFE, NPSET, NPE, NPS, NNI, NLI, AVDIM, NCFN, 1 NCFL, NETF, LENRW, LENIW, LENRWLS, LENIWLS 80 FORMAT(//'Final statistics:'// & ' number of steps = ', I5, 4X, & ' number of f evals. = ', I5/ & ' number of prec. setups = ', I5/ & ' number of prec. evals. = ', I5, 4X, & ' number of prec. solves = ', I5/ & ' number of nonl. iters. = ', I5, 4X, & ' number of lin. iters. = ', I5/ & ' average Krylov subspace dimension (NLI/NNI) = ', E14.6/ & ' number of conv. failures.. nonlinear =', I3, & ' linear = ', I3/ & ' number of error test failures = ', I3/ & ' main solver real/int workspace sizes = ',2I5/ & ' linear solver real/int workspace sizes = ',2I5) CALL FCVBPOPT(LENRWBP, LENIWBP, NFEBP) WRITE(6,82) LENRWBP, LENIWBP, NFEBP 82 FORMAT('In CVBANDPRE:'/ & ' real/int workspace sizes = ', 2I5/ & ' number of f evaluations = ', I5) C CALL FCVFREE C STOP END C ---------------------------------------------------------------- SUBROUTINE INITKX(MX, MY, U0, IPAR, RPAR) C Routine to set problem constants and initial values C IMPLICIT NONE C INTEGER*4 MX, MY, IPAR(*) DOUBLE PRECISION RPAR(*) C INTEGER*4 MM, JY, JX, NEQ DOUBLE PRECISION U0 DIMENSION U0(2,MX,MY) DOUBLE PRECISION Q1, Q2, Q3, Q4, A3, A4, OM, C3, DY, HDCO DOUBLE PRECISION VDCO, HACO, X, Y DOUBLE PRECISION CX, CY, DKH, DKV0, DX, HALFDA, PI, VEL C DATA DKH/4.0D-6/, VEL/0.001D0/, DKV0/1.0D-8/, HALFDA/4.32D4/, 1 PI/3.1415926535898D0/ C C Problem constants MM = MX * MY NEQ = 2 * MM Q1 = 1.63D-16 Q2 = 4.66D-16 A3 = 22.62D0 A4 = 7.601D0 OM = PI / HALFDA C3 = 3.7D16 DX = 20.0D0 / (MX - 1.0D0) DY = 20.0D0 / (MY - 1.0D0) HDCO = DKH / DX**2 HACO = VEL / (2.0D0 * DX) VDCO = (1.0D0 / DY**2) * DKV0 C Load constants in IPAR and RPAR IPAR(1) = MX IPAR(2) = MY IPAR(3) = MM IPAR(4) = NEQ C RPAR(1) = Q1 RPAR(2) = Q2 RPAR(3) = Q3 RPAR(4) = Q4 RPAR(5) = A3 RPAR(6) = A4 RPAR(7) = OM RPAR(8) = C3 RPAR(9) = DY RPAR(10) = HDCO RPAR(11) = VDCO RPAR(12) = HACO C C Set initial profiles. DO 20 JY = 1, MY Y = 30.0D0 + (JY - 1.0D0) * DY CY = (0.1D0 * (Y - 40.0D0))**2 CY = 1.0D0 - CY + 0.5D0 * CY**2 DO 10 JX = 1, MX X = (JX - 1.0D0) * DX CX = (0.1D0 * (X - 10.0D0))**2 CX = 1.0D0 - CX + 0.5D0 * CX**2 U0(1,JX,JY) = 1.0D6 * CX * CY U0(2,JX,JY) = 1.0D12 * CX * CY 10 CONTINUE 20 CONTINUE C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVFUN(T, U, UDOT, IPAR, RPAR, IER) C Routine for right-hand side function f IMPLICIT NONE C INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, U(2,*), UDOT(2,*), RPAR(*) C INTEGER ILEFT, IRIGHT INTEGER*4 MX, MY, MM, JY, JX, IBLOK0, IDN, IUP, IBLOK DOUBLE PRECISION Q1,Q2,Q3,Q4, A3, A4, OM, C3, DY, HDCO, VDCO, HACO DOUBLE PRECISION C1, C2, C1DN, C2DN, C1UP, C2UP, C1LT, C2LT DOUBLE PRECISION C1RT, C2RT, CYDN, CYUP, HORD1, HORD2, HORAD1 DOUBLE PRECISION HORAD2, QQ1, QQ2, QQ3, QQ4, RKIN1, RKIN2, S DOUBLE PRECISION VERTD1, VERTD2, YDN, YUP C C Extract constants from IPAR and RPAR MX = IPAR(1) MY = IPAR(2) MM = IPAR(3) C Q1 = RPAR(1) Q2 = RPAR(2) Q3 = RPAR(3) Q4 = RPAR(4) A3 = RPAR(5) A4 = RPAR(6) OM = RPAR(7) C3 = RPAR(8) DY = RPAR(9) HDCO = RPAR(10) VDCO = RPAR(11) HACO = RPAR(12) C C Set diurnal rate coefficients. S = SIN(OM * T) IF (S .GT. 0.0D0) THEN Q3 = EXP(-A3 / S) Q4 = EXP(-A4 / S) ELSE Q3 = 0.0D0 Q4 = 0.0D0 ENDIF C C Loop over all grid points. DO 20 JY = 1, MY YDN = 30.0D0 + (JY - 1.5D0) * DY YUP = YDN + DY CYDN = VDCO * EXP(0.2D0 * YDN) CYUP = VDCO * EXP(0.2D0 * YUP) IBLOK0 = (JY - 1) * MX IDN = -MX IF (JY .EQ. 1) IDN = MX IUP = MX IF (JY .EQ. MY) IUP = -MX DO 10 JX = 1, MX IBLOK = IBLOK0 + JX C1 = U(1,IBLOK) C2 = U(2,IBLOK) C Set kinetic rate terms. QQ1 = Q1 * C1 * C3 QQ2 = Q2 * C1 * C2 QQ3 = Q3 * C3 QQ4 = Q4 * C2 RKIN1 = -QQ1 - QQ2 + 2.0D0 * QQ3 + QQ4 RKIN2 = QQ1 - QQ2 - QQ4 C Set vertical diffusion terms. C1DN = U(1,IBLOK + IDN) C2DN = U(2,IBLOK + IDN) C1UP = U(1,IBLOK + IUP) C2UP = U(2,IBLOK + IUP) VERTD1 = CYUP * (C1UP - C1) - CYDN * (C1 - C1DN) VERTD2 = CYUP * (C2UP - C2) - CYDN * (C2 - C2DN) C Set horizontal diffusion and advection terms. ILEFT = -1 IF (JX .EQ. 1) ILEFT = 1 IRIGHT = 1 IF (JX .EQ. MX) IRIGHT = -1 C1LT = U(1,IBLOK + ILEFT) C2LT = U(2,IBLOK + ILEFT) C1RT = U(1,IBLOK + IRIGHT) C2RT = U(2,IBLOK + IRIGHT) HORD1 = HDCO * (C1RT - 2.0D0 * C1 + C1LT) HORD2 = HDCO * (C2RT - 2.0D0 * C2 + C2LT) HORAD1 = HACO * (C1RT - C1LT) HORAD2 = HACO * (C2RT - C2LT) C Load all terms into UDOT. UDOT(1,IBLOK) = VERTD1 + HORD1 + HORAD1 + RKIN1 UDOT(2,IBLOK) = VERTD2 + HORD2 + HORAD2 + RKIN2 10 CONTINUE 20 CONTINUE C IER = 0 C RETURN END sundials-2.5.0/examples/cvode/fcmix_serial/fcvRoberts_dns.out0000600000175000017500000000256311741421121025311 0ustar sylvestresylvestreDense example problem: Robertson kinetics, NEQ = 3 At t = 0.2639E+00 y = 0.989965E+00 0.347056E-04 0.100000E-01 Above is a root, INFO() = 0 1 At t = 0.4000E+00 y = 0.985164E+00 0.338624E-04 0.148020E-01 At t = 0.4000E+01 y = 0.905510E+00 0.224034E-04 0.944679E-01 At t = 0.4000E+02 y = 0.715801E+00 0.918510E-05 0.284190E+00 At t = 0.4000E+03 y = 0.450544E+00 0.322322E-05 0.549453E+00 At t = 0.4000E+04 y = 0.183196E+00 0.894205E-06 0.816803E+00 At t = 0.4000E+05 y = 0.389810E-01 0.162166E-06 0.961019E+00 At t = 0.4000E+06 y = 0.493867E-02 0.198517E-07 0.995061E+00 At t = 0.4000E+07 y = 0.516609E-03 0.206750E-08 0.999483E+00 At t = 0.2080E+08 y = 0.100000E-03 0.400039E-09 0.999900E+00 Above is a root, INFO() = -1 0 At t = 0.4000E+08 y = 0.520641E-04 0.208267E-09 0.999948E+00 At t = 0.4000E+09 y = 0.521124E-05 0.208451E-10 0.999995E+00 At t = 0.4000E+10 y = 0.520052E-06 0.208021E-11 0.999999E+00 At t = 0.4000E+11 y = 0.569949E-07 0.227979E-12 0.100000E+01 Final value of ydot = -0.304816E-17 -0.121927E-22 0.304818E-17 Final statistics: No. steps = 579 No. f-s = 817 No. J-s = 12 No. LU-s = 118 No. nonlinear iterations = 813 No. nonlinear convergence failures = 0 No. error test failures = 31 No. root function evals = 615 sundials-2.5.0/examples/cvode/fcmix_serial/fcvAdvDiff_bnd.f0000600000175000017500000001765211741421121024576 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2007/10/25 20:03:27 $ C ---------------------------------------------------------------- C FCVODE Example Problem: Advection-diffusion, banded user C Jacobian. C C The following is a simple example problem with a banded C Jacobian. The problem is the semi-discrete form of the C advection-diffusion equation in 2D: C du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 C on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time C interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions C are posed, and the initial condition is the following: C u(x,y,t=0) = x(2-x)y(1-y)exp(5xy) . C The PDE is discretized on a uniform MX+2 by MY+2 grid with C central differencing, and with boundary values eliminated, C leaving an ODE system of size NEQ = MX*MY. C This program solves this problem with CVODE, using the Fortran/C C interface routine package. This solution uses the BDF method, C a user-supplied banded Jacobian routine, and scalar relative and C absolute tolerances. It prints results at t = .1, .2, ..., 1.0. C At the end of the run, various counters of interest are printed. C ---------------------------------------------------------------- C IMPLICIT NONE C INTEGER*4 MX, MY, NEQ PARAMETER (MX=10, MY=5) PARAMETER (NEQ=MX*MY) C DOUBLE PRECISION XMAX, YMAX DATA XMAX/2.0D0/, YMAX/1.0D0/ C INTEGER LNST, LNFE, LNSETUP, LNNI, LNCF, LNETF, LNJE INTEGER IER, METH, ITMETH, IATOL, ITASK, JOUT INTEGER*4 IOUT(25), IPAR(2) INTEGER*4 MU, ML DOUBLE PRECISION RTOL, ATOL, T0, T, TOUT, DTOUT, UNORM DOUBLE PRECISION U(NEQ), ROUT(10), RPAR(5) C DATA LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, LNNI/7/, LNSETUP/8/, 1 LNJE/17/ C CALL INITBX(XMAX, YMAX, MX, MY, U, IPAR, RPAR) C T0 = 0.0D0 METH = 2 ITMETH = 2 IATOL = 1 RTOL = 0.0D0 ATOL = 1.0D-5 MU = MY ML = MY DTOUT = 0.1D0 ITASK = 1 C WRITE(6,10) NEQ 10 FORMAT('Band example problem:'// 1 ' Advection-diffusion, NEQ = ', I2//) C CALL FNVINITS(1, NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITS returned IER = ', I5) STOP ENDIF C CALL FCVMALLOC(T0, U, METH, ITMETH, IATOL, RTOL, ATOL, 1 IOUT, ROUT, IPAR, RPAR, IER) IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) STOP ENDIF C CALL FCVBAND(NEQ, MU, ML, IER) IF (IER .NE. 0) THEN WRITE(6,40) IER 40 FORMAT(///' SUNDIALS_ERROR: FCVBAND returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVBANDSETJAC(1, IER) C CALL MAXNORM(NEQ, U, UNORM) WRITE(6,45) T0, UNORM 45 FORMAT(' At t = ', F6.2, ' max.norm(u) = ', E14.6) C TOUT = DTOUT DO 70 JOUT = 1, 10 C CALL FCVODE(TOUT, T, U, ITASK, IER) C CALL MAXNORM(NEQ, U, UNORM) WRITE(6,50) T, UNORM, IOUT(LNST) 50 FORMAT(' At t = ', F6.2, ' max.norm(u) = ', E14.6, 1 ' NST = ', I4) C IF (IER .NE. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, 1 ' Linear Solver returned IER = ', I5) CALL FCVFREE STOP ENDIF C TOUT = TOUT + DTOUT 70 CONTINUE C WRITE(6,80) IOUT(LNST), IOUT(LNFE), IOUT(LNJE), IOUT(LNSETUP), 1 IOUT(LNNI), IOUT(LNCF), IOUT(LNETF) 80 FORMAT(//'Final statistics:'// 1 ' No. steps = ', I4, ' No. f-s = ', I4, 2 ' No. J-s = ', I4, ' No. LU-s = ', I4/ 3 ' No. nonlinear iterations = ', I4/ 4 ' No. nonlinear convergence failures = ', I4/ 5 ' No. error test failures = ', I4) C CALL FCVFREE C STOP END C ---------------------------------------------------------------- SUBROUTINE INITBX(XMAX, YMAX, MX, MY, U0, IPAR, RPAR) C Load IPAR and RPAR with problem constants and U0 with initial values IMPLICIT NONE C INTEGER*4 MX, MY, IPAR(*) DOUBLE PRECISION XMAX, YMAX, U0(MY,MX), RPAR(*) C INTEGER*4 I, J DOUBLE PRECISION DX, DY, X, Y, HDCOEF, HACOEF, VDCOEF C C Problem constants DX = XMAX / (MX + 1) DY = YMAX / (MY + 1) HDCOEF = 1.0D0 / (DX * DX) HACOEF = 0.5D0 / (2.0D0 * DX) VDCOEF = 1.0D0 / (DY * DY) C Load constants in IPAR and RPAR IPAR(1) = MX IPAR(2) = MY RPAR(1) = DX RPAR(2) = DY RPAR(3) = HDCOEF RPAR(4) = HACOEF RPAR(5) = VDCOEF C C Loop over grid and load initial values. DO 20 I = 1, MX X = I * DX DO 10 J = 1, MY Y = J * DY U0(J,I) = X * (XMAX - X) * Y * (YMAX - Y) * * EXP(5.0D0 * X * Y) 10 CONTINUE 20 CONTINUE C RETURN END SUBROUTINE MAXNORM(N, U, UNORM) C Compute max-norm of array U IMPLICIT NONE C INTEGER*4 I, N DOUBLE PRECISION U(*), UNORM, TEMP C TEMP = 0.0D0 DO 10 I = 1, N TEMP = MAX(ABS(U(I)), TEMP) 10 CONTINUE UNORM = TEMP RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVFUN(T, U, UDOT, IPAR, RPAR, IER) C Right-hand side routine IMPLICIT NONE C DOUBLE PRECISION T, U(*), UDOT(*), RPAR(*) INTEGER*4 IPAR(*), IER C INTEGER*4 I, MX, IOFF, MY, J, IJ DOUBLE PRECISION UIJ, UDN, UUP, ULT, URT, HDIFF, HADV, VDIFF DOUBLE PRECISION DX, DY, HDCOEF, HACOEF, VDCOEF C C Exract constants from IPAR and RPAR MX = IPAR(1) MY = IPAR(2) DX = RPAR(1) DY = RPAR(2) HDCOEF = RPAR(3) HACOEF = RPAR(4) VDCOEF = RPAR(5) C C Loop over all grid points. DO 20 I = 1, MX IOFF = (I - 1) * MY DO 10 J = 1, MY C C Extract u at x_i, y_j and four neighboring points. IJ = J + IOFF UIJ = U(IJ) UDN = 0.0D0 IF (J .NE. 1) UDN = U(IJ - 1) UUP = 0.0D0 IF (J .NE. MY) UUP = U(IJ + 1) ULT = 0.0D0 IF (I .NE. 1) ULT = U(IJ - MY) URT = 0.0D0 IF (I .NE. MX) URT = U(IJ + MY) C C Set diffusion and advection terms and load into UDOT. HDIFF = HDCOEF * (ULT - 2.0D0 * UIJ + URT) HADV = HACOEF * (URT - ULT) VDIFF = VDCOEF * (UUP - 2.0D0 * UIJ + UDN) UDOT(IJ) = HDIFF + HADV + VDIFF 10 CONTINUE 20 CONTINUE C IER = 0 C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVBJAC(N, MU, ML, MDIM, T, U, FU, 1 BJAC, H, IPAR, RPAR, V1, V2, V3, IER) C Load banded Jacobian IMPLICIT NONE C INTEGER N, MU, ML, MDIM INTEGER*4 IPAR(*), IER DOUBLE PRECISION T, U(*), FU(*), BJAC(MDIM,*), H, RPAR(*) DOUBLE PRECISION V1(*), V2(*), V3(*) C INTEGER*4 MBAND, MX, MY INTEGER*4 I, J, K, IOFF, MU1, MU2 DOUBLE PRECISION DX, DY, HDCOEF, HACOEF, VDCOEF C C Exract constants from IPAR and RPAR MX = IPAR(1) MY = IPAR(2) DX = RPAR(1) DY = RPAR(2) HDCOEF = RPAR(3) HACOEF = RPAR(4) VDCOEF = RPAR(5) C MU1 = MU + 1 MU2 = MU + 2 MBAND = MU + 1 + ML C C Loop over all grid points. DO 20 I = 1, MX IOFF = (I - 1) * MY DO 10 J = 1, MY K = J + IOFF C C Set Jacobian elements in column k of Jb. BJAC(MU1,K) = -2.0D0 * (VDCOEF + HDCOEF) IF (I .NE. 1) BJAC(1,K) = HDCOEF + HACOEF IF (I .NE. MX) BJAC(MBAND,K) = HDCOEF - HACOEF IF (J .NE. 1) BJAC(MU,K) = VDCOEF IF (J .NE. MY) BJAC(MU2,K) = VDCOEF C 10 CONTINUE 20 CONTINUE C IER = 0 C RETURN END sundials-2.5.0/examples/cvode/fcmix_serial/fcvDiurnal_kry_bp.out0000600000175000017500000000666011741421121025773 0ustar sylvestresylvestreKrylov example problem: Kinetics-transport, NEQ = 200 t = 0.720000E+04 no. steps = 190 order = 5 stepsize = 0.160965E+03 c1 (bot.left/middle/top rt.) = 0.104683E+05 0.296373E+05 0.111853E+05 c2 (bot.left/middle/top rt.) = 0.252672E+12 0.715377E+12 0.269977E+12 t = 0.144000E+05 no. steps = 221 order = 5 stepsize = 0.382687E+03 c1 (bot.left/middle/top rt.) = 0.665902E+07 0.531602E+07 0.730081E+07 c2 (bot.left/middle/top rt.) = 0.258192E+12 0.205680E+12 0.283286E+12 t = 0.216000E+05 no. steps = 246 order = 5 stepsize = 0.278111E+03 c1 (bot.left/middle/top rt.) = 0.266497E+08 0.103640E+08 0.293077E+08 c2 (bot.left/middle/top rt.) = 0.299279E+12 0.102815E+12 0.331344E+12 t = 0.288000E+05 no. steps = 291 order = 4 stepsize = 0.113513E+03 c1 (bot.left/middle/top rt.) = 0.870208E+07 0.129196E+08 0.965001E+07 c2 (bot.left/middle/top rt.) = 0.338035E+12 0.502927E+12 0.375095E+12 t = 0.360000E+05 no. steps = 331 order = 4 stepsize = 0.885814E+02 c1 (bot.left/middle/top rt.) = 0.140403E+05 0.202899E+05 0.156090E+05 c2 (bot.left/middle/top rt.) = 0.338677E+12 0.489432E+12 0.376516E+12 t = 0.432000E+05 no. steps = 402 order = 4 stepsize = 0.415260E+03 c1 (bot.left/middle/top rt.) = -0.576856E-08 0.342117E-08 -0.386627E-08 c2 (bot.left/middle/top rt.) = 0.338232E+12 0.135500E+12 0.380352E+12 t = 0.504000E+05 no. steps = 415 order = 5 stepsize = 0.457901E+03 c1 (bot.left/middle/top rt.) = -0.497941E-17 -0.719339E-14 -0.265325E-14 c2 (bot.left/middle/top rt.) = 0.335816E+12 0.493026E+12 0.386444E+12 t = 0.576000E+05 no. steps = 430 order = 4 stepsize = 0.219223E+03 c1 (bot.left/middle/top rt.) = 0.161106E-16 0.458698E-15 -0.470389E-17 c2 (bot.left/middle/top rt.) = 0.332031E+12 0.964973E+12 0.390899E+12 t = 0.648000E+05 no. steps = 444 order = 4 stepsize = 0.579451E+03 c1 (bot.left/middle/top rt.) = 0.950457E-15 0.115369E-13 -0.231605E-15 c2 (bot.left/middle/top rt.) = 0.331302E+12 0.892177E+12 0.396342E+12 t = 0.720000E+05 no. steps = 457 order = 4 stepsize = 0.579451E+03 c1 (bot.left/middle/top rt.) = 0.390973E-15 -0.484816E-13 0.254545E-14 c2 (bot.left/middle/top rt.) = 0.332972E+12 0.618613E+12 0.403884E+12 t = 0.792000E+05 no. steps = 469 order = 4 stepsize = 0.579451E+03 c1 (bot.left/middle/top rt.) = -0.290314E-14 0.215229E-12 0.355073E-15 c2 (bot.left/middle/top rt.) = 0.333440E+12 0.666885E+12 0.412026E+12 t = 0.864000E+05 no. steps = 481 order = 4 stepsize = 0.579451E+03 c1 (bot.left/middle/top rt.) = 0.235825E-22 0.231595E-17 -0.600745E-15 c2 (bot.left/middle/top rt.) = 0.335178E+12 0.910810E+12 0.416250E+12 Final statistics: number of steps = 481 number of f evals. = 620 number of prec. setups = 88 number of prec. evals. = 9 number of prec. solves = 1096 number of nonl. iters. = 616 number of lin. iters. = 561 average Krylov subspace dimension (NLI/NNI) = 0.910714E+00 number of conv. failures.. nonlinear = 0 linear = 0 number of error test failures = 28 main solver real/int workspace sizes = 2089 50 linear solver real/int workspace sizes = 2046 10 In CVBANDPRE: real/int workspace sizes = 2400 200 number of f evaluations = 45 sundials-2.5.0/examples/cvode/fcmix_serial/fcvDiurnal_kry.f0000600000175000017500000006502311741421121024726 0ustar sylvestresylvestreC ---------------------------------------------------------------- C $Revision: 1.1 $ C $Date: 2007/10/25 20:03:27 $ C ---------------------------------------------------------------- C FCVODE Example Problem: 2D kinetics-transport, precond. Krylov C solver. C C An ODE system is generated from the following 2-species diurnal C kinetics advection-diffusion PDE system in 2 space dimensions: C C dc(i)/dt = Kh*(d/dx)**2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) C + Ri(c1,c2,t) for i = 1,2, where C R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , C R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , C Kv(y) = Kv0*exp(y/5) , C Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) C vary diurnally. C C The problem is posed on the square C 0 .le. x .le. 20, 30 .le. y .le. 50 (all in km), C with homogeneous Neumann boundary conditions, and for time t C in 0 .le. t .le. 86400 sec (1 day). C The PDE system is treated by central differences on a uniform C 10 x 10 mesh, with simple polynomial initial profiles. C The problem is solved with CVODE, with the BDF/GMRES method and C the block-diagonal part of the Jacobian as a left C preconditioner. C C Note: this program requires the dense linear solver routines C DGEFA and DGESL from LINPACK, and BLAS routines DCOPY and DSCAL. C C The second and third dimensions of U here must match the values C of MX and MY, for consistency with the output statements C below. C ---------------------------------------------------------------- C IMPLICIT NONE C INTEGER*4 MX, MY, NEQ PARAMETER (MX=10, MY=10) PARAMETER (NEQ=2*MX*MY) INTEGER*4 LENIPAR, LENRPAR PARAMETER (LENIPAR=6+2*MX*MY, LENRPAR=12+8*MX*MY) C INTEGER METH,ITMETH,IATOL,ITASK,IER,LNCFL,LNPS INTEGER LNST,LNFE,LNSETUP,LNNI,LNCF,LQ,LH,LNPE,LNLI,LNETF INTEGER JOUT,JPRETYPE,IGSTYPE,MAXL INTEGER*4 IOUT(25),IPAR(LENIPAR) INTEGER*4 NST,NFE,NPSET,NPE,NPS,NNI,NETF INTEGER*4 NLI,NCFN,NCFL DOUBLE PRECISION ATOL,AVDIM,T,TOUT,TWOHR,RTOL,FLOOR,DELT DOUBLE PRECISION U(2,MX,MY),ROUT(10),RPAR(LENRPAR) C DATA TWOHR/7200.0D0/, RTOL/1.0D-5/, FLOOR/100.0D0/, & JPRETYPE/1/, IGSTYPE/1/, MAXL/0/, DELT/0.0D0/ DATA LNST/3/, LNFE/4/, LNETF/5/, LNCF/6/, LNNI/7/, LNSETUP/8/, & LQ/9/, LNPE/18/, LNLI/20/, LNPS/19/, LNCFL/21/ DATA LH/2/ C C Load problem constants into IPAR, RPAR, and set initial values CALL INITKX(MX, MY, U, IPAR, RPAR) C C Set other input arguments. T = 0.0D0 METH = 2 ITMETH = 2 IATOL = 1 ATOL = RTOL * FLOOR ITASK = 1 C WRITE(6,10) NEQ 10 FORMAT('Krylov example problem:'// & ' Kinetics-transport, NEQ = ', I4/) C CALL FNVINITS(1, NEQ, IER) IF (IER .NE. 0) THEN WRITE(6,20) IER 20 FORMAT(///' SUNDIALS_ERROR: FNVINITS returned IER = ', I5) STOP ENDIF C C Initialize CVODE CALL FCVMALLOC(T, U, METH, ITMETH, IATOL, RTOL, ATOL, & IOUT, ROUT, IPAR, RPAR, IER) IF (IER .NE. 0) THEN WRITE(6,30) IER 30 FORMAT(///' SUNDIALS_ERROR: FCVMALLOC returned IER = ', I5) STOP ENDIF C CALL FCVSPGMR(JPRETYPE, IGSTYPE, MAXL, DELT, IER) IF (IER .NE. 0) THEN WRITE(6,40) IER 40 FORMAT(///' SUNDIALS_ERROR: FCVSPGMR returned IER = ', I5) CALL FCVFREE STOP ENDIF C CALL FCVSPILSSETPREC(1, IER) C C Loop over output points, call FCVODE, print sample solution values. TOUT = TWOHR DO JOUT = 1, 12 C CALL FCVODE(TOUT, T, U, ITASK, IER) C WRITE(6,50) T, IOUT(LNST), IOUT(LQ), ROUT(LH) 50 FORMAT(/' t = ', E11.3, 3X, 'nst = ', I5, & ' q = ', I2, ' h = ', E14.6) WRITE(6,55) U(1,1,1), U(1,5,5), U(1,10,10), & U(2,1,1), U(2,5,5), U(2,10,10) 55 FORMAT(' c1 (bot.left/middle/top rt.) = ', 3E14.6/ & ' c2 (bot.left/middle/top rt.) = ', 3E14.6) C IF (IER .NE. 0) THEN WRITE(6,60) IER, IOUT(15) 60 FORMAT(///' SUNDIALS_ERROR: FCVODE returned IER = ', I5, /, & ' Linear Solver returned IER = ', I5) CALL FCVFREE STOP ENDIF C TOUT = TOUT + TWOHR C ENDDO C Print final statistics. NST = IOUT(LNST) NFE = IOUT(LNFE) NPSET = IOUT(LNSETUP) NPE = IOUT(LNPE) NPS = IOUT(LNPS) NNI = IOUT(LNNI) NLI = IOUT(LNLI) AVDIM = DBLE(NLI) / DBLE(NNI) NCFN = IOUT(LNCF) NCFL = IOUT(LNCFL) NETF = IOUT(LNETF) WRITE(6,80) NST, NFE, NPSET, NPE, NPS, NNI, NLI, AVDIM, NCFN, & NCFL, NETF 80 FORMAT(//'Final statistics:'// & ' number of steps = ', I5, 5X, & ' number of f evals. =', I5/ & ' number of prec. setups = ', I5/ & ' number of prec. evals. = ', I5, 5X, & ' number of prec. solves = ', I5/ & ' number of nonl. iters. = ', I5, 5X, & ' number of lin. iters. = ', I5/ & ' average Krylov subspace dimension (NLI/NNI) = ', E14.6/ & ' number of conv. failures.. nonlinear = ', I3, & ' linear = ', I3/ & ' number of error test failures = ', I3) C CALL FCVFREE C STOP END C ---------------------------------------------------------------- SUBROUTINE INITKX(MX, MY, U0, IPAR, RPAR) C Routine to set problem constants and initial values C IMPLICIT NONE C INTEGER*4 MX, MY, IPAR(*) DOUBLE PRECISION RPAR(*) C INTEGER*4 MM, JY, JX, P_IPP, P_BD, P_P DOUBLE PRECISION U0 DIMENSION U0(2,MX,MY) DOUBLE PRECISION Q1, Q2, Q3, Q4, A3, A4, OM, C3, DY, HDCO DOUBLE PRECISION VDCO, HACO, X, Y DOUBLE PRECISION CX, CY, DKH, DKV0, DX, HALFDA, PI, VEL C DATA DKH/4.0D-6/, VEL/0.001D0/, DKV0/1.0D-8/, HALFDA/4.32D4/, 1 PI/3.1415926535898D0/ C C Problem constants MM = MX * MY Q1 = 1.63D-16 Q2 = 4.66D-16 A3 = 22.62D0 A4 = 7.601D0 OM = PI / HALFDA C3 = 3.7D16 DX = 20.0D0 / (MX - 1.0D0) DY = 20.0D0 / (MY - 1.0D0) HDCO = DKH / DX**2 HACO = VEL / (2.0D0 * DX) VDCO = (1.0D0 / DY**2) * DKV0 C C Load constants in IPAR and RPAR IPAR(1) = MX IPAR(2) = MY IPAR(3) = MM C RPAR(1) = Q1 RPAR(2) = Q2 RPAR(3) = Q3 RPAR(4) = Q4 RPAR(5) = A3 RPAR(6) = A4 RPAR(7) = OM RPAR(8) = C3 RPAR(9) = DY RPAR(10) = HDCO RPAR(11) = VDCO RPAR(12) = HACO C C Pointers into IPAR and RPAR P_IPP = 7 P_BD = 13 P_P = P_BD + 4*MM C IPAR(4) = P_IPP IPAR(5) = P_BD IPAR(6) = P_P C C Set initial profiles. DO JY = 1, MY Y = 30.0D0 + (JY - 1.0D0) * DY CY = (0.1D0 * (Y - 40.0D0))**2 CY = 1.0D0 - CY + 0.5D0 * CY**2 DO JX = 1, MX X = (JX - 1.0D0) * DX CX = (0.1D0 * (X - 10.0D0))**2 CX = 1.0D0 - CX + 0.5D0 * CX**2 U0(1,JX,JY) = 1.0D6 * CX * CY U0(2,JX,JY) = 1.0D12 * CX * CY ENDDO ENDDO C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVFUN(T, U, UDOT, IPAR, RPAR, IER) C Routine for right-hand side function f C IMPLICIT NONE C DOUBLE PRECISION T, U(2,*), UDOT(2,*), RPAR(*) INTEGER*4 IPAR(*), IER C INTEGER ILEFT, IRIGHT INTEGER*4 JX, JY, MX, MY, MM, IBLOK0, IBLOK, IDN, IUP DOUBLE PRECISION Q1, Q2, Q3, Q4, A3, A4, OM, C3, DY, HDCO DOUBLE PRECISION VDCO, HACO DOUBLE PRECISION C1, C2, C1DN, C2DN, C1UP, C2UP, C1LT, C2LT DOUBLE PRECISION C1RT, C2RT, CYDN, CYUP, HORD1, HORD2, HORAD1 DOUBLE PRECISION HORAD2, QQ1, QQ2, QQ3, QQ4, RKIN1, RKIN2, S DOUBLE PRECISION VERTD1, VERTD2, YDN, YUP C C Extract constants from IPAR and RPAR MX = IPAR(1) MY = IPAR(2) MM = IPAR(3) C Q1 = RPAR(1) Q2 = RPAR(2) Q3 = RPAR(3) Q4 = RPAR(4) A3 = RPAR(5) A4 = RPAR(6) OM = RPAR(7) C3 = RPAR(8) DY = RPAR(9) HDCO = RPAR(10) VDCO = RPAR(11) HACO = RPAR(12) C C Set diurnal rate coefficients. S = SIN(OM * T) IF (S .GT. 0.0D0) THEN Q3 = EXP(-A3 / S) Q4 = EXP(-A4 / S) ELSE Q3 = 0.0D0 Q4 = 0.0D0 ENDIF RPAR(3) = Q3 RPAR(4) = Q4 C C Loop over all grid points. DO JY = 1, MY YDN = 30.0D0 + (JY - 1.5D0) * DY YUP = YDN + DY CYDN = VDCO * EXP(0.2D0 * YDN) CYUP = VDCO * EXP(0.2D0 * YUP) IBLOK0 = (JY - 1) * MX IDN = -MX IF (JY .EQ. 1) IDN = MX IUP = MX IF (JY .EQ. MY) IUP = -MX DO JX = 1, MX IBLOK = IBLOK0 + JX C1 = U(1,IBLOK) C2 = U(2,IBLOK) C Set kinetic rate terms. QQ1 = Q1 * C1 * C3 QQ2 = Q2 * C1 * C2 QQ3 = Q3 * C3 QQ4 = Q4 * C2 RKIN1 = -QQ1 - QQ2 + 2.0D0 * QQ3 + QQ4 RKIN2 = QQ1 - QQ2 - QQ4 C Set vertical diffusion terms. C1DN = U(1,IBLOK + IDN) C2DN = U(2,IBLOK + IDN) C1UP = U(1,IBLOK + IUP) C2UP = U(2,IBLOK + IUP) VERTD1 = CYUP * (C1UP - C1) - CYDN * (C1 - C1DN) VERTD2 = CYUP * (C2UP - C2) - CYDN * (C2 - C2DN) C Set horizontal diffusion and advection terms. ILEFT = -1 IF (JX .EQ. 1) ILEFT = 1 IRIGHT = 1 IF (JX .EQ. MX) IRIGHT = -1 C1LT = U(1,IBLOK + ILEFT) C2LT = U(2,IBLOK + ILEFT) C1RT = U(1,IBLOK + IRIGHT) C2RT = U(2,IBLOK + IRIGHT) HORD1 = HDCO * (C1RT - 2.0D0 * C1 + C1LT) HORD2 = HDCO * (C2RT - 2.0D0 * C2 + C2LT) HORAD1 = HACO * (C1RT - C1LT) HORAD2 = HACO * (C2RT - C2LT) C Load all terms into UDOT. UDOT(1,IBLOK) = VERTD1 + HORD1 + HORAD1 + RKIN1 UDOT(2,IBLOK) = VERTD2 + HORD2 + HORAD2 + RKIN2 ENDDO ENDDO C IER = 0 C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVPSET(T, U, FU, JOK, JCUR, GAMMA, H, & IPAR, RPAR, V1, V2, V3, IER) C Routine to set and preprocess block-diagonal preconditioner. C Note: The dimensions in /BDJ/ below assume at most 100 mesh points. C IMPLICIT NONE C INTEGER IER, JOK, JCUR DOUBLE PRECISION T, U(2,*), FU(*), GAMMA, H INTEGER*4 IPAR(*) DOUBLE PRECISION RPAR(*), V1(*), V2(*), V3(*) C INTEGER*4 MX, MY, MM, P_IPP, P_BD, P_P DOUBLE PRECISION Q1, Q2, Q3, Q4, C3, DY, HDCO, VDCO C IER = 0 C C Extract constants from IPAR and RPAR MX = IPAR(1) MY = IPAR(2) MM = IPAR(3) C Q1 = RPAR(1) Q2 = RPAR(2) Q3 = RPAR(3) Q4 = RPAR(4) C3 = RPAR(8) DY = RPAR(9) HDCO = RPAR(10) VDCO = RPAR(11) C C Extract pointers into IPAR and RPAR P_IPP = IPAR(4) P_BD = IPAR(5) P_P = IPAR(6) C C If needed, recompute BD C IF (JOK .EQ. 1) THEN C JOK = 1. Reuse saved BD JCUR = 0 ELSE C JOK = 0. Compute diagonal Jacobian blocks. C (using q4 value computed on last FCVFUN call). CALL PREC_JAC(MX, MY, MM, U, RPAR(P_BD), & Q1, Q2, Q3, Q4, C3, DY, HDCO, VDCO) JCUR = 1 ENDIF C C Copy BD to P CALL DCOPY(4*MM, RPAR(P_BD), 1, RPAR(P_P), 1) C C Scale P by -GAMMA CALL DSCAL(4*MM, -GAMMA, RPAR(P_P), 1) C C Perform LU decomposition CALL PREC_LU(MM, RPAR(P_P), IPAR(P_IPP), IER) C RETURN END C ---------------------------------------------------------------- SUBROUTINE FCVPSOL(T, U, FU, R, Z, GAMMA, DELTA, LR, & IPAR, RPAR, VTEMP, IER) C Routine to solve preconditioner linear system. C IMPLICIT NONE C INTEGER IER, LR INTEGER*4 IPAR(*) DOUBLE PRECISION T, U(*), FU(*), R(*), Z(2,*) DOUBLE PRECISION GAMMA, DELTA, RPAR(*) DOUBLE PRECISION VTEMP(*) C INTEGER*4 MM, P_IPP, P_P C IER = 0 C C Extract constants from IPAR and RPAR MM = IPAR(3) C C Extract pointers into IPAR and RPAR P_IPP = IPAR(4) P_P = IPAR(6) C C Copy RHS into Z CALL DCOPY(2*MM, R, 1, Z, 1) C C Solve the block-diagonal system Px = r using LU factors stored in P C and pivot data in IPP, and return the solution in Z. CALL PREC_SOL(MM, RPAR(P_P), IPAR(P_IPP), Z) RETURN END C ---------------------------------------------------------------- SUBROUTINE PREC_JAC(MX, MY, MM, U, BD, & Q1, Q2, Q3, Q4, C3, DY, HDCO, VDCO) C Routine to compute diagonal Jacobian blocks C IMPLICIT NONE C INTEGER*4 MX, MY, MM DOUBLE PRECISION U(2,*), BD(2,2,MM) DOUBLE PRECISION Q1, Q2, Q3, Q4, C3, DY, HDCO, VDCO C INTEGER*4 JY, JX, IBLOK, IBLOK0 DOUBLE PRECISION C1, C2, CYDN, CYUP, DIAG, YDN, YUP C DO JY = 1, MY YDN = 30.0D0 + (JY - 1.5D0) * DY YUP = YDN + DY CYDN = VDCO * EXP(0.2D0 * YDN) CYUP = VDCO * EXP(0.2D0 * YUP) DIAG = -(CYDN + CYUP + 2.0D0 * HDCO) IBLOK0 = (JY - 1) * MX DO JX = 1, MX IBLOK = IBLOK0 + JX C1 = U(1,IBLOK) C2 = U(2,IBLOK) BD(1,1,IBLOK) = (-Q1 * C3 - Q2 * C2) + DIAG BD(1,2,IBLOK) = -Q2 * C1 + Q4 BD(2,1,IBLOK) = Q1 * C3 - Q2 * C2 BD(2,2,IBLOK) = (-Q2 * C1 - Q4) + DIAG ENDDO ENDDO RETURN END C ---------------------------------------------------------------- SUBROUTINE PREC_LU(MM, P, IPP, IER) C Routine to perform LU decomposition on (P+I) C IMPLICIT NONE C INTEGER IER INTEGER*4 MM, IPP(2,MM) DOUBLE PRECISION P(2,2,MM) C INTEGER*4 I C C Add identity matrix and do LU decompositions on blocks, in place. DO I = 1, MM P(1,1,I) = P(1,1,I) + 1.0D0 P(2,2,I) = P(2,2,I) + 1.0D0 CALL DGEFA(P(1,1,I), 2, 2, IPP(1,I), IER) IF (IER .NE. 0) RETURN ENDDO C RETURN END C ---------------------------------------------------------------- SUBROUTINE PREC_SOL(MM, P, IPP, Z) C Routine for backsolve C IMPLICIT NONE C INTEGER*4 MM, IPP(2,MM) DOUBLE PRECISION P(2,2,MM), Z(2,MM) C INTEGER*4 I C DO I = 1, MM CALL DGESL(P(1,1,I), 2, 2, IPP(1,I), Z(1,I), 0) ENDDO RETURN END C ---------------------------------------------------------------- subroutine dgefa(a, lda, n, ipvt, info) c implicit none c integer info, idamax, j, k, kp1, l, nm1, n integer*4 lda, ipvt(1) double precision a(lda,1), t c c dgefa factors a double precision matrix by gaussian elimination. c c dgefa is usually called by dgeco, but it can be called c directly with a saving in time if rcond is not needed. c (time for dgeco) = (1 + 9/n)*(time for dgefa) . c c on entry c c a double precision(lda, n) c the matrix to be factored. c c lda integer c the leading dimension of the array a . c c n integer c the order of the matrix a . c c on return c c a an upper triangular matrix and the multipliers c which were used to obtain it. c the factorization can be written a = l*u where c l is a product of permutation and unit lower c triangular matrices and u is upper triangular. c c ipvt integer(n) c an integer vector of pivot indices. c c info integer c = 0 normal value. c = k if u(k,k) .eq. 0.0 . this is not an error c condition for this subroutine, but it does c indicate that dgesl or dgedi will divide by zero c if called. employ rcond in dgeco for a reliable c indication of singularity. c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas daxpy,dscal,idamax c c internal variables c c gaussian elimination with partial pivoting c info = 0 nm1 = n - 1 if (nm1 .lt. 1) go to 70 do 60 k = 1, nm1 kp1 = k + 1 c c find l = pivot index c l = idamax(n - k + 1, a(k,k), 1) + k - 1 ipvt(k) = l c c zero pivot implies this column already triangularized c if (a(l,k) .eq. 0.0d0) go to 40 c c interchange if necessary c if (l .eq. k) go to 10 t = a(l,k) a(l,k) = a(k,k) a(k,k) = t 10 continue c c compute multipliers c t = -1.0d0 / a(k,k) call dscal(n - k, t, a(k + 1,k), 1) c c row elimination with column indexing c do 30 j = kp1, n t = a(l,j) if (l .eq. k) go to 20 a(l,j) = a(k,j) a(k,j) = t 20 continue call daxpy(n - k, t, a(k + 1,k), 1, a(k + 1,j), 1) 30 continue go to 50 40 continue info = k 50 continue 60 continue 70 continue ipvt(n) = n if (a(n,n) .eq. 0.0d0) info = n return end C ---------------------------------------------------------------- subroutine dgesl(a, lda, n, ipvt, b, job) c implicit none c integer lda, n, job, k, kb, l, nm1 integer*4 ipvt(1) double precision a(lda,1), b(1), ddot, t c c dgesl solves the double precision system c a * x = b or trans(a) * x = b c using the factors computed by dgeco or dgefa. c c on entry c c a double precision(lda, n) c the output from dgeco or dgefa. c c lda integer c the leading dimension of the array a . c c n integer c the order of the matrix a . c c ipvt integer(n) c the pivot vector from dgeco or dgefa. c c b double precision(n) c the right hand side vector. c c job integer c = 0 to solve a*x = b , c = nonzero to solve trans(a)*x = b where c trans(a) is the transpose. c c on return c c b the solution vector x . c c error condition c c a division by zero will occur if the input factor contains a c zero on the diagonal. technically this indicates singularity c but it is often caused by improper arguments or improper c setting of lda . it will not occur if the subroutines are c called correctly and if dgeco has set rcond .gt. 0.0 c or dgefa has set info .eq. 0 . c c to compute inverse(a) * c where c is a matrix c with p columns c call dgeco(a,lda,n,ipvt,rcond,z) c if (rcond is too small) go to ... c do 10 j = 1, p c call dgesl(a,lda,n,ipvt,c(1,j),0) c 10 continue c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas daxpy,ddot c c internal variables c nm1 = n - 1 if (job .ne. 0) go to 50 c c job = 0 , solve a * x = b c first solve l*y = b c if (nm1 .lt. 1) go to 30 do 20 k = 1, nm1 l = ipvt(k) t = b(l) if (l .eq. k) go to 10 b(l) = b(k) b(k) = t 10 continue call daxpy(n - k, t, a(k + 1,k), 1, b(k + 1), 1) 20 continue 30 continue c c now solve u*x = y c do 40 kb = 1, n k = n + 1 - kb b(k) = b(k) / a(k,k) t = -b(k) call daxpy(k - 1, t, a(1,k), 1, b(1), 1) 40 continue go to 100 50 continue c c job = nonzero, solve trans(a) * x = b c first solve trans(u)*y = b c do 60 k = 1, n t = ddot(k - 1, a(1,k), 1, b(1), 1) b(k) = (b(k) - t) / a(k,k) 60 continue c c now solve trans(l)*x = y c if (nm1 .lt. 1) go to 90 do 80 kb = 1, nm1 k = n - kb b(k) = b(k) + ddot(n - k, a(k + 1,k), 1, b(k + 1), 1) l = ipvt(k) if (l .eq. k) go to 70 t = b(l) b(l) = b(k) b(k) = t 70 continue 80 continue 90 continue 100 continue return end C ---------------------------------------------------------------- subroutine daxpy(n, da, dx, incx, dy, incy) c c constant times a vector plus a vector. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c implicit none c integer i, incx, incy, ix, iy, m, mp1 integer*4 n double precision dx(1), dy(1), da c if (n .le. 0) return if (da .eq. 0.0d0) return if (incx .eq. 1 .and. incy .eq. 1) go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if (incx .lt. 0) ix = (-n + 1) * incx + 1 if (incy .lt. 0) iy = (-n + 1) * incy + 1 do 10 i = 1, n dy(iy) = dy(iy) + da * dx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n, 4) if ( m .eq. 0 ) go to 40 do 30 i = 1, m dy(i) = dy(i) + da * dx(i) 30 continue if ( n .lt. 4 ) return 40 mp1 = m + 1 do 50 i = mp1, n, 4 dy(i) = dy(i) + da * dx(i) dy(i + 1) = dy(i + 1) + da * dx(i + 1) dy(i + 2) = dy(i + 2) + da * dx(i + 2) dy(i + 3) = dy(i + 3) + da * dx(i + 3) 50 continue return end C ---------------------------------------------------------------- subroutine dscal(n, da, dx, incx) c c scales a vector by a constant. c uses unrolled loops for increment equal to one. c jack dongarra, linpack, 3/11/78. c implicit none c integer i, incx, m, mp1, nincx integer*4 n double precision da, dx(1) c if (n.le.0) return if (incx .eq. 1) go to 20 c c code for increment not equal to 1 c nincx = n * incx do 10 i = 1, nincx, incx dx(i) = da * dx(i) 10 continue return c c code for increment equal to 1 c c c clean-up loop c 20 m = mod(n, 5) if ( m .eq. 0 ) go to 40 do 30 i = 1, m dx(i) = da * dx(i) 30 continue if ( n .lt. 5 ) return 40 mp1 = m + 1 do 50 i = mp1, n, 5 dx(i) = da * dx(i) dx(i + 1) = da * dx(i + 1) dx(i + 2) = da * dx(i + 2) dx(i + 3) = da * dx(i + 3) dx(i + 4) = da * dx(i + 4) 50 continue return end C ---------------------------------------------------------------- double precision function ddot(n, dx, incx, dy, incy) c c forms the dot product of two vectors. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c implicit none c integer i, incx, incy, ix, iy, m, mp1 integer*4 n double precision dx(1), dy(1), dtemp c ddot = 0.0d0 dtemp = 0.0d0 if (n .le. 0) return if (incx .eq. 1 .and. incy .eq. 1) go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if (incx .lt. 0) ix = (-n + 1) * incx + 1 if (incy .lt. 0) iy = (-n + 1) * incy + 1 do 10 i = 1, n dtemp = dtemp + dx(ix) * dy(iy) ix = ix + incx iy = iy + incy 10 continue ddot = dtemp return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n, 5) if ( m .eq. 0 ) go to 40 do 30 i = 1,m dtemp = dtemp + dx(i) * dy(i) 30 continue if ( n .lt. 5 ) go to 60 40 mp1 = m + 1 do 50 i = mp1, n, 5 dtemp = dtemp + dx(i) * dy(i) + dx(i + 1) * dy(i + 1) + * dx(i + 2) * dy(i + 2) + dx(i + 3) * dy(i + 3) + * dx(i + 4) * dy(i + 4) 50 continue 60 ddot = dtemp return end C ---------------------------------------------------------------- integer function idamax(n, dx, incx) c c finds the index of element having max. absolute value. c jack dongarra, linpack, 3/11/78. c implicit none c integer i, incx, ix integer*4 n double precision dx(1), dmax c idamax = 0 if (n .lt. 1) return idamax = 1 if (n .eq. 1) return if (incx .eq. 1) go to 20 c c code for increment not equal to 1 c ix = 1 dmax = abs(dx(1)) ix = ix + incx do 10 i = 2, n if (abs(dx(ix)) .le. dmax) go to 5 idamax = i dmax = abs(dx(ix)) 5 ix = ix + incx 10 continue return c c code for increment equal to 1 c 20 dmax = abs(dx(1)) do 30 i = 2, n if (abs(dx(i)) .le. dmax) go to 30 idamax = i dmax = abs(dx(i)) 30 continue return end C ---------------------------------------------------------------- subroutine dcopy(n, dx, incx, dy, incy) c c copies a vector, x, to a vector, y. c uses unrolled loops for increments equal to one. c jack dongarra, linpack, 3/11/78. c implicit none c integer i, incx, incy, ix, iy, m, mp1 integer*4 n double precision dx(1), dy(1) c if (n .le. 0) return if (incx .eq. 1 .and. incy .eq. 1) go to 20 c c code for unequal increments or equal increments c not equal to 1 c ix = 1 iy = 1 if (incx .lt. 0) ix = (-n + 1) * incx + 1 if (incy .lt. 0) iy = (-n + 1) * incy + 1 do 10 i = 1, n dy(iy) = dx(ix) ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n, 7) if ( m .eq. 0 ) go to 40 do 30 i = 1, m dy(i) = dx(i) 30 continue if ( n .lt. 7 ) return 40 mp1 = m + 1 do 50 i = mp1, n, 7 dy(i) = dx(i) dy(i + 1) = dx(i + 1) dy(i + 2) = dx(i + 2) dy(i + 3) = dx(i + 3) dy(i + 4) = dx(i + 4) dy(i + 5) = dx(i + 5) dy(i + 6) = dx(i + 6) 50 continue return end sundials-2.5.0/examples/cvode/fcmix_serial/README0000600000175000017500000000131011741421121022442 0ustar sylvestresylvestreList of serial CVODE FCMIX examples fcvAdvDiff_bnd : advection-diffusion example (BDF/BAND) fcvDiurnal_kry_bp : kinetics-transport example (BDF/SPGMR/FCVBP) fcvDiurnal_kry : kinetics-transport example (BDF/SPGMR/User Prec) fcvRoberts_dns : chemical kinetics example (BDF/DENSE) fcvRoberts_dnsL : chemical kinetics example (BDF/DENSE lapack) Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 sundials-2.5.0/examples/idas/0000755000175000017500000000000011767174700016772 5ustar sylvestresylvestresundials-2.5.0/examples/idas/parallel/0000755000175000017500000000000011767174700020566 5ustar sylvestresylvestresundials-2.5.0/examples/idas/parallel/idasHeat2D_FSA_kry_bbd_p.c0000600000175000017500000007554611741421242025343 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:06:38 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDAS: FSA for 2D heat equation, parallel, * GMRES, IDABBDPRE. * * This example solves a discretized 2D heat equation problem and * performs forward sensitivity analysis with respect to the * diffusion coefficients. This version uses the Krylov solver * IDASpgmr and BBD preconditioning. * * The DAE system solved is a spatial discretization of the PDE * du/dt = p1 * d^2u/dx^2 + p2 * d^2u/dy^2 * on the unit square. The nominal values of the parameters are * p1 = p2 = 1.0. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). * The PDE is treated with central differences on a uniform * MX x MY grid. The values of u at the interior points satisfy * ODEs, and equations u = 0 at the boundaries are appended,\ * to form a DAE system of size N = MX * MY. Here MX = MY = 10. * * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR in conjunction with the preconditioner module IDABBDPRE. * The preconditioner uses a tridiagonal approximation * (half-bandwidths = 1). The constraints u >= 0 are posed for all * components. Local error testing on the boundary values is * suppressed. Output is taken at t = 0, .01, .02, .04, ..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NOUT 11 /* Number of output times */ #define NPEX 2 /* No. PEs in x direction of PE array */ #define NPEY 2 /* No. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* No. x points per subgrid */ #define MYSUB 5 /* No. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ #define NS 2 /* Number of sensitivities (NS<=2) */ typedef struct { realtype p[2]; int thispe, mx, my, ixsub, jysub, npex, npey, mxsub, mysub; long int n_local; realtype dx, dy, coeffx, coeffy, coeffxy; realtype uext[(MXSUB+2)*(MYSUB+2)]; MPI_Comm comm; } *UserData; /* Prototypes of user-supplied and supporting functions */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data); static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]); static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]); static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]); /* Prototypes of private functions */ static int InitUserData(int thispe, MPI_Comm comm, UserData data); static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data); static void PrintHeader(int Neq, realtype rtol, realtype atol, int mudq, int mukeep, booleantype sensi, int sensi_meth, int err_con); static void PrintOutput(int id, void *mem, realtype t, N_Vector uu, booleantype sensi, N_Vector *uuS); static void PrintFinalStats(void *mem); static void ProcessArgs(int argc, char *argv[], int my_pe, booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(int my_pe, char *name); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int thispe, iout, ier, npes; long int Neq, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; realtype *pbar; int is; N_Vector *uuS, *upS; booleantype sensi, err_con; int sensi_meth; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; uuS = upS = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Process arguments */ ProcessArgs(argc, argv, thispe, &sensi, &sensi_meth, &err_con); /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate N-vectors. */ uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* Allocate and initialize the data structure. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and constraints profiles. */ SetInitialProfile(uu, up, id, res, data); N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAInit to initialize solution and various IDASet*** functions to specify optional inputs: - indicate which variables are differential and which are algebraic - exclude algebraic variables from error test - specify additional constraints on solution components */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); /* Specify state tolerances (scalar relative and absolute tolerances) */ ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 12); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize BBD preconditioner. */ mudq = MXSUB; mldq = MXSUB; mukeep = 1; mlkeep = 1; ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&ier, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Sensitivity-related settings */ if( sensi) { /* Allocate and set pbar, the vector with order of magnitude information for the problem parameters. (Note: this is done here as an illustration only, as the default values for pbar, if pbar is not supplied, are anyway 1.0) */ pbar = (realtype *) malloc(NS*sizeof(realtype)); if (check_flag((void *)pbar, "malloc", 2, thispe)) MPI_Abort(comm, 1); for (is=0; isp[is]; /* Allocate sensitivity solution vectors uuS and upS and set them to an initial guess for the sensitivity ICs (the IC for uuS are 0.0 since the state IC do not depend on the porblem parameters; however, the derivatives upS may not and therefore we will have to call IDACalcIC to find them) */ uuS = N_VCloneVectorArray_Parallel(NS, uu); if (check_flag((void *)uuS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1); for (is = 0; is < NS; is++) N_VConst(ZERO,uuS[is]); upS = N_VCloneVectorArray_Parallel(NS, uu); if (check_flag((void *)upS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1); for (is = 0; is < NS; is++) N_VConst(ZERO,upS[is]); /* Initialize FSA using the default internal sensitivity residual function (Note that this requires specifying the problem parameters -- see below) */ ier = IDASensInit(mem, NS, sensi_meth, NULL, uuS, upS); if(check_flag(&ier, "IDASensInit", 1, thispe)) MPI_Abort(comm, 1); /* Indicate the use of internally estimated tolerances for the sensitivity variables (based on the tolerances provided for the states and the pbar values) */ ier = IDASensEEtolerances(mem); if(check_flag(&ier, "IDASensEEtolerances", 1, thispe)) MPI_Abort(comm, 1); /* Specify whether the sensitivity variables are included in the error test or not */ ier = IDASetSensErrCon(mem, err_con); if(check_flag(&ier, "IDASetSensErrCon", 1, thispe)) MPI_Abort(comm, 1); /* Specify the problem parameters and their order of magnitude (Note that we do not specify the index array plist and therefore IDAS will compute sensitivities w.r.t. the first NS parameters) */ ier = IDASetSensParams(mem, data->p, pbar, NULL); if(check_flag(&ier, "IDASetSensParams", 1, thispe)) MPI_Abort(comm, 1); /* Compute consistent initial conditions (Note that this is required only if performing SA since uu and up already contain consistent initial conditions for the states) */ ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1); if(check_flag(&ier, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); } /* Print problem description */ if (thispe == 0 ) PrintHeader(Neq, rtol, atol, mudq, mukeep, sensi, sensi_meth, err_con); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); if (sensi) { ier = IDAGetSens(mem, &tret, uuS); if(check_flag(&ier, "IDAGetSens", 1, thispe)) MPI_Abort(comm, 1); } PrintOutput(thispe, mem, tret, uu, sensi, uuS); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* Free Memory */ IDAFree(&mem); free(data); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * heatres: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. * * This parallel implementation uses several supporting routines. * First a call is made to rescomm to do communication of subgrid boundary * data into array uext. Then reslocal is called to compute the residual * on individual processors and their corresponding domains. The routines * BSend, BRecvPost, and BREcvWait handle interprocessor communication * of uu required to calculate the residual. */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tres, uu, up, data); /* Call reslocal to calculate res. */ retval = reslocal(Nlocal, tres, uu, up, res, data); return(0); } /* * rescomm routine. This routine performs all inter-processor * communication of data in u needed to calculate G. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*MYSUB]; MPI_Comm comm; int thispe, ixsub, jysub, mxsub, mysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(uu); /* Get comm, thispe, subgrid indices, data sizes, extended array uext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; uext = data->uext; /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, mxsub, uext, buffer); return(0); } /* * reslocal routine. Compute res = F(t, uu, up). This routine assumes * that all inter-processor communication of data needed to calculate F * has already been done, and that this data is in the work array uext. */ static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { realtype *uext, *uuv, *upv, *resv; realtype termx, termy; int lx, ly, offsetu, offsetue, locu, locue; int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey; int ixbegin, ixend, jybegin, jyend; UserData data; realtype p1, p2; /* Get subgrid indices, array sizes, extended work array uext. */ data = (UserData) user_data; uext = data->uext; uuv = NV_DATA_P(uu); upv = NV_DATA_P(up); resv = NV_DATA_P(res); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mxsub2 = data->mxsub + 2; mysub = data->mysub; npex = data->npex; npey = data->npey; p1 = data->p[0]; p2 = data->p[1]; /* Initialize all elements of res to uu. This sets the boundary elements simply without indexing hassles. */ N_VScale(ONE, uu, res); /* Copy local segment of u vector into the working extended array uext. This completes uext prior to the computation of the res vector. */ offsetu = 0; offsetue = mxsub2 + 1; for (ly = 0; ly < mysub; ly++) { for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx]; offsetu = offsetu + mxsub; offsetue = offsetue + mxsub2; } /* Set loop limits for the interior of the local subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; /* Loop over all grid points in local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; locue = (lx+1) + (ly+1)*mxsub2; termx = p1 * data->coeffx *(uext[locue-1] - TWO*uext[locue] + uext[locue+1]); termy = p2 * data->coeffy *(uext[locue-mxsub2] - TWO*uext[locue] + uext[locue+mxsub2]); resv[locu] = upv[locu] - (termx + termy); } } return(0); } /* * Routine to send boundary data to neighboring PEs. */ static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]) { int ly, offsetu; realtype bufleft[MYSUB], bufright[MYSUB]; /* If jysub > 0, send data from bottom x-line of u. */ if (jysub != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of u. */ if (jysub != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of u (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*dsizex; bufleft[ly] = uarray[offsetu]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of u (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*MXSUB + (MXSUB-1); bufright[ly] = uarray[offsetu]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm); } return(0); } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in * both calls also. */ static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]) { int offsetue; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+MYSUB; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Irecv(&uext[1], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) { offsetue = (1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm, &request[3]); } return(0); } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have four entries, and should be passed in both * calls also. */ static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]) { int ly, dsizex2, offsetue; realtype *bufleft = buffer, *bufright = buffer+MYSUB; MPI_Status status; dsizex2 = dsizex + 2; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext. */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+1)*dsizex2; uext[offsetue] = bufleft[ly]; } } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+2)*dsizex2 - 1; uext[offsetue] = bufright[ly]; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData initializes the user's data block data. */ static int InitUserData(int thispe, MPI_Comm comm, UserData data) { data->thispe = thispe; data->dx = ONE/(MX-ONE); /* Assumes a [0,1] interval in x. */ data->dy = ONE/(MY-ONE); /* Assumes a [0,1] interval in y. */ data->coeffx = ONE/(data->dx * data->dx); data->coeffy = ONE/(data->dy * data->dy); data->coeffxy = TWO/(data->dx * data->dx) + TWO/(data->dy * data->dy) ; data->jysub = thispe/NPEX; data->ixsub = thispe - data->jysub * NPEX; data->npex = NPEX; data->npey = NPEY; data->mx = MX; data->my = MY; data->mxsub = MXSUB; data->mysub = MYSUB; data->comm = comm; data->n_local = MXSUB*MYSUB; data->p[0] = ONE; data->p[1] = ONE; return(0); } /* * SetInitialProfile sets the initial values for the problem. */ static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data) { int i, iloc, j, jloc, offset, loc, ixsub, jysub; int ixbegin, ixend, jybegin, jyend; realtype xfact, yfact, *udata, *iddata, dx, dy; /* Initialize uu. */ udata = NV_DATA_P(uu); iddata = NV_DATA_P(id); /* Set mesh spacings and subgrid indices for this PE. */ dx = data->dx; dy = data->dy; ixsub = data->ixsub; jysub = data->jysub; /* Set beginning and ending locations in the global array corresponding to the portion of that array assigned to this processor. */ ixbegin = MXSUB*ixsub; ixend = MXSUB*(ixsub+1) - 1; jybegin = MYSUB*jysub; jyend = MYSUB*(jysub+1) - 1; /* Loop over the local array, computing the initial profile value. The global indices are (i,j) and the local indices are (iloc,jloc). Also set the id vector to zero for boundary points, one otherwise. */ N_VConst(ONE,id); for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) { yfact = data->dy*j; offset= jloc*MXSUB; for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) { xfact = data->dx * i; loc = offset + iloc; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO; } } /* Initialize up. */ N_VConst(ZERO, up); /* Initially set up = 0. */ /* heatres sets res to negative of ODE RHS values at interior points. */ heatres(ZERO, uu, up, res, data); /* Copy -res into up to get correct initial up values. */ N_VScale(-ONE, res, up); return(0); } /* * Print first lines of output (problem description) * and table heading */ static void PrintHeader(int Neq, realtype rtol, realtype atol, int mudq, int mukeep, booleantype sensi, int sensi_meth, int err_con) { printf("\nidasHeat2D_FSA_kry_bbd_p: Heat equation, parallel example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions, polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d ; ", MX, MY); printf(" Total system size: %d\n\n", Neq); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("SUPPRESSALG = TRUE to suppress local error testing on"); printf(" all boundary components. \n"); printf("Linear solver: IDASPGMR. "); printf("Preconditioner: IDABBDPRE - Banded-block-diagonal.\n"); printf("Difference quotient half-bandwidths = %d",mudq); printf("Retained matrix half-bandwidths = %d \n\n",mukeep); if (sensi) { printf("Sensitivity: YES "); if(sensi_meth == IDA_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else printf("( STAGGERED +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } else { printf("Sensitivity: NO "); } printf("\n\nOutput Summary: umax = max-norm of solution\n"); printf(" max-norm of sensitivity 1\n"); printf(" max-norm of sensitivity 2\n\n"); printf(" time umax k nst nni nli nre nreLS nge h npe nps\n"); printf(" . . . . . . . . . . . . . . . . . . . . . . . .\n"); } /* * Print integrator statistics and max-norm of solution */ static void PrintOutput(int id, void *mem, realtype t, N_Vector uu, booleantype sensi, N_Vector *uuS) { realtype umax, hused; int kused, ier, is; long int nst, nni, nre, nli, npe, nps, nreLS, nge; umax = N_VMaxNorm(uu); if (id == 0) { ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1, id); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1, id); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1, id); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1, id); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1, id); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1, id); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1, id); ier = IDABBDPrecGetNumGfnEvals(mem, &nge); check_flag(&ier, "IDABBDPrecGetNumGfnEvals", 1, id); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1, id); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1, id); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #endif } if (sensi) { for (is=0; is= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/parallel/idasHeat2D_FSA_kry_bbd_p.out0000600000175000017500000000456311741421242025717 0ustar sylvestresylvestreidasHeat2D_FSA_kry_bbd_p: Heat equation, parallel example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 ; Total system size: 100 Subgrid dimensions: 5 x 5 Processor array: 2 x 2 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. SUPPRESSALG = TRUE to suppress local error testing on all boundary components. Linear solver: IDASPGMR. Preconditioner: IDABBDPRE - Banded-block-diagonal. Difference quotient half-bandwidths = 5Retained matrix half-bandwidths = 1 Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) Output Summary: umax = max-norm of solution max-norm of sensitivity 1 max-norm of sensitivity 2 time umax k nst nni nli nre nreLS nge h npe nps . . . . . . . . . . . . . . . . . . . . . . . . 0.01 8.24107e-01 2 12 17 30 19 30 144 2.56e-03 12 87 7.20970e-02 7.20841e-02 0.02 6.88132e-01 3 15 22 43 24 43 144 5.12e-03 12 115 1.27103e-01 1.27071e-01 0.04 4.70895e-01 3 19 26 60 28 60 144 5.12e-03 12 144 1.81692e-01 1.81794e-01 0.08 2.16325e-01 3 23 31 95 33 95 156 1.02e-02 13 194 1.68436e-01 1.68462e-01 0.16 4.58960e-02 3 29 39 140 41 140 168 1.84e-02 14 263 7.02125e-02 7.03265e-02 0.32 2.29034e-03 3 36 47 200 49 200 180 3.69e-02 15 347 6.22596e-03 6.33303e-03 0.64 2.32389e-05 1 41 55 255 57 255 204 1.47e-01 17 426 7.82118e-05 8.20707e-05 1.28 5.39438e-19 1 43 59 269 61 269 228 5.90e-01 19 452 3.23841e-04 1.68342e-04 2.56 1.44292e-20 1 44 61 272 63 272 240 1.18e+00 20 461 7.70031e-05 1.35511e-04 5.12 3.10555e-20 1 46 64 277 66 277 264 4.72e+00 22 475 3.35209e-04 6.48901e-05 10.24 4.32423e-20 1 47 66 279 68 279 276 9.44e+00 23 483 7.13723e-05 5.93381e-05 Error test failures = 0 Nonlinear convergence failures = 2 Linear convergence failures = 0 sundials-2.5.0/examples/idas/parallel/idasBruss_kry_bbd_p.c0000600000175000017500000010313111741421242024657 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: * $Date: * ----------------------------------------------------------------- * Programmer(s): Cosmin Petra and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDAS: Brusselator, parallel, GMRES, IDABBD * preconditioner. * * This example program for IDAS uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses the * IDABBDPRE band-block-diagonal preconditioner module for the * IDASPGMR package. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. * * The PDE system is a two-species time-dependent PDE known as * Brusselator PDE and models a chemically reacting system. * * * du/dt = eps(u + u) + u^2 v -(B+1)u + A * xx yy * domain [0,L]X[0,L] * dv/dt = eps(v + v) - u^2 v + Bu * xx yy * * B.C. : Neumann * I.C. : u(x,y,t0) = u0(x,y) = 1 - 0.5*cos(pi*y/L) * v(x,y,t0) = v0(x,y) = 3.5 - 2.5*cos(pi*x/L) * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product MX*MY*NUM_SPECIES. * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 2 #define ctL RCONST(1.0) /* Domain =[0,L]^2 */ #define ctA RCONST(1.0) #define ctB RCONST(3.4) #define ctEps RCONST(2.0e-3) #define PI RCONST(3.1415926535898) /* pi */ #define MXSUB 21 /* Number of x mesh points per processor subgrid */ #define MYSUB 21 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) /* User-defined vector accessor macro IJ_Vptr. */ /* * IJ_Vptr is defined in order to express the underlying 3-d structure of the * dependent variable vector from its underlying 1-d storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { int ns, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype A, B, L, eps[NUM_SPECIES]; realtype dx, dy; realtype cox[NUM_SPECIES], coy[NUM_SPECIES]; realtype gridext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; realtype rhs[NUM_SPECIES]; MPI_Comm comm; realtype rates[2]; long int n_local; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data); static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data); /* Prototypes for supporting functions */ static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static void ReactRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData data); /* Prototypes for private functions */ static void InitUserData(UserData data, int thispe, int npes, MPI_Comm comm); static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data); static void PrintHeader(int SystemSize, int maxl, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector uv, realtype time, UserData data, MPI_Comm comm); static void PrintSol(void* mem, N_Vector uv, N_Vector uvp, UserData data, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, tout, tret; N_Vector uv, uvp, resid, id; int thispe, npes, maxl, iout, retval; uv = uvp = resid = id = NULL; data = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block data. */ data = (UserData) malloc(sizeof *data); InitUserData(data, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector resid is used temporarily only. */ uv = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uv, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); uvp = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uvp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); resid = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)resid, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(uv, uvp, id, resid, data); /* Set remaining inputs to IDAS. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAInit to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); retval = IDASetUserData(mem, data); if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); retval = IDAInit(mem, res, t0, uv, uvp); if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDAS LINEAR SOLVER IDASPGMR */ maxl = 16; retval = IDASpgmr(mem, maxl); if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner. The half-bandwidths for the difference quotient evaluation are exact for the system Jacobian, but only a 5-diagonal band matrix is retained. */ mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); retval = IDAGetConsistentIC(mem, uv, uvp); if(check_flag(&retval, "IDAGetConsistentIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, mudq, mldq, mukeep, mlkeep, rtol, atol); PrintOutput(mem, uv, t0, data, comm); /* Call IDAS in tout loop, normal mode, and print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, uv, uvp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, uv, tret, data, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* Print each PE's portion of the solution in a separate file. */ /* PrintSol(mem, uv, uvp, data, comm); */ /* On PE 0, print final set of statistics. */ if (thispe == 0) { PrintFinalStats(mem); } /* Free memory. */ N_VDestroy_Parallel(uv); N_VDestroy_Parallel(uvp); N_VDestroy_Parallel(id); N_VDestroy_Parallel(resid); IDAFree(&mem); free(data); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in data (of type UserData). */ static void InitUserData(UserData data, int thispe, int npes, MPI_Comm comm) { data->jysub = thispe / NPEX; data->ixsub = thispe - (data->jysub)*NPEX; data->mxsub = MXSUB; data->mysub = MYSUB; data->npex = NPEX; data->npey = NPEY; data->ns = NUM_SPECIES; data->dx = ctL/(MX-1); data->dy = ctL/(MY-1); data->thispe = thispe; data->npes = npes; data->nsmxsub = MXSUB * NUM_SPECIES; data->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; data->comm = comm; data->n_local = MXSUB*MYSUB*NUM_SPECIES; data->A = ctA; data->B = ctB; data->L = ctL; data->eps[0] = data->eps[1] = ctEps; } /* * SetInitialProfiles: Set initial conditions in uv, uvp, and id. */ static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data) { int ixsub, jysub, mxsub, mysub, nsmxsub, ix, jy; realtype *idxy, dx, dy, x, y, *uvxy, *uvxy1, L, npex, npey; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; nsmxsub = data->nsmxsub; npex = data->npex; npey = data->npey; dx = data->dx; dy = data->dy; L = data->L; /* Loop over grid, load uv values and id values. */ for (jy = 0; jy < mysub; jy++) { y = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { x = (ix + ixsub*mxsub) * dx; uvxy = IJ_Vptr(uv,ix,jy); uvxy[0] = RCONST(1.0) - HALF*cos(PI*y/L); uvxy[1] = RCONST(3.5) - RCONST(2.5)*cos(PI*x/L); } } N_VConst(ONE, id); if (jysub == 0) { for (ix=0; ixthispe; npelast = data->npes - 1; cdata = NV_DATA_P(uv); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;ithispe; sprintf(szFilename, "ysol%d.txt", thispe); fout = fopen(szFilename, "w+"); if (fout==NULL) { printf("PE[% 2d] is unable to write solution to disk!\n", thispe); return; } mxsub = data->mxsub; mysub = data->mysub; for (jy=0; jy= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * res: System residual function * * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, uv, uvp, user_data); /* Call reslocal to calculate the local portion of residual vector. */ retval = reslocal(Nlocal, tt, uv, uvp, rr, user_data); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the uv vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data) { UserData data; realtype *cdata, *gridext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; data = (UserData) user_data; cdata = NV_DATA_P(uv); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; gridext = data->gridext; nsmxsub = data->nsmxsub; nsmysub = (data->ns)*(data->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, gridext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, gridext, buffer); return(0); } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of uv from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of uv. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of uv. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of uv (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of uv (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (data->mxsub) #define mysub (data->mysub) #define npex (data->npex) #define npey (data->npey) #define ixsub (data->ixsub) #define jysub (data->jysub) #define nsmxsub (data->nsmxsub) #define nsmxsub2 (data->nsmxsub2) #define dx (data->dx) #define dy (data->dy) #define cox (data->cox) #define coy (data->coy) #define gridext (data->gridext) #define eps (data->eps) #define ns (data->ns) /* * reslocal: Compute res = F(t,uv,uvp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the uv vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector data->rates * for use by the preconditioner setup routine. */ static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { realtype *uvdata, *uvpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui, dx2, dy2; realtype ixend, ixstart, jystart, jyend; int ix, jy, is, i, locc, ylocce, locce; realtype rates[2]; UserData data; data = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ uvdata = NV_DATA_P(uv); dx2 = dx * dx; dy2 = dy * dy; /* Copy local segment of uv vector into the working extended array gridext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of uv to gridext. */ /* If jysub = 0, copy x-line 2 of uv to gridext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) gridext[NUM_SPECIES+i] = uvdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of uv to gridext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of uv to gridext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of uv to gridext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately (ODE in the interior and DAE on the boundary)*/ ixend = ixstart = jystart = jyend = 0; if (jysub==0) jystart = 1; if (jysub==npey-1) jyend = 1; if (ixsub==0) ixstart = 1; if (ixsub==npex-1) ixend = 1; for (jy = jystart; jy < mysub-jyend; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = ixstart; ix < mxsub-ixend; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ReactRates(xx, yy, &(gridext[locce]), rates, data); resxy = IJ_Vptr(rr,ix,jy); uvpxy = IJ_Vptr(uvp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = gridext[locce+is] - gridext[locce+is-nsmxsub2]; dcyui = gridext[locce+is+nsmxsub2] - gridext[locce+is]; dcxli = gridext[locce+is] - gridext[locce+is-NUM_SPECIES]; dcxui = gridext[locce+is+NUM_SPECIES] - gridext[locce+is]; resxy[is] = uvpxy[is]- eps[is]*( (dcxui-dcxli)/dx2 + (dcyui-dcyli)/dy2 ) - rates[is]; } } } /* Algebraic equation correspoding to boundary mesh point. */ if (jysub==0) { for (ix=0; ixA; B = data->B; rates[0] = uvval[0]*uvval[0]*uvval[1]; rates[1] = - rates[0]; rates[0] += A-(B+1)*uvval[0]; rates[1] += B*uvval[0]; } sundials-2.5.0/examples/idas/parallel/idasHeat2D_kry_p.c0000600000175000017500000006772211741421242024040 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:38 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, parallel, GMRES. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). * The PDE is treated with central differences on a uniform MX x MY * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = MX * MY. Here MX = MY = 10. * * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR. The preconditioner uses the diagonal elements of the * Jacobian only. Routines for preconditioning, required by * IDASPGMR, are supplied here. The constraints u >= 0 are posed * for all components. Local error testing on the boundary values * is suppressed. Output is taken at t = 0, .01, .02, .04, * ..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NOUT 11 /* Number of output times */ #define NPEX 2 /* No. PEs in x direction of PE array */ #define NPEY 2 /* No. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* No. x points per subgrid */ #define MYSUB 5 /* No. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ typedef struct { long int thispe, mx, my, ixsub, jysub, npex, npey, mxsub, mysub; realtype dx, dy, coeffx, coeffy, coeffxy; realtype uext[(MXSUB+2)*(MYSUB+2)]; N_Vector pp; /* vector of diagonal preconditioner elements */ MPI_Comm comm; } *UserData; /* User-supplied residual function and supporting routines */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data); static int rescomm(N_Vector uu, N_Vector up, void *user_data); static int reslocal(realtype tt, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int BSend(MPI_Comm comm, long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uarray[]); static int BRecvPost(MPI_Comm comm, MPI_Request request[], long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static int BRecvWait(MPI_Request request[], long int ixsub, long int jysub, long int dsizex, realtype uext[], realtype buffer[]); /* User-supplied preconditioner routines */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); int PsetupHeat(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private function to check function return values */ static int InitUserData(int thispe, MPI_Comm comm, UserData data); static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data); static void PrintHeader(long int Neq, realtype rtol, realtype atol); static void PrintOutput(int id, void *mem, realtype t, N_Vector uu); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int iout, thispe, ier, npes; long int Neq, local_N; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate and initialize the data structure and N-vectors. */ data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* An N-vector to hold preconditioner. */ data->pp = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)data->pp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and res profiles. */ SetInitialProfile(uu, up, id, res, data); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution. */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only) and intial solution */ if (thispe == 0) PrintHeader(Neq, rtol, atol); PrintOutput(thispe, mem, t0, uu); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print remaining counters. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); N_VDestroy_Parallel(data->pp); free(data); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. * * This parallel implementation uses several supporting routines. * First a call is made to rescomm to do communication of subgrid boundary * data into array uext. Then reslocal is called to compute the residual * on individual processors and their corresponding domains. The routines * BSend, BRecvPost, and BREcvWait handle interprocessor communication * of uu required to calculate the residual. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { int retval; /* Call rescomm to do inter-processor communication. */ retval = rescomm(uu, up, user_data); /* Call reslocal to calculate res. */ retval = reslocal(tt, uu, up, rr, user_data); return(0); } /* * PsetupHeat: setup for diagonal preconditioner for heatsk. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupHeat argument list. * */ int PsetupHeat(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype *ppv, pelinv; long int lx, ly, ixbegin, ixend, jybegin, jyend, locu, mxsub, mysub; long int ixsub, jysub, npex, npey; UserData data; data = (UserData) user_data; ppv = NV_DATA_P(data->pp); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initially set all pp elements to one. */ N_VConst(ONE, data->pp); /* Prepare to loop over subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; pelinv = ONE/(c_j + data->coeffxy); /* Load the inverse of the preconditioner diagonal elements in loop over all the local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; ppv[locu] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PsetupHeat), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { UserData data; data = (UserData) user_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * rescomm routine. This routine performs all inter-processor * communication of data in u needed to calculate G. */ static int rescomm(N_Vector uu, N_Vector up, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*MYSUB]; MPI_Comm comm; long int thispe, ixsub, jysub, mxsub, mysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(uu); /* Get comm, thispe, subgrid indices, data sizes, extended array uext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; uext = data->uext; /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, mxsub, uext, buffer); return(0); } /* * reslocal routine. Compute res = F(t, uu, up). This routine assumes * that all inter-processor communication of data needed to calculate F * has already been done, and that this data is in the work array uext. */ static int reslocal(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { realtype *uext, *uuv, *upv, *resv; realtype termx, termy, termctr; long int lx, ly, offsetu, offsetue, locu, locue; long int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey; long int ixbegin, ixend, jybegin, jyend; UserData data; /* Get subgrid indices, array sizes, extended work array uext. */ data = (UserData) user_data; uext = data->uext; uuv = NV_DATA_P(uu); upv = NV_DATA_P(up); resv = NV_DATA_P(rr); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mxsub2 = data->mxsub + 2; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initialize all elements of rr to uu. This sets the boundary elements simply without indexing hassles. */ N_VScale(ONE, uu, rr); /* Copy local segment of u vector into the working extended array uext. This completes uext prior to the computation of the rr vector. */ offsetu = 0; offsetue = mxsub2 + 1; for (ly = 0; ly < mysub; ly++) { for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx]; offsetu = offsetu + mxsub; offsetue = offsetue + mxsub2; } /* Set loop limits for the interior of the local subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; /* Loop over all grid points in local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; locue = (lx+1) + (ly+1)*mxsub2; termx = data->coeffx *(uext[locue-1] + uext[locue+1]); termy = data->coeffy *(uext[locue-mxsub2] + uext[locue+mxsub2]); termctr = data->coeffxy*uext[locue]; resv[locu] = upv[locu] - (termx + termy - termctr); } } return(0); } /* * Routine to send boundary data to neighboring PEs. */ static int BSend(MPI_Comm comm, long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uarray[]) { long int ly, offsetu; realtype bufleft[MYSUB], bufright[MYSUB]; /* If jysub > 0, send data from bottom x-line of u. */ if (jysub != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of u. */ if (jysub != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of u (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*dsizex; bufleft[ly] = uarray[offsetu]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of u (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*MXSUB + (MXSUB-1); bufright[ly] = uarray[offsetu]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm); } return(0); } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in * both calls also. */ static int BRecvPost(MPI_Comm comm, MPI_Request request[], long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+MYSUB; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Irecv(&uext[1], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) { offsetue = (1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm, &request[3]); } return(0); } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have four entries, and should be passed in both * calls also. */ static int BRecvWait(MPI_Request request[], long int ixsub, long int jysub, long int dsizex, realtype uext[], realtype buffer[]) { long int ly, dsizex2, offsetue; realtype *bufleft = buffer, *bufright = buffer+MYSUB; MPI_Status status; dsizex2 = dsizex + 2; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext. */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+1)*dsizex2; uext[offsetue] = bufleft[ly]; } } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+2)*dsizex2 - 1; uext[offsetue] = bufright[ly]; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData initializes the user's data block data. */ static int InitUserData(int thispe, MPI_Comm comm, UserData data) { data->thispe = thispe; data->dx = ONE/(MX-ONE); /* Assumes a [0,1] interval in x. */ data->dy = ONE/(MY-ONE); /* Assumes a [0,1] interval in y. */ data->coeffx = ONE/(data->dx * data->dx); data->coeffy = ONE/(data->dy * data->dy); data->coeffxy = TWO/(data->dx * data->dx) + TWO/(data->dy * data->dy) ; data->jysub = thispe/NPEX; data->ixsub = thispe - data->jysub * NPEX; data->npex = NPEX; data->npey = NPEY; data->mx = MX; data->my = MY; data->mxsub = MXSUB; data->mysub = MYSUB; data->comm = comm; return(0); } /* * SetInitialProfile sets the initial values for the problem. */ static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data) { long int i, iloc, j, jloc, offset, loc, ixsub, jysub; long int ixbegin, ixend, jybegin, jyend; realtype xfact, yfact, *udata, *iddata, dx, dy; /* Initialize uu. */ udata = NV_DATA_P(uu); iddata = NV_DATA_P(id); /* Set mesh spacings and subgrid indices for this PE. */ dx = data->dx; dy = data->dy; ixsub = data->ixsub; jysub = data->jysub; /* Set beginning and ending locations in the global array corresponding to the portion of that array assigned to this processor. */ ixbegin = MXSUB*ixsub; ixend = MXSUB*(ixsub+1) - 1; jybegin = MYSUB*jysub; jyend = MYSUB*(jysub+1) - 1; /* Loop over the local array, computing the initial profile value. The global indices are (i,j) and the local indices are (iloc,jloc). Also set the id vector to zero for boundary points, one otherwise. */ N_VConst(ONE,id); for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) { yfact = data->dy*j; offset= jloc*MXSUB; for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) { xfact = data->dx * i; loc = offset + iloc; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO; } } /* Initialize up. */ N_VConst(ZERO, up); /* Initially set up = 0. */ /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct initial up values. */ N_VScale(-ONE, res, up); return(0); } /* * Print first lines of output and table heading */ static void PrintHeader(long int Neq, realtype rtol, realtype atol) { printf("\nidasHeat2D_p: Heat equation, parallel example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %ld\n\n", Neq); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("SUPPRESSALG = TRUE to suppress local error testing on "); printf("all boundary components. \n"); printf("Linear solver: IDASPGMR "); printf("Preconditioner: diagonal elements only.\n"); /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nli nre nreLS h npe nps\n"); printf("----------------------------------------------------------------------\n"); } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(int id, void *mem, realtype t, N_Vector uu) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); if (id == 0) { ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1, id); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1, id); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1, id); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1, id); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1, id); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1, id); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1, id); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1, id); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1, id); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1, id); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } } /* * Print some final integrator statistics */ static void PrintFinalStats(void *mem) { long int netf, ncfn, ncfl; IDAGetNumErrTestFails(mem, &netf); IDAGetNumNonlinSolvConvFails(mem, &ncfn); IDASpilsGetNumConvFails(mem, &ncfl); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/parallel/idasFoodWeb_kry_bbd_p.out0000600000175000017500000000347611741421242025506 0ustar sylvestresylvestreidasFoodWeb_kry_bbd_p: Predator-prey DAE parallel example problem for IDA Number of species ns: 2 Mesh dimensions: 20 x 20 Total system size: 800 Subgrid dimensions: 10 x 10 Processor array: 2 x 2 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDASPGMR Max. Krylov dimension maxl: 16 Preconditioner: band-block-diagonal (IDABBDPRE), with parameters mudq = 20, mldq = 20, mukeep = 2, mlkeep = 2 CalcIC called to correct initial predator concentrations ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+01 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0827e+01 | 33 4 9.7404e-05 1.0319e+05 1.0822e+05 | 1.00e-02 1.6189e+02 1.9735e+02 | 123 3 1.9481e-04 1.6189e+06 1.9735e+06 | 1.00e-01 2.4019e+02 2.7072e+02 | 197 1 4.0396e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+02 | 200 1 3.2316e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+02 | 200 1 3.2316e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+02 | 201 1 6.4633e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final statistics: Number of steps = 201 Number of residual evaluations = 1110 Number of nonlinear iterations = 245 Number of error test failures = 0 Number of nonlinear conv. failures = 0 Number of linear iterations = 863 Number of linear conv. failures = 0 Number of preconditioner setups = 26 Number of preconditioner solves = 1110 Number of local residual evals. = 1092 sundials-2.5.0/examples/idas/parallel/CMakeLists.txt0000600000175000017500000000770611741421242023314 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for IDAS parallel examples # Add variable IDAS_examples with the names of the parallel IDAS examples SET(IDAS_examples idasBruss_ASAp_kry_bbd_p idasBruss_FSA_kry_bbd_p idasBruss_kry_bbd_p idasFoodWeb_kry_bbd_p idasFoodWeb_kry_p idasHeat2D_FSA_kry_bbd_p idasHeat2D_kry_bbd_p idasHeat2D_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the C compiler to the MPICC script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDAS_LIB sundials_idas_static) SET(NVECP_LIB sundials_nvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDAS_LIB sundials_idas_shared) SET(NVECP_LIB sundials_nvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${IDAS_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each IDAS example FOREACH(example ${IDAS_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPICC) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPICC) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDAS_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDAS") SET(SOLVER_LIB "sundials_idas") LIST2STRING(IDAS_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/idas/parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/idas/parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/idas/parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/idas/parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/idas/parallel/Makefile.in0000600000175000017500000000725311741421242022616 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.11 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDA parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/idas/libsundials_idas.la $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = idasBruss_ASAp_kry_bbd_p \ idasBruss_FSA_kry_bbd_p \ idasBruss_kry_bbd_p \ idasFoodWeb_kry_bbd_p \ idasFoodWeb_kry_p \ idasHeat2D_FSA_kry_bbd_p \ idasHeat2D_kry_bbd_p \ idasHeat2D_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(SUNDIALS_INCS) -I$(MPI_INC_DIR) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(MPICC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}$(OBJ_EXT) $(MPI_FLAGS) $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/idas/parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/idas/parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/idas/parallel/README $(EXS_INSTDIR)/idas/parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/parallel/$${i}.c $(EXS_INSTDIR)/idas/parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/parallel/$${i}.out $(EXS_INSTDIR)/idas/parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/idas/parallel/Makefile rm -f $(EXS_INSTDIR)/idas/parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/idas/parallel/$${i}.c ; \ rm -f $(EXS_INSTDIR)/idas/parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/idas/parallel $(rminstalldirs) $(EXS_INSTDIR)/idas clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/idas/parallel/idasHeat2D_kry_bbd_p.c0000600000175000017500000006440211741421242024637 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:06:38 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, parallel, GMRES, * IDABBDPRE. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr and BBD * preconditioning. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform MX x MY * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = MX * MY. Here MX = MY = 10. * * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR in conjunction with the preconditioner module IDABBDPRE. * The preconditioner uses a tridiagonal approximation * (half-bandwidths = 1). The constraints u >= 0 are posed for all * components. Local error testing on the boundary values is * suppressed. Output is taken at t = 0, .01, .02, .04, ..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NOUT 11 /* Number of output times */ #define NPEX 2 /* No. PEs in x direction of PE array */ #define NPEY 2 /* No. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* No. x points per subgrid */ #define MYSUB 5 /* No. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ typedef struct { int thispe, mx, my, ixsub, jysub, npex, npey, mxsub, mysub; int n_local; realtype dx, dy, coeffx, coeffy, coeffxy; realtype uext[(MXSUB+2)*(MYSUB+2)]; MPI_Comm comm; } *UserData; /* Prototypes of user-supplied and supporting functions */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data); static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]); static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]); static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]); /* Prototypes of private functions */ static int InitUserData(int thispe, MPI_Comm comm, UserData data); static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data); static void PrintHeader(long int Neq, realtype rtol, realtype atol); static void PrintCase(int case_number, int mudq, int mukeep); static void PrintOutput(int id, void *mem, realtype t, N_Vector uu); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int thispe, iout, ier, npes; long int Neq, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate N-vectors. */ uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* Allocate and initialize the data structure. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and constraints profiles. */ SetInitialProfile(uu, up, id, res, data); N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); mudq = MXSUB; mldq = MXSUB; mukeep = 1; mlkeep = 1; /* Print problem description */ if (thispe == 0 ) PrintHeader(Neq, rtol, atol); /* * ----------------------------- * Case 1 -- mldq = mudq = MXSUB * ----------------------------- */ /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize BBD preconditioner. */ ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&ier, "IDABBDPrecAlloc", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only) and initial solution. */ if (thispe == 0) PrintCase(1, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* * ----------------------------- * Case 2 -- mldq = mudq = 1 * ----------------------------- */ mudq = 1; mldq = 1; /* Re-initialize the uu and up profiles. */ SetInitialProfile(uu, up, id, res, data); /* Call IDAReInit to re-initialize IDA. */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecReInit to re-initialize BBD preconditioner. */ ier = IDABBDPrecReInit(mem, mudq, mldq, ZERO); if(check_flag(&ier, "IDABBDPrecReInit", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only). */ if (thispe == 0) PrintCase(2, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* Free Memory */ IDAFree(&mem); free(data); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * heatres: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. * * This parallel implementation uses several supporting routines. * First a call is made to rescomm to do communication of subgrid boundary * data into array uext. Then reslocal is called to compute the residual * on individual processors and their corresponding domains. The routines * BSend, BRecvPost, and BREcvWait handle interprocessor communication * of uu required to calculate the residual. */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tres, uu, up, data); /* Call reslocal to calculate res. */ retval = reslocal(Nlocal, tres, uu, up, res, data); return(0); } /* * rescomm routine. This routine performs all inter-processor * communication of data in u needed to calculate G. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*MYSUB]; MPI_Comm comm; int thispe, ixsub, jysub, mxsub, mysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(uu); /* Get comm, thispe, subgrid indices, data sizes, extended array uext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; uext = data->uext; /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, mxsub, uext, buffer); return(0); } /* * reslocal routine. Compute res = F(t, uu, up). This routine assumes * that all inter-processor communication of data needed to calculate F * has already been done, and that this data is in the work array uext. */ static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { realtype *uext, *uuv, *upv, *resv; realtype termx, termy, termctr; int lx, ly, offsetu, offsetue, locu, locue; int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey; int ixbegin, ixend, jybegin, jyend; UserData data; /* Get subgrid indices, array sizes, extended work array uext. */ data = (UserData) user_data; uext = data->uext; uuv = NV_DATA_P(uu); upv = NV_DATA_P(up); resv = NV_DATA_P(res); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mxsub2 = data->mxsub + 2; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initialize all elements of res to uu. This sets the boundary elements simply without indexing hassles. */ N_VScale(ONE, uu, res); /* Copy local segment of u vector into the working extended array uext. This completes uext prior to the computation of the res vector. */ offsetu = 0; offsetue = mxsub2 + 1; for (ly = 0; ly < mysub; ly++) { for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx]; offsetu = offsetu + mxsub; offsetue = offsetue + mxsub2; } /* Set loop limits for the interior of the local subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; /* Loop over all grid points in local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; locue = (lx+1) + (ly+1)*mxsub2; termx = data->coeffx *(uext[locue-1] + uext[locue+1]); termy = data->coeffy *(uext[locue-mxsub2] + uext[locue+mxsub2]); termctr = data->coeffxy*uext[locue]; resv[locu] = upv[locu] - (termx + termy - termctr); } } return(0); } /* * Routine to send boundary data to neighboring PEs. */ static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]) { int ly, offsetu; realtype bufleft[MYSUB], bufright[MYSUB]; /* If jysub > 0, send data from bottom x-line of u. */ if (jysub != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of u. */ if (jysub != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of u (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*dsizex; bufleft[ly] = uarray[offsetu]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of u (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*MXSUB + (MXSUB-1); bufright[ly] = uarray[offsetu]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm); } return(0); } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in * both calls also. */ static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]) { int offsetue; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+MYSUB; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Irecv(&uext[1], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) { offsetue = (1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm, &request[3]); } return(0); } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have four entries, and should be passed in both * calls also. */ static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]) { int ly, dsizex2, offsetue; realtype *bufleft = buffer, *bufright = buffer+MYSUB; MPI_Status status; dsizex2 = dsizex + 2; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext. */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+1)*dsizex2; uext[offsetue] = bufleft[ly]; } } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+2)*dsizex2 - 1; uext[offsetue] = bufright[ly]; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData initializes the user's data block data. */ static int InitUserData(int thispe, MPI_Comm comm, UserData data) { data->thispe = thispe; data->dx = ONE/(MX-ONE); /* Assumes a [0,1] interval in x. */ data->dy = ONE/(MY-ONE); /* Assumes a [0,1] interval in y. */ data->coeffx = ONE/(data->dx * data->dx); data->coeffy = ONE/(data->dy * data->dy); data->coeffxy = TWO/(data->dx * data->dx) + TWO/(data->dy * data->dy) ; data->jysub = thispe/NPEX; data->ixsub = thispe - data->jysub * NPEX; data->npex = NPEX; data->npey = NPEY; data->mx = MX; data->my = MY; data->mxsub = MXSUB; data->mysub = MYSUB; data->comm = comm; data->n_local = MXSUB*MYSUB; return(0); } /* * SetInitialProfile sets the initial values for the problem. */ static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data) { int i, iloc, j, jloc, offset, loc, ixsub, jysub; int ixbegin, ixend, jybegin, jyend; realtype xfact, yfact, *udata, *iddata, dx, dy; /* Initialize uu. */ udata = NV_DATA_P(uu); iddata = NV_DATA_P(id); /* Set mesh spacings and subgrid indices for this PE. */ dx = data->dx; dy = data->dy; ixsub = data->ixsub; jysub = data->jysub; /* Set beginning and ending locations in the global array corresponding to the portion of that array assigned to this processor. */ ixbegin = MXSUB*ixsub; ixend = MXSUB*(ixsub+1) - 1; jybegin = MYSUB*jysub; jyend = MYSUB*(jysub+1) - 1; /* Loop over the local array, computing the initial profile value. The global indices are (i,j) and the local indices are (iloc,jloc). Also set the id vector to zero for boundary points, one otherwise. */ N_VConst(ONE,id); for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) { yfact = data->dy*j; offset= jloc*MXSUB; for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) { xfact = data->dx * i; loc = offset + iloc; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO; } } /* Initialize up. */ N_VConst(ZERO, up); /* Initially set up = 0. */ /* heatres sets res to negative of ODE RHS values at interior points. */ heatres(ZERO, uu, up, res, data); /* Copy -res into up to get correct initial up values. */ N_VScale(-ONE, res, up); return(0); } /* * Print first lines of output (problem description) * and table heading */ static void PrintHeader(long int Neq, realtype rtol, realtype atol) { printf("idasHeat2D_kry_bbd_p: Heat equation, parallel example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n\n", Neq); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("SUPPRESSALG = TRUE to suppress local error testing on"); printf(" all boundary components. \n"); printf("Linear solver: IDASPGMR. "); printf("Preconditioner: IDABBDPRE - Banded-block-diagonal.\n"); } /* * Print case and table header */ static void PrintCase(int case_number, int mudq, int mukeep) { printf("\n\nCase %1d. \n", case_number); printf(" Difference quotient half-bandwidths = %d",mudq); printf(" Retained matrix half-bandwidths = %d \n",mukeep); /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nli nre nreLS nge h npe nps\n"); printf(" . . . . . . . . . . . . . . . . . . . . . . . .\n"); } /* * Print integrator statistics and max-norm of solution */ static void PrintOutput(int id, void *mem, realtype t, N_Vector uu) { realtype umax, hused; int kused, ier; long int nst, nni, nre, nli, npe, nps, nreLS, nge; umax = N_VMaxNorm(uu); if (id == 0) { ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1, id); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1, id); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1, id); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1, id); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1, id); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1, id); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1, id); ier = IDABBDPrecGetNumGfnEvals(mem, &nge); check_flag(&ier, "IDABBDPrecGetNumGfnEvals", 1, id); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1, id); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1, id); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #endif } } /* * Print some final integrator statistics */ static void PrintFinalStats(void *mem) { long int netf, ncfn, ncfl; IDAGetNumErrTestFails(mem, &netf); IDAGetNumNonlinSolvConvFails(mem, &ncfn); IDASpilsGetNumConvFails(mem, &ncfl); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/parallel/idasBruss_ASAp_kry_bbd_p.out0000600000175000017500000000320411741421242026110 0ustar sylvestresylvestreBRUSSELATOR: chemically reacting system Number of species ns: 2 Mesh dimensions: 42 x 42 Total system size: 3528 Subgrid dimensions: 21 x 21 Processor array: 2 x 2 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDASPGMR Max. Krylov dimension maxl: 16 Preconditioner: band-block-diagonal (IDABBDPRE), with parameters mudq = 42, mldq = 42, mukeep = 2, mlkeep = 2 ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 1.00e+00 2.6132e-01 3.0982e+00 | 154 5 1.1112e-02 1.9993e+00 1.0125e+00 | ----------------------------------------------------------- Final statistics: Number of steps = 154 Number of residual evaluations = 392 Number of nonlinear iterations = 174 Number of error test failures = 2 Number of nonlinear conv. failures = 0 Number of linear iterations = 216 Number of linear conv. failures = 0 Number of preconditioner setups = 17 Number of preconditioner solves = 392 Number of local residual evals. = 1462 BACKWARD problem ----------------------------------------------------------- Final statistics: Number of steps = 99 Number of residual evaluations = 268 Number of nonlinear iterations = 118 Number of error test failures = 0 Number of nonlinear conv. failures = 0 Number of linear iterations = 150 Number of linear conv. failures = 0 Number of preconditioner setups = 16 Number of preconditioner solves = 268 Number of local residual evals. = 1376 sundials-2.5.0/examples/idas/parallel/idasFoodWeb_kry_p.c0000600000175000017500000012042411741421242024303 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:06:38 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web, parallel, GMRES, user * preconditioner. * * This example program for IDAS uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses a * block-diagonal preconditioner (setup and solve routines) for the * IDASPGMR package. It was originally run on a Sun SPARC cluster * and used MPICH. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * Note: The above equations are written in 1-based indices, * whereas the code has 0-based indices, being written in C. * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product * MX * MY * NUM_SPECIES. The system is actually implemented on * submeshes, processor by processor, with an MXSUB by MYSUB mesh * on each of NPEX * NPEY processors. * * The DAE system is solved by IDAS using the IDASPGMR linear * solver, which uses the preconditioned GMRES iterative method to * solve linear systems. The precondtioner supplied to IDASPGMR is * the block-diagonal part of the Jacobian with ns by ns blocks * arising from the reaction terms only. Output is printed at * t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Journal of Applied Mathematics and Computation, Vol. 31 * (May 1989), pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include /* Problem Constants. */ #define NPREY 1 /* Number of prey (= number of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) /* pi */ #define FOURPI (RCONST(4.0)*PI) /* 4 pi */ #define MXSUB 10 /* Number of x mesh points per processor subgrid */ #define MYSUB 10 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ /* User-defined vector accessor macro IJ_Vptr. */ /* IJ_Vptr is defined in order to express the underlying 3-d structure of the dependent variable vector from its underlying 1-d storage (an N_Vector). IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { long int ns; int np, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES], rhs[NUM_SPECIES], cext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; MPI_Comm comm; N_Vector rates; realtype **PP[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; N_Vector ewt; void *ida_mem; } *UserData; /* Prototypes for user-supplied and supporting functions. */ static int resweb(realtype time, N_Vector cc, N_Vector cp, N_Vector resval, void *user_data); static int Precondbd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); static int PSolvebd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype cj, realtype delta, void *user_data, N_Vector tempv); static int rescomm(N_Vector cc, N_Vector cp, void *user_data); static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static int reslocal(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(int size, realtype *x1, realtype *x2); /* Prototypes for private Helper Functions. */ static UserData AllocUserData(MPI_Comm comm, long int local_N, long int SystemSize); static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm); static void FreeUserData(UserData webdata); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector scrtch, UserData webdata); static void PrintHeader(long int SystemSize, int maxl, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector cc, realtype time, UserData webdata, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData webdata; long int SystemSize, local_N; realtype rtol, atol, t0, tout, tret; N_Vector cc, cp, res, id; int thispe, npes, maxl, iout, flag; cc = cp = res = id = NULL; webdata = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block webdata. */ webdata = AllocUserData(comm, local_N, SystemSize); if (check_flag((void *)webdata, "AllocUserData", 0, thispe)) MPI_Abort(comm, 1); InitUserData(webdata, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector res is used temporarily only. */ cc = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); cp = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(cc, cp, id, res, webdata); N_VDestroy(res); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize IDA. A pointer to IDA problem memory is returned and stored in idamem. */ mem = IDACreate(); if (check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); flag = IDASetUserData(mem, webdata); if (check_flag(&flag, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); flag = IDASetId(mem, id); if (check_flag(&flag, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); flag = IDAInit(mem, resweb, t0, cc, cp); if (check_flag(&flag, "IDAinit", 1, thispe)) MPI_Abort(comm, 1); flag = IDASStolerances(mem, rtol, atol); if (check_flag(&flag, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); webdata->ida_mem = mem; /* Call IDASpgmr to specify the IDA linear solver IDASPGMR and specify the preconditioner routines supplied (Precondbd and PSolvebd). maxl (max. Krylov subspace dim.) is set to 16. */ maxl = 16; flag = IDASpgmr(mem, maxl); if (check_flag(&flag, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); flag = IDASpilsSetPreconditioner(mem, Precondbd, PSolvebd); if (check_flag(&flag, "IDASpilsSetPreconditioner", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if (check_flag(&flag, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, rtol, atol); PrintOutput(mem, cc, t0, webdata, comm); /* Loop over iout, call IDASolve (normal mode), print selected output. */ for (iout = 1; iout <= NOUT; iout++) { flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if (check_flag(&flag, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, cc, tret, webdata, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* On PE 0, print final set of statistics. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory. */ N_VDestroy_Parallel(cc); N_VDestroy_Parallel(cp); N_VDestroy_Parallel(id); IDAFree(&mem); FreeUserData(webdata); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * AllocUserData: Allocate memory for data structure of type UserData. */ static UserData AllocUserData(MPI_Comm comm, long int local_N, long int SystemSize) { int ix, jy; UserData webdata; webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize); for (ix = 0; ix < MXSUB; ix++) { for (jy = 0; jy < MYSUB; jy++) { (webdata->PP)[ix][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (webdata->pivot)[ix][jy] = newLintArray(NUM_SPECIES); } } webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); webdata->ewt = N_VNew_Parallel(comm, local_N, SystemSize); return(webdata); } /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2, **acoef, *bcoef, *cox, *coy; webdata->jysub = thispe / NPEX; webdata->ixsub = thispe - (webdata->jysub)*NPEX; webdata->mxsub = MXSUB; webdata->mysub = MYSUB; webdata->npex = NPEX; webdata->npey = NPEY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->thispe = thispe; webdata->npes = npes; webdata->nsmxsub = MXSUB * NUM_SPECIES; webdata->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; webdata->comm = comm; /* Set up the coefficients a and b plus others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); acoef = webdata->acoef; bcoef = webdata->bcoef; cox = webdata->cox; coy = webdata->coy; for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * FreeUserData: Free webdata memory. */ static void FreeUserData(UserData webdata) { int ix, jy; for (ix = 0; ix < MXSUB; ix++) { for (jy = 0; jy < MYSUB; jy++) { destroyMat((webdata->PP)[ix][jy]); destroyArray((webdata->pivot)[ix][jy]); } } destroyMat(webdata->acoef); N_VDestroy_Parallel(webdata->rates); N_VDestroy_Parallel(webdata->ewt); free(webdata); } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector res, UserData webdata) { int ixsub, jysub, mxsub, mysub, nsmxsub, np, ix, jy, is; realtype *cxy, *idxy, *cpxy, dx, dy, xx, yy, xyfactor; ixsub = webdata->ixsub; jysub = webdata->jysub; mxsub = webdata->mxsub; mysub = webdata->mxsub; nsmxsub = webdata->nsmxsub; dx = webdata->dx; dy = webdata->dy; np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix + ixsub*mxsub) * dx; xyfactor = RCONST(16.0)*xx*(ONE - xx)*yy*(ONE - yy); xyfactor *= xyfactor; cxy = IJ_Vptr(cc,ix,jy); idxy = IJ_Vptr(id,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) { cxy[is] = RCONST(10.0) + (realtype)(is+1)*xyfactor; idxy[is] = ONE; } else { cxy[is] = 1.0e5; idxy[is] = ZERO; } } } } /* Set c' for the prey by calling the residual function with cp = 0. */ N_VConst(ZERO, cp); resweb(ZERO, cc, cp, res, webdata); N_VScale(-ONE, res, cp); /* Set c' for predators to 0. */ for (jy = 0; jy < mysub; jy++) { for (ix = 0; ix < mxsub; ix++) { cpxy = IJ_Vptr(cp,ix,jy); for (is = np; is < NUM_SPECIES; is++) cpxy[is] = ZERO; } } } /* * Print first lines of output (problem description) */ static void PrintHeader(long int SystemSize, int maxl, realtype rtol, realtype atol) { printf("\nidasFoodWeb_kry_p: Predator-prey DAE parallel example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n",SystemSize); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDASPGMR Max. Krylov dimension maxl: %d\n", maxl); printf("Preconditioner: block diagonal, block size ns,"); printf(" via difference quotients\n"); printf("CalcIC called to correct initial predator concentrations \n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of c1 and c2 * are printed for the bottom left and top right grid points only. * (NOTE: This routine is specific to the case NUM_SPECIES = 2.) */ static void PrintOutput(void *mem, N_Vector cc, realtype tt, UserData webdata, MPI_Comm comm) { MPI_Status status; realtype *cdata, clast[2], hused; long int nst; int i, kused, flag, thispe, npelast, ilast;; thispe = webdata->thispe; npelast = webdata->npes - 1; cdata = NV_DATA_P(cc); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { int flag; UserData webdata; webdata = (UserData)user_data; /* Call rescomm to do inter-processor communication. */ flag = rescomm(cc, cp, webdata); /* Call reslocal to calculate the local portion of residual vector. */ flag = reslocal(tt, cc, cp, res, webdata); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the cc vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(N_Vector cc, N_Vector cp, void *user_data) { UserData webdata; realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; webdata = (UserData) user_data; cdata = NV_DATA_P(cc); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = webdata->comm; thispe = webdata->thispe; ixsub = webdata->ixsub; jysub = webdata->jysub; cext = webdata->cext; nsmxsub = webdata->nsmxsub; nsmysub = (webdata->ns)*(webdata->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, cext, buffer); return(0); } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of cc from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of cc. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of cc. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of cc (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of cc (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (webdata->mxsub) #define mysub (webdata->mysub) #define npex (webdata->npex) #define npey (webdata->npey) #define ixsub (webdata->ixsub) #define jysub (webdata->jysub) #define nsmxsub (webdata->nsmxsub) #define nsmxsub2 (webdata->nsmxsub2) #define np (webdata->np) #define dx (webdata->dx) #define dy (webdata->dy) #define cox (webdata->cox) #define coy (webdata->coy) #define rhs (webdata->rhs) #define cext (webdata->cext) #define rates (webdata->rates) #define ns (webdata->ns) #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) /* * reslocal: Compute res = F(t,cc,cp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the cc vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector webdata->rates * for use by the preconditioner setup routine. */ static int reslocal(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { realtype *cdata, *ratesxy, *cpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui; int ix, jy, is, i, locc, ylocce, locce; UserData webdata; webdata = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ cdata = NV_DATA_P(cc); /* Copy local segment of cc vector into the working extended array cext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext. */ /* If jysub = 0, copy x-line 2 of cc to cext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of cc to cext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of cc to cext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of cc to cext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set res values appropriately for prey/predator components of F. */ for (jy = 0; jy < mysub; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ratesxy = IJ_Vptr(rates,ix,jy); WebRates(xx, yy, &(cext[locce]), ratesxy, webdata); resxy = IJ_Vptr(res,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = cext[locce+is] - cext[locce+is-nsmxsub2]; dcyui = cext[locce+is+nsmxsub2] - cext[locce+is]; dcxli = cext[locce+is] - cext[locce+is-NUM_SPECIES]; dcxui = cext[locce+is+NUM_SPECIES] - cext[locce+is]; rhs[is] = cox[is]*(dcxui-dcxli) + coy[is]*(dcyui-dcyli) + ratesxy[is]; if (is < np) resxy[is] = cpxy[is] - rhs[is]; else resxy[is] = - rhs[is]; } /* End of is (species) loop. */ } /* End of ix loop. */ } /* End of jy loop. */ return(0); } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(int size, realtype *x1, realtype *x2) { int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } /* * Preconbd: Preconditioner setup routine. * This routine generates and preprocesses the block-diagonal * preconditoner PP. At each spatial point, a block of PP is computed * by way of difference quotients on the reaction rates R. * The base value of R are taken from webdata->rates, as set by webres. * Each block is LU-factored, for later solution of the linear systems. */ static int Precondbd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { int flag, thispe; realtype uround; realtype xx, yy, *cxy, *ewtxy, cctemp, **Pxy, *ratesxy, *Pxycol, *cpxy; realtype inc, sqru, fac, perturb_rates[NUM_SPECIES]; int is, js, ix, jy, ret; UserData webdata; void *mem; N_Vector ewt; realtype hh; webdata = (UserData)user_data; uround = UNIT_ROUNDOFF; sqru = SQRT(uround); thispe = webdata->thispe; mem = webdata->ida_mem; ewt = webdata->ewt; flag = IDAGetErrWeights(mem, ewt); check_flag(&flag, "IDAGetErrWeights", 1, thispe); flag = IDAGetCurrentStep(mem, &hh); check_flag(&flag, "IDAGetCurrentStep", 1, thispe); for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix+ ixsub*mxsub)*dx; Pxy = (webdata->PP)[ix][jy]; cxy = IJ_Vptr(cc,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); ewtxy= IJ_Vptr(ewt,ix,jy); ratesxy = IJ_Vptr(rates,ix,jy); for (js = 0; js < ns; js++) { inc = sqru*(MAX(ABS(cxy[js]), MAX(hh*ABS(cpxy[js]), ONE/ewtxy[js]))); cctemp = cxy[js]; /* Save the (js,ix,jy) element of cc. */ cxy[js] += inc; /* Perturb the (js,ix,jy) element of cc. */ fac = -ONE/inc; WebRates(xx, yy, cxy, perturb_rates, webdata); Pxycol = Pxy[js]; for (is = 0; is < ns; is++) Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac; if (js < np) Pxycol[js] += cj; /* Add partial with respect to cp. */ cxy[js] = cctemp; /* Restore (js,ix,jy) element of cc. */ } /* End of js loop. */ /* Do LU decomposition of matrix block for grid point (ix,jy). */ ret = denseGETRF(Pxy, ns, ns, (webdata->pivot)[ix][jy]); if (ret != 0) return(1); } /* End of ix loop. */ } /* End of jy loop. */ return(0); } /* * PSolvebd: Preconditioner solve routine. * This routine applies the LU factorization of the blocks of the * preconditioner PP, to compute the solution of PP * zvec = rvec. */ static int PSolvebd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype cj, realtype delta, void *user_data, N_Vector tempv) { realtype **Pxy, *zxy; long int *pivot, ix, jy; UserData webdata; webdata = (UserData)user_data; N_VScale(ONE, rvec, zvec); /* Loop through subgrid and apply preconditioner factors at each point. */ for (ix = 0; ix < mxsub; ix++) { for (jy = 0; jy < mysub; jy++) { /* For grid point (ix,jy), do backsolve on local vector. zxy is the address of the local portion of zvec, and Pxy is the address of the corresponding block of PP. */ zxy = IJ_Vptr(zvec,ix,jy); Pxy = (webdata->PP)[ix][jy]; pivot = (webdata->pivot)[ix][jy]; denseGETRS(Pxy, ns, pivot, zxy); } /* End of jy loop. */ } /* End of ix loop. */ return(0); } sundials-2.5.0/examples/idas/parallel/idasFoodWeb_kry_bbd_p.c0000600000175000017500000010767211741421242025124 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:06:37 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web, parallel, GMRES, IDABBD * preconditioner. * * This example program for IDAS uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses the * IDABBDPRE band-block-diagonal preconditioner module for the * IDASPGMR package. It was originally run on a Sun SPARC cluster * and used MPICH. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * Note: The above equations are written in 1-based indices, * whereas the code has 0-based indices, being written in C. * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product * MX * MY * NUM_SPECIES. The system is actually implemented on * submeshes, processor by processor, with an MXSUB by MYSUB mesh * on each of NPEX * NPEY processors. * * The DAE system is solved by IDAS using the IDASPGMR linear solver, * in conjunction with the preconditioner module IDABBDPRE. The * preconditioner uses a 5-diagonal band-block-diagonal * approximation (half-bandwidths = 2). Output is printed at * t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Journal of Applied Mathematics and Computation, Vol. 31 * (May 1989), pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NPREY 1 /* Number of prey (= number of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) /* pi */ #define FOURPI (RCONST(4.0)*PI) /* 4 pi */ #define MXSUB 10 /* Number of x mesh points per processor subgrid */ #define MYSUB 10 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ /* User-defined vector accessor macro IJ_Vptr. */ /* * IJ_Vptr is defined in order to express the underlying 3-d structure of the * dependent variable vector from its underlying 1-d storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { int ns, np, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES], rhs[NUM_SPECIES], cext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; MPI_Comm comm; N_Vector rates; long int n_local; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data); static int reslocal(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, void *user_data); /* Prototypes for supporting functions */ static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(int size, realtype *x1, realtype *x2); /* Prototypes for private functions */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector scrtch, UserData webdata); static void PrintHeader(int SystemSize, int maxl, int mudq, int mldq, int mukeep, int mlkeep, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector cc, realtype time, UserData webdata, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData webdata; long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, tout, tret; N_Vector cc, cp, res, id; int thispe, npes, maxl, iout, retval; cc = cp = res = id = NULL; webdata = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block webdata. */ webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize); webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); InitUserData(webdata, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector res is used temporarily only. */ cc = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); cp = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(cc, cp, id, res, webdata); N_VDestroy_Parallel(res); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); retval = IDASetUserData(mem, webdata); if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); retval = IDAInit(mem, resweb, t0, cc, cp); if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDA linear solver IDASPGMR */ maxl = 16; retval = IDASpgmr(mem, maxl); if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner. The half-bandwidths for the difference quotient evaluation are exact for the system Jacobian, but only a 5-diagonal band matrix is retained. */ mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, mudq, mldq, mukeep, mlkeep, rtol, atol); PrintOutput(mem, cc, t0, webdata, comm); /* Call IDA in tout loop, normal mode, and print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, cc, tret, webdata, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* On PE 0, print final set of statistics. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory. */ N_VDestroy_Parallel(cc); N_VDestroy_Parallel(cp); N_VDestroy_Parallel(id); IDAFree(&mem); destroyMat(webdata->acoef); N_VDestroy_Parallel(webdata->rates); free(webdata); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2, **acoef, *bcoef, *cox, *coy; webdata->jysub = thispe / NPEX; webdata->ixsub = thispe - (webdata->jysub)*NPEX; webdata->mxsub = MXSUB; webdata->mysub = MYSUB; webdata->npex = NPEX; webdata->npey = NPEY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->thispe = thispe; webdata->npes = npes; webdata->nsmxsub = MXSUB * NUM_SPECIES; webdata->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; webdata->comm = comm; webdata->n_local = MXSUB*MYSUB*NUM_SPECIES; /* Set up the coefficients a and b plus others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); acoef = webdata->acoef; bcoef = webdata->bcoef; cox = webdata->cox; coy = webdata->coy; for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector res, UserData webdata) { int ixsub, jysub, mxsub, mysub, nsmxsub, np, ix, jy, is; realtype *cxy, *idxy, *cpxy, dx, dy, xx, yy, xyfactor; ixsub = webdata->ixsub; jysub = webdata->jysub; mxsub = webdata->mxsub; mysub = webdata->mxsub; nsmxsub = webdata->nsmxsub; dx = webdata->dx; dy = webdata->dy; np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix + ixsub*mxsub) * dx; xyfactor = 16.*xx*(1. - xx)*yy*(1. - yy); xyfactor *= xyfactor; cxy = IJ_Vptr(cc,ix,jy); idxy = IJ_Vptr(id,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) { cxy[is] = RCONST(10.0) + (realtype)(is+1)*xyfactor; idxy[is] = ONE; } else { cxy[is] = 1.0e5; idxy[is] = ZERO; } } } } /* Set c' for the prey by calling the residual function with cp = 0. */ N_VConst(ZERO, cp); resweb(ZERO, cc, cp, res, webdata); N_VScale(-ONE, res, cp); /* Set c' for predators to 0. */ for (jy = 0; jy < mysub; jy++) { for (ix = 0; ix < mxsub; ix++) { cpxy = IJ_Vptr(cp,ix,jy); for (is = np; is < NUM_SPECIES; is++) cpxy[is] = ZERO; } } } /* * Print first lines of output (problem description) * and table headerr */ static void PrintHeader(int SystemSize, int maxl, int mudq, int mldq, int mukeep, int mlkeep, realtype rtol, realtype atol) { printf("\nidasFoodWeb_kry_bbd_p: Predator-prey DAE parallel example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n",SystemSize); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDASPGMR Max. Krylov dimension maxl: %d\n", maxl); printf("Preconditioner: band-block-diagonal (IDABBDPRE), with parameters\n"); printf(" mudq = %d, mldq = %d, mukeep = %d, mlkeep = %d\n", mudq, mldq, mukeep, mlkeep); printf("CalcIC called to correct initial predator concentrations \n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of c1 and c2 * are printed for the bottom left and top right grid points only. */ static void PrintOutput(void *mem, N_Vector cc, realtype tt, UserData webdata, MPI_Comm comm) { MPI_Status status; realtype *cdata, clast[2], hused; long int nst; int i, kused, flag, thispe, npelast, ilast;; thispe = webdata->thispe; npelast = webdata->npes - 1; cdata = NV_DATA_P(cc); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data) { int retval; UserData webdata; long int Nlocal; webdata = (UserData) user_data; Nlocal = webdata->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, cc, cp, user_data); /* Call reslocal to calculate the local portion of residual vector. */ retval = reslocal(Nlocal, tt, cc, cp, rr, user_data); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the cc vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, void *user_data) { UserData webdata; realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; webdata = (UserData) user_data; cdata = NV_DATA_P(cc); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = webdata->comm; thispe = webdata->thispe; ixsub = webdata->ixsub; jysub = webdata->jysub; cext = webdata->cext; nsmxsub = webdata->nsmxsub; nsmysub = (webdata->ns)*(webdata->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, cext, buffer); return(0); } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of cc from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of cc. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of cc. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of cc (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of cc (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (webdata->mxsub) #define mysub (webdata->mysub) #define npex (webdata->npex) #define npey (webdata->npey) #define ixsub (webdata->ixsub) #define jysub (webdata->jysub) #define nsmxsub (webdata->nsmxsub) #define nsmxsub2 (webdata->nsmxsub2) #define np (webdata->np) #define dx (webdata->dx) #define dy (webdata->dy) #define cox (webdata->cox) #define coy (webdata->coy) #define rhs (webdata->rhs) #define cext (webdata->cext) #define rates (webdata->rates) #define ns (webdata->ns) #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) /* * reslocal: Compute res = F(t,cc,cp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the cc vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector webdata->rates * for use by the preconditioner setup routine. */ static int reslocal(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data) { realtype *cdata, *ratesxy, *cpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui; int ix, jy, is, i, locc, ylocce, locce; UserData webdata; webdata = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ cdata = NV_DATA_P(cc); /* Copy local segment of cc vector into the working extended array cext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext. */ /* If jysub = 0, copy x-line 2 of cc to cext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of cc to cext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of cc to cext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of cc to cext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately for prey/predator components of F. */ for (jy = 0; jy < mysub; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ratesxy = IJ_Vptr(rates,ix,jy); WebRates(xx, yy, &(cext[locce]), ratesxy, webdata); resxy = IJ_Vptr(rr,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = cext[locce+is] - cext[locce+is-nsmxsub2]; dcyui = cext[locce+is+nsmxsub2] - cext[locce+is]; dcxli = cext[locce+is] - cext[locce+is-NUM_SPECIES]; dcxui = cext[locce+is+NUM_SPECIES] - cext[locce+is]; rhs[is] = cox[is]*(dcxui-dcxli) + coy[is]*(dcyui-dcyli) + ratesxy[is]; if (is < np) resxy[is] = cpxy[is] - rhs[is]; else resxy[is] = - rhs[is]; } } } return(0); } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(int size, realtype *x1, realtype *x2) { int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } sundials-2.5.0/examples/idas/parallel/idasFoodWeb_kry_p.out0000600000175000017500000000334311741421242024670 0ustar sylvestresylvestreidasFoodWeb_kry_p: Predator-prey DAE parallel example problem for IDA Number of species ns: 2 Mesh dimensions: 20 x 20 Total system size: 800 Subgrid dimensions: 10 x 10 Processor array: 2 x 2 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDASPGMR Max. Krylov dimension maxl: 16 Preconditioner: block diagonal, block size ns, via difference quotients CalcIC called to correct initial predator concentrations ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+01 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0827e+01 | 33 4 9.7404e-05 1.0319e+05 1.0822e+05 | 1.00e-02 1.6189e+02 1.9735e+02 | 86 4 1.7533e-04 1.6189e+06 1.9735e+06 | 1.00e-01 2.4019e+02 2.7072e+02 | 162 1 4.0396e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+02 | 165 1 3.2316e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+02 | 166 1 6.4633e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+02 | 166 1 6.4633e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final statistics: Number of steps = 166 Number of residual evaluations = 1257 Number of nonlinear iterations = 206 Number of error test failures = 0 Number of nonlinear conv. failures = 0 Number of linear iterations = 1049 Number of linear conv. failures = 0 Number of preconditioner setups = 25 Number of preconditioner solves = 1257 sundials-2.5.0/examples/idas/parallel/idasBruss_FSA_kry_bbd_p.c0000600000175000017500000011044211741421242025353 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: * $Date: * ----------------------------------------------------------------- * Programmer(s): Cosmin Petra and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Brusselator, parallel, GMRES, IDABBD * preconditioner, FSA. * * This example program for IDAS uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses the * IDABBDPRE band-block-diagonal preconditioner module for the * IDASPGMR package. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. * * The PDE system is a two-species time-dependent PDE known as * Brusselator PDE and models a chemically reacting system. * * * du/dt = eps1(u + u ) + u^2 v -(B+1)u + A * xx yy * domain [0,L]X[0,L] * dv/dt = eps2(v + v ) - u^2 v + Bu * xx yy * * B.C. Neumann * I.C u(x,y,t0) = u0(x,y) = 1 - 0.5*cos(pi*y/L) * v(x,y,t0) = v0(x,y) = 3.5 - 2.5*cos(pi*x/L) * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product MX*MY*NUM_SPECIES. * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The average of the solution u at final time is also computed. * / / * g = | | u(x,y,tf) dx dy * / / * Also the sensitivities of g with respect to parameters eps1 and * eps2 are computed. * / / * dg/d eps = | | u (x,y,tf) dx dy * / / eps */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 2 #define ctL RCONST(1.0) /* Domain =[0,L]^2 */ #define ctA RCONST(1.0) #define ctB RCONST(3.4) #define ctEps RCONST(2.0e-3) #define NS 2 #define PI RCONST(3.1415926535898) /* pi */ #define MXSUB 41 /* Number of x mesh points per processor subgrid */ #define MYSUB 41 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) /* User-defined vector accessor macro IJ_Vptr. */ /* * IJ_Vptr is defined in order to express the underlying 3-d structure of the * dependent variable vector from its underlying 1-d storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { int ns, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype A, B, L, eps[NUM_SPECIES]; realtype dx, dy; realtype cox[NUM_SPECIES], coy[NUM_SPECIES]; realtype gridext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; realtype rhs[NUM_SPECIES]; MPI_Comm comm; realtype rates[2]; long int n_local; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data); static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data); /* Integrate over spatial domain. */ static int integr(MPI_Comm comm, N_Vector uv, void *user_data, realtype *intval); /* Prototypes for supporting functions */ static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static void ReactRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData data); /* Prototypes for private functions */ static void InitUserData(UserData data, int thispe, int npes, MPI_Comm comm); static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data); static void PrintHeader(int SystemSize, int maxl, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector uv, realtype time, UserData data, MPI_Comm comm); static void PrintSol(void* mem, N_Vector uv, N_Vector uvp, UserData data, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, tout, tret; N_Vector uv, uvp, resid, id, *uvS, *uvpS; int thispe, npes, maxl, iout, retval; realtype pbar[NS]; int is; realtype intval; uv = uvp = resid = id = NULL; uvS = uvpS = NULL; data = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block data. */ data = (UserData) malloc(sizeof *data); InitUserData(data, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector resid is used temporarily only. */ uv = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uv, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); uvp = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uvp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); resid = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)resid, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); uvS = N_VCloneVectorArray_Parallel(NS, uv); if (check_flag((void *)uvS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1); for (is=0;iseps[0]; pbar[1] = data->eps[1]; retval = IDASetSensParams(mem, data->eps, pbar, NULL); if (check_flag(&retval, "IDASetSensParams", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDAS LINEAR SOLVER IDASPGMR */ maxl = 16; retval = IDASpgmr(mem, maxl); if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner. The half-bandwidths for the difference quotient evaluation are exact for the system Jacobian, but only a 5-diagonal band matrix is retained. */ mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, mudq, mldq, mukeep, mlkeep, rtol, atol); PrintOutput(mem, uv, t0, data, comm); /* Call IDAS in tout loop, normal mode, and print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, uv, uvp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, uv, tret, data, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* Print each PE's portion of the solution in a separate file. */ /* PrintSol(mem, uv, uvp, data, comm); */ /* On PE 0, print final set of statistics. */ if (thispe == 0) { PrintFinalStats(mem); } /* calculate integral of u over domain. */ integr(comm, uv, data, &intval); if (thispe == 0) { printf("\n\nThe average of u on the domain:\ng = %g\n", intval); } /* integrate the sensitivities of u over domain. */ IDAGetSens(mem, &tret, uvS); if (thispe == 0) printf("\nSensitivities of g:\n"); for (is=0; isjysub = thispe / NPEX; data->ixsub = thispe - (data->jysub)*NPEX; data->mxsub = MXSUB; data->mysub = MYSUB; data->npex = NPEX; data->npey = NPEY; data->ns = NUM_SPECIES; data->dx = ctL/(MX-1); data->dy = ctL/(MY-1); data->thispe = thispe; data->npes = npes; data->nsmxsub = MXSUB * NUM_SPECIES; data->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; data->comm = comm; data->n_local = MXSUB*MYSUB*NUM_SPECIES; data->A = ctA; data->B = ctB; data->L = ctL; data->eps[0] = data->eps[1] = ctEps; } /* * SetInitialProfiles: Set initial conditions in uv, uvp, and id. */ static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data) { int ixsub, jysub, mxsub, mysub, nsmxsub, ix, jy; realtype *idxy, dx, dy, x, y, *uvxy, *uvxy1, L, npex, npey; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; nsmxsub = data->nsmxsub; npex = data->npex; npey = data->npey; dx = data->dx; dy = data->dy; L = data->L; /* Loop over grid, load uv values and id values. */ for (jy = 0; jy < mysub; jy++) { y = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { x = (ix + ixsub*mxsub) * dx; uvxy = IJ_Vptr(uv,ix,jy); uvxy[0] = RCONST(1.0) - HALF*cos(PI*y/L); uvxy[1] = RCONST(3.5) - RCONST(2.5)*cos(PI*x/L); } } N_VConst(ONE, id); if (jysub == 0) { for (ix=0; ixthispe; npelast = data->npes - 1; cdata = NV_DATA_P(uv); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;ithispe; sprintf(szFilename, "ysol%d.txt", thispe); fout = fopen(szFilename, "w+"); if (fout==NULL) { printf("PE[% 2d] is unable to write solution to disk!\n", thispe); return; } mxsub = data->mxsub; mysub = data->mysub; for (jy=0; jy= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * res: System residual function * * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, uv, uvp, user_data); /* Call reslocal to calculate the local portion of residual vector. */ retval = reslocal(Nlocal, tt, uv, uvp, rr, user_data); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the uv vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data) { UserData data; realtype *cdata, *gridext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; data = (UserData) user_data; cdata = NV_DATA_P(uv); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; gridext = data->gridext; nsmxsub = data->nsmxsub; nsmysub = (data->ns)*(data->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, gridext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, gridext, buffer); return(0); } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of uv from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of uv. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of uv. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of uv (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of uv (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (data->mxsub) #define mysub (data->mysub) #define npex (data->npex) #define npey (data->npey) #define ixsub (data->ixsub) #define jysub (data->jysub) #define nsmxsub (data->nsmxsub) #define nsmxsub2 (data->nsmxsub2) #define dx (data->dx) #define dy (data->dy) #define cox (data->cox) #define coy (data->coy) #define gridext (data->gridext) #define eps (data->eps) #define ns (data->ns) /* * reslocal: Compute res = F(t,uv,uvp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the uv vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector data->rates * for use by the preconditioner setup routine. */ static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { realtype *uvdata, *uvpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui, dx2, dy2; realtype ixend, ixstart, jystart, jyend; int ix, jy, is, i, locc, ylocce, locce; realtype rates[2]; UserData data; data = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ uvdata = NV_DATA_P(uv); dx2 = dx * dx; dy2 = dy * dy; /* Copy local segment of uv vector into the working extended array gridext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of uv to gridext. */ /* If jysub = 0, copy x-line 2 of uv to gridext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) gridext[NUM_SPECIES+i] = uvdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of uv to gridext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of uv to gridext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of uv to gridext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately (ODE in the interior and DAE on the boundary)*/ ixend = ixstart = jystart = jyend = 0; if (jysub==0) jystart = 1; if (jysub==npey-1) jyend = 1; if (ixsub==0) ixstart = 1; if (ixsub==npex-1) ixend = 1; for (jy = jystart; jy < mysub-jyend; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = ixstart; ix < mxsub-ixend; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ReactRates(xx, yy, &(gridext[locce]), rates, data); resxy = IJ_Vptr(rr,ix,jy); uvpxy = IJ_Vptr(uvp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = gridext[locce+is] - gridext[locce+is-nsmxsub2]; dcyui = gridext[locce+is+nsmxsub2] - gridext[locce+is]; dcxli = gridext[locce+is] - gridext[locce+is-NUM_SPECIES]; dcxui = gridext[locce+is+NUM_SPECIES] - gridext[locce+is]; resxy[is] = uvpxy[is]-eps[is]*((dcxui-dcxli)/dx2+(dcyui-dcyli)/dy2)-rates[is]; } } } /* Algebraic equation correspoding to boundary mesh point. */ if (jysub==0) { for (ix=0; ixA; B = data->B; rates[0] = uvval[0]*uvval[0]*uvval[1]; rates[1] = - rates[0]; rates[0] += A-(B+1)*uvval[0]; rates[1] += B*uvval[0]; } /* Integrate over the spatial domain. Each process computes the integral on its grid. Then processes call MPI_REDUCE to compute sum of the local values. */ static int integr(MPI_Comm comm, N_Vector uv, void *user_data, realtype *intval) { int ix, jy; int retval; realtype *uvdata; UserData data; realtype buf[2]; data = (UserData) user_data; /* compute the integral on the (local) grid */ uvdata = NV_DATA_P(uv); *intval = 0; for (jy=1; jy= 0. SUPPRESSALG = TRUE to suppress local error testing on all boundary components. Linear solver: IDASPGMR. Preconditioner: IDABBDPRE - Banded-block-diagonal. Case 1. Difference quotient half-bandwidths = 5 Retained matrix half-bandwidths = 1 Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS nge h npe nps . . . . . . . . . . . . . . . . . . . . . . . . 0.01 8.24107e-01 2 12 14 7 14 7 96 2.56e-03 8 21 0.02 6.88124e-01 3 15 18 12 18 12 96 5.12e-03 8 30 0.04 4.70754e-01 3 18 24 22 24 22 108 6.58e-03 9 46 0.08 2.16600e-01 3 22 29 30 29 30 108 1.32e-02 9 59 0.16 4.56595e-02 4 28 37 43 37 43 120 2.63e-02 10 80 0.32 2.10959e-03 4 35 45 59 45 59 120 2.37e-02 10 104 0.64 5.53681e-05 1 40 54 71 54 71 156 1.90e-01 13 125 1.28 1.55972e-19 1 42 56 71 56 71 180 7.58e-01 15 127 2.56 3.38647e-21 1 43 57 71 57 71 192 1.52e+00 16 128 5.12 8.60743e-21 1 44 58 71 58 71 204 3.03e+00 17 129 10.24 1.66301e-20 1 45 59 71 59 71 216 6.06e+00 18 130 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 Case 2. Difference quotient half-bandwidths = 1 Retained matrix half-bandwidths = 1 Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS nge h npe nps . . . . . . . . . . . . . . . . . . . . . . . . 0.01 8.24111e-01 2 12 14 7 14 7 32 2.56e-03 8 21 0.02 6.88118e-01 3 15 18 12 18 12 32 5.12e-03 8 30 0.04 4.70932e-01 3 19 23 20 23 20 36 1.02e-02 9 43 0.08 2.16547e-01 3 23 27 32 27 32 36 1.02e-02 9 59 0.16 4.52248e-02 4 27 33 44 33 44 40 2.05e-02 10 77 0.32 2.18677e-03 3 34 41 67 41 67 44 4.10e-02 11 108 0.64 4.88467e-19 1 39 49 86 49 86 52 1.64e-01 13 135 1.28 5.39822e-19 1 41 51 86 51 86 60 6.55e-01 15 137 2.56 7.41945e-18 1 42 52 86 52 86 64 1.31e+00 16 138 5.12 6.10808e-17 1 43 53 86 53 86 68 2.62e+00 17 139 10.24 4.05358e-16 1 44 54 86 54 86 72 5.24e+00 18 140 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/idas/parallel/idasBruss_ASAp_kry_bbd_p.c0000600000175000017500000013124111741421242025526 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: * $Date: * ----------------------------------------------------------------- * Programmer(s): Cosmin Petra and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDAS: Brusselator, parallel, GMRES, IDABBD * preconditioner, ASA * * This example program for IDAS uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses the * IDABBDPRE band-block-diagonal preconditioner module for the * IDASPGMR package. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. * * The PDE system is a two-species time-dependent PDE known as * Brusselator PDE and models a chemically reacting system. * * * du/dt = eps(u + u) + u^2 v -(B+1)u + A * xx yy * domain Omega = [0,L]X[0,L] * dv/dt = eps(v + v) - u^2 v + Bu * xx yy * * B.C. : Neumann * I.C : u(x,y,t0) = u0(x,y) = 1 - 0.5*cos(pi*y/L) * v(x,y,t0) = v0(x,y) = 3.5 - 2.5*cos(pi*x/L) * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product MX*MY*NUM_SPECIES. * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * * The sensitivity of the output functional * 1 / * g(t) = ----- | u(x,y,t) , * |L^2| / * Omega * with respect to initial conditions u0 and v0 is also computed. * Given the perturbations du0 and dv0 in the IC, the sensitivity of * of g at final time tf is * 1 / * dg(tf) = ----- | ( lambda(0,x,y) du0(x,y) + mu(0,x,y) dv0(x,y) ), * |L^2| / * Omega * where lambda and mu are the solutions of the adjoint PDEs: * * dl/dt = - eps(l + l) - (2uv - B - 1)l + (2uv - B)m * xx yy * domain Omega = [0,L]X[0,L] * dm/dt = - eps(m + m) - u^2 l + u^2 m * xx yy * B.C. : Neumann * I.C. : l(x,y,tf) = 1 * m(x,y,tf) = 0 * * The adjoint PDEs are discretized and solved in the same way as * the Brusselator PDEs. */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 2 #define ctL RCONST(1.0) /* Domain =[0,L]^2 */ #define ctA RCONST(1.0) #define ctB RCONST(3.4) #define ctEps RCONST(2.0e-3) #define PI RCONST(3.1415926535898) /* pi */ #define MXSUB 21 /* Number of x mesh points per processor subgrid */ #define MYSUB 21 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define TBEGIN RCONST(0.0) /* Multiplier for tout values */ #define TEND RCONST(1.0) /* Increment for tout values */ #define STEPS 50 #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* User-defined vector accessor macro IJ_Vptr. */ /* * IJ_Vptr is defined in order to express the underlying 3-d structure of the * dependent variable vector from its underlying 1-d storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { int ns, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype A, B, L, eps[NUM_SPECIES]; realtype dx, dy; realtype cox[NUM_SPECIES], coy[NUM_SPECIES]; realtype gridext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; realtype rhs[NUM_SPECIES]; MPI_Comm comm; realtype rates[2]; long int n_local; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data); static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data); /* Prototypes for supporting functions */ static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static void ReactRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData data); /* ADJOINT */ static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); static int resBlocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector yyB, N_Vector ypB, N_Vector res, void *user_dataB); /* Prototypes for private functions */ static void InitUserData(UserData data, int thispe, int npes, MPI_Comm comm); static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data); static void SetInitialProfilesB(N_Vector uv, N_Vector uvp, N_Vector uvB, N_Vector uvpB, N_Vector residB, UserData data); static void PrintHeader(int SystemSize, int maxl, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector uv, realtype time, UserData data, MPI_Comm comm); static void PrintSol(void* mem, N_Vector uv, N_Vector uvp, UserData data, MPI_Comm comm); static void PrintAdjSol(N_Vector uvB, N_Vector uvpB, UserData data); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, tout, tret; N_Vector uv, uvp, resid, id, uvB, uvpB, residB, qB; int thispe, npes, maxl, retval; int nckpnt, indexB; uv = uvp = resid = id = NULL; data = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block data. */ data = (UserData) malloc(sizeof *data); InitUserData(data, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector resid is used temporarily only. */ uv = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uv, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); uvp = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)uvp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); resid = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)resid, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(uv, uvp, id, resid, data); res(ZERO, uv, uvp, resid, data); /* Set remaining inputs to IDAS. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAInit to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); retval = IDASetUserData(mem, data); if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); retval = IDAInit(mem, res, t0, uv, uvp); if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDAS LINEAR SOLVER IDASPGMR */ maxl = 16; retval = IDASpgmr(mem, maxl); if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner. The half-bandwidths for the difference quotient evaluation are exact for the system Jacobian, but only a 5-diagonal band matrix is retained. */ mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Initialize adjoint module. */ retval = IDAAdjInit(mem, STEPS, IDA_POLYNOMIAL); if(check_flag(&retval, "IDAAdjInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); if (thispe == 0) printf("\nStarting integration of the FORWARD problem\n\n"); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, mudq, mldq, mukeep, mlkeep, rtol, atol); /* Call IDAS in tout loop, normal mode, and print selected output. */ retval = IDASolveF(mem, TEND, &tret, uv, uvp, IDA_NORMAL, &nckpnt); if(check_flag(&retval, "IDASolveF", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, uv, tret, data, comm); /* Print each PE's portion of the solution in a separate file. */ //PrintSol(mem, uv, uvp, data, comm); /* On PE 0, print final set of statistics. */ if (thispe == 0) { PrintFinalStats(mem); } /******************************************************* * ADJOINT * *******************************************************/ if (thispe == 0) printf("\n\t\t BACKWARD problem\n"); uvB = N_VNew_Parallel(comm, local_N, SystemSize); uvpB = N_VNew_Parallel(comm, local_N, SystemSize); residB = N_VNew_Parallel(comm, local_N, SystemSize); qB = N_VNew_Parallel(comm, local_N, SystemSize); retval = IDACreateB(mem, &indexB); /*Get consistent IC */ SetInitialProfilesB(uv, uvp, uvB, uvpB, residB, data); retval = IDAInitB(mem, indexB, resB, TEND, uvB, uvpB); if(check_flag(&retval, "IDAInitB", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetUserDataB(mem, indexB, data); if(check_flag(&retval, "IDASetUserDataB", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetIdB(mem, indexB, id); if(check_flag(&retval, "IDASetIdBIDAInitB", 1, thispe)) MPI_Abort(comm, 1); retval = IDASStolerancesB(mem, indexB, rtol, atol); if(check_flag(&retval, "IDASStolerancesB", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDAS LINEAR SOLVER IDASPGMR */ maxl = 16; retval = IDASpgmrB(mem, indexB, maxl); mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInitB(mem, indexB, local_N, mudq, mldq, mukeep, mlkeep, ZERO, resBlocal, NULL); if(check_flag(&retval, "IDABBDPrecInitB", 1, thispe)) MPI_Abort(comm, 1); retval = IDASolveB(mem, TBEGIN, IDA_NORMAL); if(check_flag(&retval, "IDASolveB", 1, thispe)) MPI_Abort(comm, 1); retval = IDAGetB(mem, indexB, &tret, uvB, uvpB); if(check_flag(&retval, "IDAGetB", 1, thispe)) MPI_Abort(comm, 1); /* Print each PE's portion of solution in a separate file. */ /* PrintAdjSol(uvB, uvpB, data); */ /* On PE 0, print final set of statistics. */ if (thispe == 0) { PrintFinalStats(IDAGetAdjIDABmem(mem, indexB)); } /* Free memory. */ N_VDestroy_Parallel(uv); N_VDestroy_Parallel(uvp); N_VDestroy_Parallel(id); N_VDestroy_Parallel(resid); N_VDestroy_Parallel(uvB); N_VDestroy_Parallel(uvpB); N_VDestroy_Parallel(residB); IDAFree(&mem); free(data); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in data (of type UserData). */ static void InitUserData(UserData data, int thispe, int npes, MPI_Comm comm) { data->jysub = thispe / NPEX; data->ixsub = thispe - (data->jysub)*NPEX; data->mxsub = MXSUB; data->mysub = MYSUB; data->npex = NPEX; data->npey = NPEY; data->ns = NUM_SPECIES; data->dx = ctL/(MX-1); data->dy = ctL/(MY-1); data->thispe = thispe; data->npes = npes; data->nsmxsub = MXSUB * NUM_SPECIES; data->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; data->comm = comm; data->n_local = MXSUB*MYSUB*NUM_SPECIES; data->A = ctA; data->B = ctB; data->L = ctL; data->eps[0] = data->eps[1] = ctEps; } /* * SetInitialProfiles: Set initial conditions in uv, uvp, and id. */ static void SetInitialProfiles(N_Vector uv, N_Vector uvp, N_Vector id, N_Vector resid, UserData data) { int ixsub, jysub, mxsub, mysub, nsmxsub, ix, jy; realtype *idxy, dx, dy, x, y, *uvxy, *uvxy1, L, npex, npey; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; nsmxsub = data->nsmxsub; npex = data->npex; npey = data->npey; dx = data->dx; dy = data->dy; L = data->L; /* Loop over grid, load uv values and id values. */ for (jy = 0; jy < mysub; jy++) { y = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { x = (ix + ixsub*mxsub) * dx; uvxy = IJ_Vptr(uv,ix,jy); uvxy[0] = RCONST(1.0) - HALF*cos(PI*y/L); uvxy[1] = RCONST(3.5) - RCONST(2.5)*cos(PI*x/L); } } N_VConst(ONE, id); if (jysub == 0) { for (ix=0; ixixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mxsub; nsmxsub = data->nsmxsub; npex = data->npex; npey = data->npey; dx = data->dx; dy = data->dy; B = data->B; /* Loop over grid, load (lambda, mu) values. */ for (jy = 0; jy < mysub; jy++) { for (ix = 0; ix < mxsub; ix++) { uvBxy = IJ_Vptr(uvB, ix,jy); uvpBxy = IJ_Vptr(uvpB,ix,jy); uvxy = IJ_Vptr(uv,ix,jy); uvBxy[0] = ONE; uvBxy[1] = ZERO; uvpBxy[0] = -TWO*uvxy[0]*uvxy[1]+(B+1); uvpBxy[1] = -uvxy[0]*uvxy[0]; } } if (jysub == 0) { for (ix=0; ixthispe; npelast = data->npes - 1; cdata = NV_DATA_P(uv); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;ithispe; sprintf(szFilename, "ysol%da.txt", thispe); fout = fopen(szFilename, "w+"); if (fout==NULL) { printf("PE[% 2d] is unable to write solution to disk!\n", thispe); return; } npex = data->npex; npey = data->npey; mxsub = data->mxsub; mysub = data->mysub; ixsub = data->ixsub; jysub = data->jysub; nsmxsub = data->nsmxsub; for (jy=0; jythispe; sprintf(szFilename, "ysol%dadj.txt", thispe); fout = fopen(szFilename, "w+"); if (fout==NULL) { printf("PE[% 2d] is unable to write adj solution to disk!\n", thispe); return; } npex = data->npex; npey = data->npey; mxsub = data->mxsub; mysub = data->mysub; ixsub = data->ixsub; jysub = data->jysub; nsmxsub = data->nsmxsub; for (jy=0; jy= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * res: System residual function * * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int res(realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, uv, uvp, user_data); /* Call reslocal to calculate the local portion of residual vector. */ retval = reslocal(Nlocal, tt, uv, uvp, rr, user_data); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the uv vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, void *user_data) { UserData data; realtype *cdata, *gridext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; data = (UserData) user_data; cdata = NV_DATA_P(uv); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; gridext = data->gridext; nsmxsub = data->nsmxsub; nsmysub = (data->ns)*(data->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, gridext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, gridext, buffer); return(0); } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of uv from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of uv. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of uv. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of uv (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of uv (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (data->mxsub) #define mysub (data->mysub) #define npex (data->npex) #define npey (data->npey) #define ixsub (data->ixsub) #define jysub (data->jysub) #define nsmxsub (data->nsmxsub) #define nsmxsub2 (data->nsmxsub2) #define dx (data->dx) #define dy (data->dy) #define cox (data->cox) #define coy (data->coy) #define gridext (data->gridext) #define eps (data->eps) #define ns (data->ns) /* * reslocal: Compute res = F(t,uv,uvp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the uv vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector data->rates * for use by the preconditioner setup routine. */ static int reslocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector rr, void *user_data) { realtype *uvdata, *uvpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui, dx2, dy2; realtype ixend, ixstart, jystart, jyend; int ix, jy, is, i, locc, ylocce, locce; realtype rates[2]; UserData data; data = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ uvdata = NV_DATA_P(uv); dx2 = dx * dx; dy2 = dy * dy; /* Copy local segment of uv vector into the working extended array gridext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of uv to gridext. */ /* If jysub = 0, copy x-line 2 of uv to gridext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) gridext[NUM_SPECIES+i] = uvdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of uv to gridext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of uv to gridext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of uv to gridext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately (ODE in the interior and DAE on the boundary)*/ ixend = ixstart = jystart = jyend = 0; if (jysub==0) jystart = 1; if (jysub==npey-1) jyend = 1; if (ixsub==0) ixstart = 1; if (ixsub==npex-1) ixend = 1; for (jy = jystart; jy < mysub-jyend; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = ixstart; ix < mxsub-ixend; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ReactRates(xx, yy, &(gridext[locce]), rates, data); resxy = IJ_Vptr(rr,ix,jy); uvpxy = IJ_Vptr(uvp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = gridext[locce+is] - gridext[locce+is-nsmxsub2]; dcyui = gridext[locce+is+nsmxsub2] - gridext[locce+is]; dcxli = gridext[locce+is] - gridext[locce+is-NUM_SPECIES]; dcxui = gridext[locce+is+NUM_SPECIES] - gridext[locce+is]; resxy[is] = uvpxy[is]-eps[is]*((dcxui-dcxli)/dx2+(dcyui-dcyli)/dy2)-rates[is]; } } } if (jysub==0) { for (ix=0; ixA; B = data->B; rates[0] = uvval[0]*uvval[0]*uvval[1]; rates[1] = - rates[0]; rates[0] += A-(B+1)*uvval[0]; rates[1] += B*uvval[0]; } static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB) { UserData data; int retval; long int Nlocal; data = (UserData) user_dataB; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, yyB, ypB, data); /* Call reslocal to calculate the local portion of residual vector. */ retval = resBlocal(Nlocal, tt, yy, yp, yyB, ypB, rrB, user_dataB); return(0); } static int resBlocal(long int Nlocal, realtype tt, N_Vector uv, N_Vector uvp, N_Vector uvB, N_Vector uvpB, N_Vector rrB, void *user_dataB) { realtype *uvBdata, *uvBxy, *uvpBxy, *uvxy, *rrBxy; realtype dx2, dy2, xx, yy; realtype dcxli, dcxui, dcyli, dcyui; int locc, locce, ylocce; int ix, jy, i, ixstart, ixend, jystart, jyend, is; UserData data; realtype A, B; data = (UserData) user_dataB; A = data->A; B = data->B; /* Get data pointers, subgrid data, array sizes, work array cext. */ uvBdata = NV_DATA_P(uvB); dx2 = dx * dx; dy2 = dy * dy; /* Copy local segment of uv vector into the working extended array gridext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvBdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* If jysub = 0, copy x-line 2 of uv to gridext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) gridext[NUM_SPECIES+i] = uvBdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of uv to gridext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) gridext[locce+i] = uvBdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of uv to gridext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvBdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of uv to gridext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) gridext[locce+i] = uvBdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately (ODE in the interior and DAE on the boundary)*/ ixend = ixstart = jystart = jyend = 0; if (jysub==0) jystart = 1; if (jysub==npey-1) jyend = 1; if (ixsub==0) ixstart = 1; if (ixsub==npex-1) ixend = 1; for (jy = jystart; jy < mysub-jyend; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = ixstart; ix < mxsub-ixend; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; uvxy = IJ_Vptr(uv ,ix,jy); uvBxy = IJ_Vptr(uvB ,ix,jy); uvpBxy= IJ_Vptr(uvpB,ix,jy); rrBxy = IJ_Vptr(rrB ,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = gridext[locce+is] - gridext[locce+is-nsmxsub2]; dcyui = gridext[locce+is+nsmxsub2] - gridext[locce+is]; dcxli = gridext[locce+is] - gridext[locce+is-NUM_SPECIES]; dcxui = gridext[locce+is+NUM_SPECIES] - gridext[locce+is]; rrBxy[is] = uvpBxy[is] + eps[is]*( (dcxui-dcxli)/dx2 + (dcyui-dcyli)/dy2 ); } //now add rates rrBxy[0] += (uvBxy[0]-uvBxy[1])*(2*uvxy[0]*uvxy[1] - B) - uvBxy[0]; rrBxy[1] += uvxy[0]*uvxy[0]*(uvBxy[0]-uvBxy[1]); } } if (jysub==0) { for (ix=0; ix= 0. SUPPRESSALG = TRUE to suppress local error testing on all boundary components. Linear solver: IDASPGMR Preconditioner: diagonal elements only. Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS h npe nps ---------------------------------------------------------------------- 0.00 9.75461e-01 0 0 0 0 0 0 0.00e+00 0 0 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 5.54028e-21 1 39 51 77 51 77 1.05e-01 12 128 1.28 3.85107e-20 1 41 53 77 53 77 4.21e-01 14 130 2.56 5.00523e-20 1 43 55 77 55 77 1.69e+00 16 132 5.12 1.50906e-19 1 44 56 77 56 77 3.37e+00 17 133 10.24 4.63224e-19 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/idas/serial/0000755000175000017500000000000011767174700020251 5ustar sylvestresylvestresundials-2.5.0/examples/idas/serial/idasAkzoNob_ASAi_dns.out0000600000175000017500000000110611741421242024661 0ustar sylvestresylvestre Adjoint Sensitivity Example for Akzo-Nobel Chemical Kinetics ------------------------------------------------------------- Sensitivity of G = int_t0^tf (y1) dt with respect to IC. ------------------------------------------------------------- Forward integration ... done ( nst = 457 ) G: 31.2642162580311549 -------------------------------------------------------- Backward integration ... done ( nst = 274 ) dG/dy0: 2.2207e+01 -6.2695e+01 -2.5115e+00 9.1837e+01 3.5176e+00 3.6976e-01 -------------------------------------------------------- sundials-2.5.0/examples/idas/serial/idasRoberts_FSA_dns.out0000600000175000017500000001343011741421242024575 0ustar sylvestresylvestre 3-species chemical kinetics problem Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) Consistent IC: y = 1.0000e+00 0.0000e+00 -7.7954e-16 yp= -4.0000e-02 4.0000e-02 0.0000e+00 Sensitivity 1 s1 = 0.0000e+00 0.0000e+00 -1.9467e-14 s1'= -1.0000e-00 1.0000e-00 0.0000e+00 Sensitivity 2 s2 = 0.0000e+00 0.0000e+00 0.0000e+00 s2'= 0.0000e+00 0.0000e+00 0.0000e+00 Sensitivity 3 s3 = 0.0000e+00 0.0000e+00 0.0000e+00 s3'= 0.0000e+00 0.0000e+00 0.0000e+00 ======================================================================= T Q H NST y1 y2 y3 ======================================================================= 4.000e-01 3 5.234e-02 410 Solution 9.8517e-01 3.3864e-05 1.4792e-02 Sensitivity 1 -3.5590e-01 3.9026e-04 3.5551e-01 Sensitivity 2 9.5512e-08 -2.1306e-10 -9.5299e-08 Sensitivity 3 -1.5847e-11 -5.2901e-13 1.6376e-11 ----------------------------------------------------------------------- 4.000e+00 4 1.544e-01 452 Solution 9.0552e-01 2.2405e-05 9.4458e-02 Sensitivity 1 -1.8761e+00 1.7922e-04 1.8759e+00 Sensitivity 2 2.9614e-06 -5.8304e-10 -2.9608e-06 Sensitivity 3 -4.9335e-10 -2.7626e-13 4.9362e-10 ----------------------------------------------------------------------- 4.000e+01 4 1.280e+00 511 Solution 7.1583e-01 9.1855e-06 2.8416e-01 Sensitivity 1 -4.2476e+00 4.5912e-05 4.2475e+00 Sensitivity 2 1.3731e-05 -2.3572e-10 -1.3731e-05 Sensitivity 3 -2.2884e-09 -1.1381e-13 2.2885e-09 ----------------------------------------------------------------------- 4.000e+02 5 1.323e+01 581 Solution 4.5052e-01 3.2229e-06 5.4948e-01 Sensitivity 1 -5.9584e+00 3.5427e-06 5.9584e+00 Sensitivity 2 2.2738e-05 -2.2601e-11 -2.2738e-05 Sensitivity 3 -3.7897e-09 -4.9948e-14 3.7897e-09 ----------------------------------------------------------------------- 4.000e+03 4 9.361e+01 675 Solution 1.8320e-01 8.9424e-07 8.1680e-01 Sensitivity 1 -4.7501e+00 -5.9937e-06 4.7501e+00 Sensitivity 2 1.8809e-05 2.3127e-11 -1.8809e-05 Sensitivity 3 -3.1348e-09 -1.8758e-14 3.1348e-09 ----------------------------------------------------------------------- 4.000e+04 5 1.092e+03 763 Solution 3.8983e-02 1.6218e-07 9.6102e-01 Sensitivity 1 -1.5750e+00 -2.7620e-06 1.5750e+00 Sensitivity 2 6.2875e-06 1.1002e-11 -6.2875e-06 Sensitivity 3 -1.0479e-09 -4.5367e-15 1.0479e-09 ----------------------------------------------------------------------- 4.000e+05 5 1.116e+04 846 Solution 4.9383e-03 1.9850e-08 9.9506e-01 Sensitivity 1 -2.3633e-01 -4.5841e-07 2.3633e-01 Sensitivity 2 9.4503e-07 1.8325e-12 -9.4503e-07 Sensitivity 3 -1.5751e-10 -6.3625e-16 1.5751e-10 ----------------------------------------------------------------------- 4.000e+06 5 1.281e+05 919 Solution 5.1682e-04 2.0683e-09 9.9948e-01 Sensitivity 1 -2.5666e-02 -5.1061e-08 2.5666e-02 Sensitivity 2 1.0266e-07 2.0423e-13 -1.0266e-07 Sensitivity 3 -1.7110e-11 -6.8510e-17 1.7110e-11 ----------------------------------------------------------------------- 4.000e+07 5 1.793e+06 974 Solution 5.2033e-05 2.0814e-10 9.9995e-01 Sensitivity 1 -2.5993e-03 -5.1947e-09 2.5993e-03 Sensitivity 2 1.0397e-08 2.0778e-14 -1.0397e-08 Sensitivity 3 -1.7328e-12 -6.9320e-18 1.7328e-12 ----------------------------------------------------------------------- 4.000e+08 4 2.324e+07 1011 Solution 5.2096e-06 2.0839e-11 9.9999e-01 Sensitivity 1 -2.6054e-04 -5.2100e-10 2.6054e-04 Sensitivity 2 1.0422e-09 2.0840e-15 -1.0422e-09 Sensitivity 3 -1.7363e-13 -6.9454e-19 1.7364e-13 ----------------------------------------------------------------------- 4.000e+09 3 3.664e+08 1042 Solution 5.2268e-07 2.0907e-12 1.0000e-00 Sensitivity 1 -2.6168e-05 -5.2687e-11 2.6169e-05 Sensitivity 2 1.0467e-10 2.1075e-16 -1.0467e-10 Sensitivity 3 -1.7422e-14 -6.9690e-20 1.7423e-14 ----------------------------------------------------------------------- 4.000e+10 2 4.467e+09 1064 Solution 5.1289e-08 2.0516e-13 1.0000e-00 Sensitivity 1 -2.5638e-06 -4.9912e-12 2.5638e-06 Sensitivity 2 1.0255e-11 1.9965e-17 -1.0255e-11 Sensitivity 3 -1.7096e-15 -6.8385e-21 1.7096e-15 ----------------------------------------------------------------------- Quadrature: G: 4.0000e+10 Sensitivities at t=4e+10: dG/dp1: 1.4895e+06 dG/dp1: -5.9536e+00 dG/dp1: 9.9196e-04 Final Statistics nst = 1064 nfe = 1702 netf = 19 nsetups = 129 nni = 1700 ncfn = 12 nfSe = 1702 nfeS = 0 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 nje = 129 nfeLS = 387 sundials-2.5.0/examples/idas/serial/idasKrylovDemo_ls.out0000600000175000017500000001133411741421242024412 0ustar sylvestresylvestre ------- | SPGMR | ------- idasKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPGMR, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 0.00000e+00 1 39 51 77 51 77 1.05e-01 12 128 1.28 0.00000e+00 1 41 53 77 53 77 4.21e-01 14 130 2.56 0.00000e+00 1 43 55 77 55 77 1.69e+00 16 132 5.12 0.00000e+00 1 44 56 77 56 77 3.37e+00 17 133 10.24 0.00000e+00 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 ====================================================================== ------- | SPBCG | ------- idasKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPBCG, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24105e-01 2 12 14 8 14 8 2.56e-03 8 22 0.02 6.88129e-01 3 15 18 14 18 14 5.12e-03 8 32 0.04 4.70820e-01 3 19 23 22 23 22 1.02e-02 9 45 0.08 2.16332e-01 3 23 27 32 27 32 1.02e-02 9 59 0.16 4.48774e-02 4 27 33 44 33 44 2.05e-02 10 77 0.32 1.75557e-03 3 33 41 70 41 70 4.10e-02 11 111 0.64 2.47770e-05 1 38 48 82 48 82 1.64e-01 13 130 1.28 2.57209e-22 1 40 50 82 50 82 6.55e-01 15 132 2.56 3.19445e-22 1 41 51 82 51 82 1.31e+00 16 133 5.12 7.19965e-22 1 42 52 82 52 82 2.62e+00 17 134 10.24 1.87591e-21 1 43 53 82 53 82 5.24e+00 18 135 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 ====================================================================== --------- | SPTFQMR | --------- idasKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPTFQMR, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24104e-01 2 12 14 11 14 11 2.56e-03 8 28 0.02 6.88133e-01 3 15 18 19 18 19 5.12e-03 8 42 0.04 4.70857e-01 3 19 23 33 23 33 1.02e-02 9 64 0.08 2.16481e-01 3 23 27 57 27 57 1.02e-02 9 96 0.16 4.51083e-02 4 27 33 84 33 84 2.05e-02 10 133 0.32 1.78483e-03 4 34 42 139 42 139 4.10e-02 11 204 0.64 4.07887e-04 1 39 51 183 51 183 1.47e-01 13 262 1.28 4.59662e-04 1 41 54 199 54 199 5.90e-01 15 282 2.56 2.03940e-05 1 43 56 202 56 202 1.18e+00 16 288 5.12 9.56073e-21 1 45 58 202 58 202 2.36e+00 17 290 10.24 5.70363e-20 1 46 59 202 59 202 4.72e+00 18 291 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/idas/serial/idasRoberts_FSA_dns.c0000600000175000017500000005370611741421242024222 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2008/04/15 16:37:37 $ * ----------------------------------------------------------------- * Programmer(s): Cosmin Petra and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * This simple example problem for IDA, due to Robertson, * is from chemical kinetics, and consists of the following three * equations: * * dy1/dt = -p1*y1 + p2*y2*y3 * dy2/dt = p1*y1 - p2*y2*y3 - p3*y2**2 * 0 = y1 + y2 + y3 - 1 * * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1, y2 = y3 = 0.The reaction rates are: p1=0.04, * p2=1e4, and p3=3e7 * * Optionally, IDAS can compute sensitivities with respect to the * problem parameters p1, p2, and p3. * The sensitivity right hand side is given analytically through the * user routine fS (of type SensRhs1Fn). * Any of two sensitivity methods (SIMULTANEOUS and STAGGERED can be * used and sensitivities may be included in the error test or not *(error control set on TRUE or FALSE, respectively). * * Execution: * * If no sensitivities are desired: * % idasRoberts_FSA_dns -nosensi * If sensitivities are to be computed: * % idasRoberts_FSA_dns -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for IDAS fcts. and consts. */ #include #include /* defs. of serial NVECTOR fcts. and macros */ #include /* def. of type realtype */ #include /* definition of ABS */ /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i=1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* (i,j)-th matrix component i,j=1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ #define NP 3 /* number of problem parameters */ #define NS 3 /* number of sensitivities computed */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Type : UserData */ typedef struct { realtype p[3]; /* problem parameters */ realtype coef; } *UserData; /* Prototypes of functions by IDAS */ static int res(realtype t, N_Vector y, N_Vector yp, N_Vector resval, void *user_data); static int resS(int Ns, realtype t, N_Vector y, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int rhsQ(realtype tres, N_Vector yy, N_Vector yp, N_Vector rrQ, void *user_data); /* Prototypes of private functions */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(char *name); static void PrintIC(N_Vector y, N_Vector yp); static void PrintSensIC(N_Vector y, N_Vector yp, N_Vector* yS, N_Vector* ypS); static void PrintOutput(void *ida_mem, realtype t, N_Vector u); static void PrintSensOutput(N_Vector *uS); static void PrintFinalStats(void *ida_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { void *ida_mem; UserData data; realtype reltol, t, tout; N_Vector y, yp, abstol, id; int iout, flag; realtype pbar[NS]; int is; N_Vector *yS, *ypS; booleantype sensi, err_con; int sensi_meth; ida_mem = NULL; data = NULL; y = NULL; yS = NULL; ypS = NULL; /* Process arguments */ ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con); /* User data structure */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2)) return(1); data->p[0] = RCONST(0.040); data->p[1] = RCONST(1.0e4); data->p[2] = RCONST(3.0e7); data->coef = 0.5; /* Initial conditions */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); Ith(y,1) = ONE; Ith(y,2) = ZERO; Ith(y,3) = ZERO; yp = N_VNew_Serial(NEQ); if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); /* These initial conditions are NOT consistent. See IDACalcIC below. */ Ith(yp,1) = RCONST(0.1); Ith(yp,2) = ZERO; Ith(yp,3) = ZERO; /* Create IDAS object */ ida_mem = IDACreate(); if (check_flag((void *)ida_mem, "IDACreate", 0)) return(1); /* Allocate space for IDAS */ flag = IDAInit(ida_mem, res, T0, y, yp); if (check_flag(&flag, "IDAInit", 1)) return(1); /* Specify scalar relative tol. and vector absolute tol. */ reltol = RCONST(1.0e-6); abstol = N_VNew_Serial(NEQ); Ith(abstol,1) = RCONST(1.0e-8); Ith(abstol,2) = RCONST(1.0e-14); Ith(abstol,3) = RCONST(1.0e-6); flag = IDASVtolerances(ida_mem, reltol, abstol); if (check_flag(&flag, "IDASVtolerances", 1)) return(1); /* Set ID vector */ id = N_VNew_Serial(NEQ); Ith(id,1) = 1.0; Ith(id,2) = 1.0; Ith(id,3) = 0.0; flag = IDASetId(ida_mem, id); if (check_flag(&flag, "IDASetId", 1)) return(1); /* Attach user data */ flag = IDASetUserData(ida_mem, data); if (check_flag(&flag, "IDASetUserData", 1)) return(1); /* Attach linear solver */ flag = IDADense(ida_mem, NEQ); if (check_flag(&flag, "IDADense", 1)) return(1); printf("\n3-species chemical kinetics problem\n"); /* Sensitivity-related settings */ if (sensi) { pbar[0] = data->p[0]; pbar[1] = data->p[1]; pbar[2] = data->p[2]; yS = N_VCloneVectorArray_Serial(NS, y); if (check_flag((void *)yS, "N_VCloneVectorArray_Serial", 0)) return(1); for (is=0;isp, pbar, NULL); if (check_flag(&flag, "IDASetSensParams", 1)) return(1); printf("Sensitivity: YES "); if(sensi_meth == IDA_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else printf("( STAGGERED +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } else { printf("Sensitivity: NO "); } /*---------------------------------------------------------- * Q U A D R A T U R E S * ---------------------------------------------------------*/ N_Vector yQ, *yQS; yQ = N_VNew_Serial(2); Ith(yQ,1) = 0; Ith(yQ,2) = 0; IDAQuadInit(ida_mem, rhsQ, yQ); yQS = N_VCloneVectorArray_Serial(NS, yQ); for (is=0;isp[0]; p2 = data->p[1]; p3 = data->p[2]; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); yp1 = Ith(yp,1); yp2 = Ith(yp,2); yp3 = Ith(yp,3); Ith(resval,1) = yp1 + p1*y1 - p2*y2*y3; Ith(resval,2) = yp2 - p1*y1 + p2*y2*y3 + p3*y2*y2; Ith(resval,3) = y1 + y2 + y3 - ONE; return(0); } /* * resS routine. Compute sensitivity r.h.s. */ static int resS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { UserData data; realtype p1, p2, p3; realtype y1, y2, y3; realtype yp1, yp2, yp3; realtype s1, s2, s3; realtype sd1, sd2, sd3; realtype rs1, rs2, rs3; int is; data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); yp1 = Ith(yp,1); yp2 = Ith(yp,2); yp3 = Ith(yp,3); for (is=0; iscoef*( Ith(y,1)*Ith(y,1)+ Ith(y,2)*Ith(y,2)+ Ith(y,3)*Ith(y,3) ); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Process and verify arguments to idasfwddenx. */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con) { *sensi = FALSE; *sensi_meth = -1; *err_con = FALSE; if (argc < 2) WrongArgs(argv[0]); if (strcmp(argv[1],"-nosensi") == 0) *sensi = FALSE; else if (strcmp(argv[1],"-sensi") == 0) *sensi = TRUE; else WrongArgs(argv[0]); if (*sensi) { if (argc != 4) WrongArgs(argv[0]); if (strcmp(argv[2],"sim") == 0) *sensi_meth = IDA_SIMULTANEOUS; else if (strcmp(argv[2],"stg") == 0) *sensi_meth = IDA_STAGGERED; else WrongArgs(argv[0]); if (strcmp(argv[3],"t") == 0) *err_con = TRUE; else if (strcmp(argv[3],"f") == 0) *err_con = FALSE; else WrongArgs(argv[0]); } } static void WrongArgs(char *name) { printf("\nUsage: %s [-nosensi] [-sensi sensi_meth err_con]\n",name); printf(" sensi_meth = sim or stg\n"); printf(" err_con = t or f\n"); exit(0); } static void PrintIC(N_Vector y, N_Vector yp) { realtype* data; data = NV_DATA_S(y); printf("\n\nConsistent IC:\n"); printf("\ty = "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", data[0], data[1], data[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", data[0], data[1], data[2]); #else printf("%12.4e %12.4e %12.4e \n", data[0], data[1], data[2]); #endif data = NV_DATA_S(yp); printf("\typ= "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", data[0], data[1], data[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", data[0], data[1], data[2]); #else printf("%12.4e %12.4e %12.4e \n", data[0], data[1], data[2]); #endif } static void PrintSensIC(N_Vector y, N_Vector yp, N_Vector* yS, N_Vector* ypS) { realtype *sdata; sdata = NV_DATA_S(yS[0]); printf(" Sensitivity 1 "); printf("\n\ts1 = "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(ypS[0]); printf("\ts1'= "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif printf(" Sensitivity 2 "); sdata = NV_DATA_S(yS[1]); printf("\n\ts2 = "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(ypS[1]); printf("\ts2'= "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif printf(" Sensitivity 3 "); sdata = NV_DATA_S(yS[2]); printf("\n\ts3 = "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(ypS[2]); printf("\ts3'= "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif } /* * Print current t, step count, order, stepsize, and solution. */ static void PrintOutput(void *ida_mem, realtype t, N_Vector u) { long int nst; int qu, flag; realtype hu, *udata; udata = NV_DATA_S(u); flag = IDAGetNumSteps(ida_mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1); flag = IDAGetLastOrder(ida_mem, &qu); check_flag(&flag, "IDAGetLastOrder", 1); flag = IDAGetLastStep(ida_mem, &hu); check_flag(&flag, "IDAGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.3Le %2d %8.3Le %5ld\n", t, qu, hu, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.3le %2d %8.3le %5ld\n", t, qu, hu, nst); #else printf("%8.3e %2d %8.3e %5ld\n", t, qu, hu, nst); #endif printf(" Solution "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", udata[0], udata[1], udata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", udata[0], udata[1], udata[2]); #else printf("%12.4e %12.4e %12.4e \n", udata[0], udata[1], udata[2]); #endif } /* * Print sensitivities. */ static void PrintSensOutput(N_Vector *uS) { realtype *sdata; sdata = NV_DATA_S(uS[0]); printf(" Sensitivity 1 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(uS[1]); printf(" Sensitivity 2 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(uS[2]); printf(" Sensitivity 3 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif } /* * Print some final statistics from the IDAS memory. */ static void PrintFinalStats(void *ida_mem, booleantype sensi) { long int nst; long int nfe, nsetups, nni, ncfn, netf; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; long int nje, nfeLS; int flag; flag = IDAGetNumSteps(ida_mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1); flag = IDAGetNumResEvals(ida_mem, &nfe); check_flag(&flag, "IDAGetNumRhsEvals", 1); flag = IDAGetNumLinSolvSetups(ida_mem, &nsetups); check_flag(&flag, "IDAGetNumLinSolvSetups", 1); flag = IDAGetNumErrTestFails(ida_mem, &netf); check_flag(&flag, "IDAGetNumErrTestFails", 1); flag = IDAGetNumNonlinSolvIters(ida_mem, &nni); check_flag(&flag, "IDAGetNumNonlinSolvIters", 1); flag = IDAGetNumNonlinSolvConvFails(ida_mem, &ncfn); check_flag(&flag, "IDAGetNumNonlinSolvConvFails", 1); if (sensi) { flag = IDAGetSensNumResEvals(ida_mem, &nfSe); check_flag(&flag, "IDAGetSensNumRhsEvals", 1); flag = IDAGetNumResEvalsSens(ida_mem, &nfeS); check_flag(&flag, "IDAGetNumResEvalsSens", 1); flag = IDAGetSensNumLinSolvSetups(ida_mem, &nsetupsS); check_flag(&flag, "IDAGetSensNumLinSolvSetups", 1); flag = IDAGetSensNumErrTestFails(ida_mem, &netfS); check_flag(&flag, "IDAGetSensNumErrTestFails", 1); flag = IDAGetSensNumNonlinSolvIters(ida_mem, &nniS); check_flag(&flag, "IDAGetSensNumNonlinSolvIters", 1); flag = IDAGetSensNumNonlinSolvConvFails(ida_mem, &ncfnS); check_flag(&flag, "IDAGetSensNumNonlinSolvConvFails", 1); } flag = IDADlsGetNumJacEvals(ida_mem, &nje); check_flag(&flag, "IDADlsGetNumJacEvals", 1); flag = IDADlsGetNumResEvals(ida_mem, &nfeLS); check_flag(&flag, "IDADlsGetNumResEvals", 1); printf("\nFinal Statistics\n\n"); printf("nst = %5ld\n\n", nst); printf("nfe = %5ld\n", nfe); printf("netf = %5ld nsetups = %5ld\n", netf, nsetups); printf("nni = %5ld ncfn = %5ld\n", nni, ncfn); if(sensi) { printf("\n"); printf("nfSe = %5ld nfeS = %5ld\n", nfSe, nfeS); printf("netfs = %5ld nsetupsS = %5ld\n", netfS, nsetupsS); printf("nniS = %5ld ncfnS = %5ld\n", nniS, ncfnS); } printf("\n"); printf("nje = %5ld nfeLS = %5ld\n", nje, nfeLS); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasHeat2D_kry.c0000600000175000017500000004226511741421242023177 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, serial, GMRES. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform M x M grid. * The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR. The preconditioner uses the diagonal elements of the * Jacobian only. Routines for preconditioning, required by * IDASPGMR, are supplied here. The constraints u >= 0 are posed * for all components. Output is taken at t = 0, .01, .02, .04, * ..., 10.24. Two cases are run -- with the Gram-Schmidt type * being Modified in the first case, and Classical in the second. * The second run uses IDAReInit and IDAReInitSpgmr. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FOUR RCONST(4.0) /* User data type */ typedef struct { long int mm; /* number of grid points */ realtype dx; realtype coeff; N_Vector pp; /* vector of prec. diag. elements */ } *UserData; /* Prototypes for functions called by IDA */ int resHeat(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); /* Prototypes for private functions */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res); static void PrintHeader(realtype rtol, realtype atol); static void PrintOutput(void *mem, realtype t, N_Vector uu); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { void *mem; UserData data; N_Vector uu, up, constraints, res; int ier, iout; realtype rtol, atol, t0, t1, tout, tret; long int netf, ncfn, ncfl; mem = NULL; data = NULL; uu = up = constraints = res = NULL; /* Allocate N-vectors and the user data structure. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2)) return(1); /* Assign parameters in the user data structure. */ data->mm = MGRID; data->dx = ONE/(MGRID-ONE); data->coeff = ONE/(data->dx * data->dx); data->pp = N_VNew_Serial(NEQ); if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1); /* Initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Assign various parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1)) return(1); ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol); /* * ------------------------------------------------------------------------- * CASE I * ------------------------------------------------------------------------- */ /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 1: gsytpe = MODIFIED_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* * ------------------------------------------------------------------------- * CASE II * ------------------------------------------------------------------------- */ /* Re-initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Re-initialize IDA and IDASPGMR */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1)) return(1); ier = IDASpilsSetGSType(mem, CLASSICAL_GS); if(check_flag(&ier, "IDASpilsSetGSType",1)) return(1); /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 2: gstype = CLASSICAL_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* Free Memory */ IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(res); N_VDestroy_Serial(data->pp); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function (user-supplied) * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { long int i, j, offset, loc, mm; realtype *uu_data, *up_data, *rr_data, coeff, dif1, dif2; UserData data; uu_data = NV_DATA_S(uu); up_data = NV_DATA_S(up); rr_data = NV_DATA_S(rr); data = (UserData) user_data; coeff = data->coeff; mm = data->mm; /* Initialize rr to uu, to take care of boundary equations. */ N_VScale(ONE, uu, rr); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < MGRID-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; dif1 = uu_data[loc-1] + uu_data[loc+1] - TWO * uu_data[loc]; dif2 = uu_data[loc-mm] + uu_data[loc+mm] - TWO * uu_data[loc]; rr_data[loc]= up_data[loc] - coeff * ( dif1 + dif2 ); } } return(0); } /* * PsetupHeat: setup for diagonal preconditioner. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupdHeat argument list. */ int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, offset, loc, mm; realtype *ppv, pelinv; UserData data; data = (UserData) user_data; ppv = NV_DATA_S(data->pp); mm = data->mm; /* Initialize the entire vector to 1., then set the interior points to the correct value for preconditioning. */ N_VConst(ONE,data->pp); /* Compute the inverse of the preconditioner diagonal elements. */ pelinv = ONE/(c_j + FOUR*data->coeff); for (j = 1; j < mm-1; j++) { offset = mm * j; for (i = 1; i < mm-1; i++) { loc = offset + i; ppv[loc] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PrecondHeateq), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { UserData data; data = (UserData) user_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u and up vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res) { long int mm, mm1, i, j, offset, loc; realtype xfact, yfact, *udata, *updata; mm = data->mm; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); /* Initialize uu on all grid points. */ mm1 = mm - 1; for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Set up at boundary points to zero. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0; i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) updata[loc] = ZERO; } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol) { printf("\nidasHeat2D_kry: Heat equation, serial example problem for IDA \n"); printf(" Discretized heat equation on 2D unit square. \n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("Linear solver: IDASPGMR, preconditioner using diagonal elements. \n"); } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(void *mem, realtype t, N_Vector uu) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/CMakeLists.txt0000600000175000017500000001030011741421242022757 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.10 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for IDAS serial examples # Add variable IDAS_examples with the names of the serial IDAS examples SET(IDAS_examples idasAkzoNob_ASAi_dns idasAkzoNob_dns idasFoodWeb_bnd idasHeat2D_bnd idasHeat2D_kry idasHessian_ASA_FSA idasKrylovDemo_ls idasRoberts_ASAi_dns idasRoberts_dns idasRoberts_FSA_dns idasSlCrank_dns idasSlCrank_FSA_dns ) # Add variable IDAS_examples_BL with the names of the serial IDAS examples # that use Lapack SET(IDAS_examples_BL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDAS_LIB sundials_idas_static) SET(NVECS_LIB sundials_nvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDAS_LIB sundials_idas_shared) SET(NVECS_LIB sundials_nvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${IDAS_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each IDAS example FOREACH(example ${IDAS_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDAS_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${IDAS_examples_BL}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDAS_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDAS") SET(SOLVER_LIB "sundials_idas") LIST2STRING(IDAS_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(IDAS_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/idas/serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/idas/serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/idas/serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/idas/serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/idas/serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/idas/serial/Makefile.in0000600000175000017500000001073511741421242022300 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.16 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDAS serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/idas/libsundials_idas.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = idasAkzoNob_ASAi_dns \ idasAkzoNob_dns \ idasFoodWeb_bnd \ idasHeat2D_bnd \ idasHeat2D_kry \ idasHessian_ASA_FSA \ idasKrylovDemo_ls \ idasRoberts_ASAi_dns \ idasRoberts_dns \ idasRoberts_FSA_dns \ idasSlCrank_dns \ idasSlCrank_FSA_dns EXAMPLES_BL = OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/idas/serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/idas/serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/idas/serial/README $(EXS_INSTDIR)/idas/serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/serial/$${i}.c $(EXS_INSTDIR)/idas/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/serial/$${i}.out $(EXS_INSTDIR)/idas/serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/serial/$${i}.c $(EXS_INSTDIR)/idas/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/idas/serial/$${i}.out $(EXS_INSTDIR)/idas/serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/idas/serial/Makefile rm -f $(EXS_INSTDIR)/idas/serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/idas/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/idas/serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/idas/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/idas/serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/idas/serial $(rminstalldirs) $(EXS_INSTDIR)/idas clean: rm -rf .libs rm -f *.lo rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/idas/serial/idasHeat2D_kry.out0000600000175000017500000000514411741421242023557 0ustar sylvestresylvestre idasHeat2D_kry: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPGMR, preconditioner using diagonal elements. Case 1: gsytpe = MODIFIED_GS Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 0.00000e+00 1 39 51 77 51 77 1.05e-01 12 128 1.28 0.00000e+00 1 41 53 77 53 77 4.21e-01 14 130 2.56 0.00000e+00 1 43 55 77 55 77 1.69e+00 16 132 5.12 0.00000e+00 1 44 56 77 56 77 3.37e+00 17 133 10.24 0.00000e+00 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 Case 2: gstype = CLASSICAL_GS Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 2.15648e-20 1 39 51 77 51 77 1.05e-01 12 128 1.28 1.30250e-20 1 41 53 77 53 77 4.21e-01 14 130 2.56 3.00951e-20 1 43 55 77 55 77 1.69e+00 16 132 5.12 7.38674e-20 1 44 56 77 56 77 3.37e+00 17 133 10.24 1.79685e-19 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/idas/serial/idasRoberts_ASAi_dns.out0000600000175000017500000000226011741421242024740 0ustar sylvestresylvestre Adjoint Sensitivity Example for Chemical Kinetics ------------------------------------------------- DAE: dy1/dt + p1*y1 - p2*y2*y3 = 0 dy2/dt - p1*y1 + p2*y2*y3 + p3*(y2)^2 = 0 y1 + y2 + y3 = 0 Find dG/dp for G = int_t0^tB0 g(t,p,y) dt g(t,p,y) = y3 Create and allocate IDAS memory for forward runs Forward integration ... done ( nst = 816 ) -------------------------------------------------------- G: 4.0000e+10 -------------------------------------------------------- Create and allocate IDAS memory for backward run Backward integration ... done ( nst = 1272 ) -------------------------------------------------------- tB0: 4.0000e+10 dG/dp: 1.4879e+06 -5.9470e+00 9.9117e-04 lambda(t0): -2.4998e+01 1.6442e-03 1.0000e+00 -------------------------------------------------------- Re-initialize IDAS memory for backward run Backward integration ... done ( nst = 399 ) -------------------------------------------------------- tB0: 5.0000e+01 dG/dp: 1.7341e+02 -5.0592e-04 8.4323e-08 lambda(t0): -7.6780e+00 -1.2758e-04 1.0000e+00 -------------------------------------------------------- Free memory sundials-2.5.0/examples/idas/serial/idasAkzoNob_ASAi_dns.c0000600000175000017500000002703711741421242024307 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2008/04/17 20:12:55 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2007, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Adjoint sensitivity example problem * * This IVP is a stiff system of 6 non-linear DAEs of index 1. The * problem originates from Akzo Nobel Central research in Arnhern, * The Netherlands, and describes a chemical process in which 2 * species are mixed, while carbon dioxide is continuously added. * See http://pitagora.dm.uniba.it/~testset/report/chemakzo.pdf * * IDAS also computes the sensitivities with respect to initial * conditions of the following quantity: * G = int_t0^t1 y1 dt * The sensitivity of G is the solution of the adjoint system at t0. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component */ /* Problem Constants */ #define NEQ 6 #define T0 RCONST(0.0) #define TF RCONST(180.0) #define RTOL RCONST(1.0e-08) #define ATOL RCONST(1.0e-10) #define RTOLB RCONST(1.0e-06) #define ATOLB RCONST(1.0e-08) #define RTOLQ RCONST(1.0e-10) #define ATOLQ RCONST(1.0e-12) #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define STEPS 150 typedef struct { realtype k1, k2, k3, k4; realtype K, klA, Ks, pCO2, H; } *UserData; static int res(realtype t, N_Vector yy, N_Vector yd, N_Vector res, void *userdata); static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector ypB); static int check_flag(void *flagvalue, char *funcname, int opt); /* Main program */ int main() { UserData data; void *mem; N_Vector yy, yp, rr, q; N_Vector yB, ypB; int ncheck, flag; realtype time; long int nst, nstB; int indexB; mem = NULL; yy = yp = NULL; printf("\nAdjoint Sensitivity Example for Akzo-Nobel Chemical Kinetics\n"); printf("-------------------------------------------------------------\n"); printf("Sensitivity of G = int_t0^tf (y1) dt with respect to IC.\n"); printf("-------------------------------------------------------------\n\n"); /* Allocate user data. */ data = (UserData) malloc(sizeof(*data)); /* Fill user's data with the appropriate values for coefficients. */ data->k1 = RCONST(18.7); data->k2 = RCONST(0.58); data->k3 = RCONST(0.09); data->k4 = RCONST(0.42); data->K = RCONST(34.4); data->klA = RCONST(3.3); data->Ks = RCONST(115.83); data->pCO2 = RCONST(0.9); data->H = RCONST(737.0); /* Allocate N-vectors. */ yy = N_VNew_Serial(NEQ); if (check_flag((void *)yy, "N_VNew_Serial", 0)) return(1); yp = N_VNew_Serial(NEQ); if (check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); /* Consistent IC for y, y'. */ #define y01 0.444 #define y02 0.00123 #define y03 0.00 #define y04 0.007 #define y05 0.0 Ith(yy,1) = RCONST(y01); Ith(yy,2) = RCONST(y02); Ith(yy,3) = RCONST(y03); Ith(yy,4) = RCONST(y04); Ith(yy,5) = RCONST(y05); Ith(yy,6) = data->Ks * RCONST(y01) * RCONST(y04); /* Get y' = - res(t0, y, 0) */ N_VConst(ZERO, yp); rr = N_VNew_Serial(NEQ); res(T0, yy, yp, rr, data); N_VScale(-ONE, rr, yp); N_VDestroy_Serial(rr); /* Create and initialize q0 for quadratures. */ q = N_VNew_Serial(1); if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1); Ith(q,1) = ZERO; /* Call IDACreate and IDAInit to initialize IDA memory */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); flag = IDAInit(mem, res, T0, yy, yp); if(check_flag(&flag, "IDAInit", 1)) return(1); /* Set tolerances. */ flag = IDASStolerances(mem, RTOL, ATOL); if(check_flag(&flag, "IDASStolerances", 1)) return(1); /* Attach user data. */ flag = IDASetUserData(mem, data); if(check_flag(&flag, "IDASetUser", 1)) return(1); /* Attach linear solver. */ flag = IDADense(mem, NEQ); /* Initialize QUADRATURE(S). */ flag = IDAQuadInit(mem, rhsQ, q); if (check_flag(&flag, "IDAQuadInit", 1)) return(1); /* Set tolerances and error control for quadratures. */ flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ); if (check_flag(&flag, "IDAQuadSStolerances", 1)) return(1); flag = IDASetQuadErrCon(mem, TRUE); if (check_flag(&flag, "IDASetQuadErrCon", 1)) return(1); /* Prepare ADJOINT. */ flag = IDAAdjInit(mem, STEPS, IDA_HERMITE); if (check_flag(&flag, "IDAAdjInit", 1)) return(1); /* FORWARD run. */ printf("Forward integration ... "); flag = IDASolveF(mem, TF, &time, yy, yp, IDA_NORMAL, &ncheck); if (check_flag(&flag, "IDASolveF", 1)) return(1); flag = IDAGetNumSteps(mem, &nst); if (check_flag(&flag, "IDAGetNumSteps", 1)) return(1); printf("done ( nst = %ld )\n",nst); flag = IDAGetQuad(mem, &time, q); if (check_flag(&flag, "IDAGetQuad", 1)) return(1); printf("G: %24.16f \n",Ith(q,1)); printf("--------------------------------------------------------\n\n"); /* BACKWARD run */ /* Initialize yB */ yB = N_VNew_Serial(NEQ); if (check_flag((void *)yB, "N_VNew_Serial", 0)) return(1); N_VConst(ZERO, yB); ypB = N_VNew_Serial(NEQ); if (check_flag((void *)ypB, "N_VNew_Serial", 0)) return(1); N_VConst(ZERO, ypB); Ith(ypB,1) = - ONE; flag = IDACreateB(mem, &indexB); if (check_flag(&flag, "IDACreateB", 1)) return(1); flag = IDAInitB(mem, indexB, resB, TF, yB, ypB); if (check_flag(&flag, "IDAInitB", 1)) return(1); flag = IDASStolerancesB(mem, indexB, RTOLB, ATOLB); if (check_flag(&flag, "IDASStolerancesB", 1)) return(1); flag = IDASetUserDataB(mem, indexB, data); if (check_flag(&flag, "IDASetUserDataB", 1)) return(1); flag = IDASetMaxNumStepsB(mem, indexB, 1000); flag = IDADenseB(mem, indexB, NEQ); if (check_flag(&flag, "IDADenseB", 1)) return(1); printf("Backward integration ... "); flag = IDASolveB(mem, T0, IDA_NORMAL); if (check_flag(&flag, "IDASolveB", 1)) return(1); IDAGetNumSteps(IDAGetAdjIDABmem(mem, indexB), &nstB); printf("done ( nst = %ld )\n", nstB); flag = IDAGetB(mem, indexB, &time, yB, ypB); if (check_flag(&flag, "IDAGetB", 1)) return(1); PrintOutput(time, yB, ypB); IDAFree(&mem); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(yB); N_VDestroy_Serial(ypB); N_VDestroy_Serial(q); return(0); } static int res(realtype t, N_Vector yy, N_Vector yd, N_Vector res, void *userdata) { UserData data; realtype k1, k2, k3, k4; realtype K, klA, Ks, pCO2, H; realtype y1, y2, y3, y4, y5, y6; realtype yd1, yd2, yd3, yd4, yd5; realtype r1, r2, r3, r4, r5, Fin; data = (UserData) userdata; k1 = data->k1; k2 = data->k2; k3 = data->k3; k4 = data->k4; K = data->K; klA = data->klA; Ks = data->Ks; pCO2 = data->pCO2; H = data->H; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); y4 = Ith(yy,4); y5 = Ith(yy,5); y6 = Ith(yy,6); yd1 = Ith(yd,1); yd2 = Ith(yd,2); yd3 = Ith(yd,3); yd4 = Ith(yd,4); yd5 = Ith(yd,5); r1 = k1 * RPowerI(y1,4) * RSqrt(y2); r2 = k2 * y3 * y4; r3 = k2/K * y1 * y5; r4 = k3 * y1 * y4 * y4; r5 = k4 * y6 * y6 * RSqrt(y2); Fin = klA * ( pCO2/H - y2 ); Ith(res,1) = yd1 + TWO*r1 - r2 + r3 + r4; Ith(res,2) = yd2 + HALF*r1 + r4 + HALF*r5 - Fin; Ith(res,3) = yd3 - r1 + r2 - r3; Ith(res,4) = yd4 + r2 - r3 + TWO*r4; Ith(res,5) = yd5 - r2 + r3 - r5; Ith(res,6) = Ks*y1*y4 - y6; return(0); } /* * rhsQ routine. Computes quadrature(t,y). */ static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data) { Ith(qdot,1) = Ith(yy,1); return(0); } #define QUARTER RCONST(0.25) #define FOUR RCONST(4.0) #define EIGHT RCONST(8.0) /* * resB routine. Residual for adjoint system. */ static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB) { UserData data; realtype y1, y2, y3, y4, y5, y6; realtype yB1, yB2, yB3, yB4, yB5, yB6; realtype ypB1, ypB2, ypB3, ypB4, ypB5; realtype k1, k2, k3, k4; realtype K, klA, Ks, pCO2, H; realtype y2tohalf, y1to3, k2overK, tmp1, tmp2; data = (UserData) user_dataB; k1 = data->k1; k2 = data->k2; k3 = data->k3; k4 = data->k4; K = data->K; klA = data->klA; Ks = data->Ks; pCO2 = data->pCO2; H = data->H; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); y4 = Ith(yy,4); y5 = Ith(yy,5); y6 = Ith(yy,6); yB1 = Ith(yyB,1); yB2 = Ith(yyB,2); yB3 = Ith(yyB,3); yB4 = Ith(yyB,4); yB5 = Ith(yyB,5); yB6 = Ith(yyB,6); ypB1 = Ith(ypB,1); ypB2 = Ith(ypB,2); ypB3 = Ith(ypB,3); ypB4 = Ith(ypB,4); ypB5 = Ith(ypB,5); y2tohalf = sqrt(y2); y1to3 = y1*y1*y1; k2overK = k2/K; tmp1 = k1* y1to3 * y2tohalf; tmp2 = k3*y4*y4; Ith(rrB,1) = 1 + ypB1 - (EIGHT*tmp1 + k2overK*y5 + tmp2)*yB1 - (TWO*tmp1+tmp2)*yB2 + (FOUR*tmp1+k2overK*y5)*yB3 + k2overK*y5*(yB4-yB5) - TWO*tmp2*yB4 + Ks*y4*yB6; tmp1 = k1 * y1*y1to3 * (y2tohalf/y2); tmp2 = k4 * y6*y6 * (y2tohalf/y2); Ith(rrB,2) = ypB2 - tmp1*yB1 - (QUARTER*tmp1 + QUARTER*tmp2 + klA)*yB2 + HALF*tmp1*yB3 + HALF*tmp2*yB5; Ith(rrB,3) = ypB3 + k2*y4*(yB1-yB3-yB4+yB5); tmp1 = k3*y1*y4; tmp2 = k2*y3; Ith(rrB,4) = ypB4 + (tmp2-TWO*tmp1)*yB1 - TWO*tmp1*yB2 - tmp2*yB3 - (tmp2+FOUR*tmp1)*yB4 + tmp2*yB5 + Ks*y1*yB6; Ith(rrB,5) = ypB5 - k2overK*y1*(yB1-yB3-yB4+yB5); Ith(rrB,6) = k4*y6*y2tohalf*(2*yB5-yB2) - yB6; return 0; } /* * Print results after backward integration */ static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector ypB) { printf("dG/dy0: \t%12.4e\n\t\t%12.4e\n\t\t%12.4e\n\t\t%12.4e\n\t\t%12.4e\n\t\t%12.4e\n", Ith(yB,1), Ith(yB,2), Ith(yB,3), Ith(yB,4), Ith(yB,5), Ith(yB,6)); printf("--------------------------------------------------------\n\n"); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasSlCrank_FSA_dns.c0000600000175000017500000003254611741421242024136 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2009/04/29 20:40:07 $ * ----------------------------------------------------------------- * Programmer: Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Simulation of a slider-crank mechanism modelled with 3 generalized * coordinates: crank angle, connecting bar angle, and slider location. * The mechanism moves under the action of a constant horizontal * force applied to the connecting rod and a spring-damper connecting * the crank and connecting rod. * * The equations of motion are formulated as a system of stabilized * index-2 DAEs (Gear-Gupta-Leimkuhler formulation). * * IDAS also computes sensitivities with respect to the problem * parameters k (spring constant) and c (damper constant) of the * kinetic energy: * G = int_t0^tend g(t,y,p) dt, * where * g(t,y,p) = 0.5*J1*v1^2 + 0.5*J2*v3^2 + 0.5*m2*v2^2 * * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i= 1..NEQ */ /* Problem Constants */ #define NEQ 10 #define NP 2 #define TBEGIN RCONST(0.0) #define TEND RCONST(10.000) #define RTOLF RCONST(1.0e-06) #define ATOLF RCONST(1.0e-07) #define RTOLQ RCONST(1.0e-06) #define ATOLQ RCONST(1.0e-08) #define RTOLFD RCONST(1.0e-06) #define ATOLFD RCONST(1.0e-08) #define ZERO RCONST(0.00) #define QUARTER RCONST(0.25) #define HALF RCONST(0.50) #define ONE RCONST(1.00) #define TWO RCONST(2.00) #define FOUR RCONST(4.00) typedef struct { realtype a; realtype J1, J2, m1, m2; realtype l0; realtype params[2]; realtype F; } *UserData; static int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static int rhsQS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *rhsQS, void *user_data, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); static void setIC(N_Vector yy, N_Vector yp, UserData data); static void force(N_Vector yy, realtype *Q, UserData data); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * Main Program *-------------------------------------------------------------------- */ int main(void) { UserData data; void *mem; N_Vector yy, yp, id, q, *yyS, *ypS, *qS; realtype tret; realtype pbar[2]; realtype dp, G, Gm[2], Gp[2]; int flag, is; realtype atolS[NP]; id = N_VNew_Serial(NEQ); yy = N_VNew_Serial(NEQ); yp = N_VNew_Serial(NEQ); q = N_VNew_Serial(1); yyS= N_VCloneVectorArray(NP,yy); ypS= N_VCloneVectorArray(NP,yp); qS = N_VCloneVectorArray_Serial(NP, q); data = (UserData) malloc(sizeof *data); data->a = 0.5; /* half-length of crank */ data->J1 = 1.0; /* crank moment of inertia */ data->m2 = 1.0; /* mass of connecting rod */ data->m1 = 1.0; data->J2 = 2.0; /* moment of inertia of connecting rod */ data->params[0] = 1.0; /* spring constant */ data->params[1] = 1.0; /* damper constant */ data->l0 = 1.0; /* spring free length */ data->F = 1.0; /* external constant force */ N_VConst(ONE, id); NV_Ith_S(id, 9) = ZERO; NV_Ith_S(id, 8) = ZERO; NV_Ith_S(id, 7) = ZERO; NV_Ith_S(id, 6) = ZERO; printf("\nSlider-Crank example for IDAS:\n"); /* Consistent IC*/ setIC(yy, yp, data); for (is=0;isparams[0];pbar[1] = data->params[1]; flag = IDASetSensParams(mem, data->params, pbar, NULL); flag = IDASensEEtolerances(mem); IDASetSensErrCon(mem, TRUE); N_VConst(ZERO, q); flag = IDAQuadInit(mem, rhsQ, q); flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ); flag = IDASetQuadErrCon(mem, TRUE); N_VConst(ZERO, qS[0]); flag = IDAQuadSensInit(mem, rhsQS, qS); atolS[0] = atolS[1] = ATOLQ; flag = IDAQuadSensSStolerances(mem, RTOLQ, atolS); flag = IDASetQuadSensErrCon(mem, TRUE); /* Perform forward run */ printf("\nForward integration ... "); flag = IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); if (check_flag(&flag, "IDASolve", 1)) return(1); printf("done!\n"); PrintFinalStats(mem); IDAGetQuad(mem, &tret, q); printf("--------------------------------------------\n"); printf(" G = %24.16f\n", Ith(q,1)); printf("--------------------------------------------\n\n"); IDAGetQuadSens(mem, &tret, qS); printf("-------------F O R W A R D------------------\n"); printf(" dG/dp: %12.4le %12.4le\n", Ith(qS[0],1), Ith(qS[1],1)); printf("--------------------------------------------\n\n"); IDAFree(&mem); /* Finite differences for dG/dp */ dp = 0.00001; data->params[0] = ONE; data->params[1] = ONE; mem = IDACreate(); setIC(yy, yp, data); flag = IDAInit(mem, ressc, TBEGIN, yy, yp); flag = IDASStolerances(mem, RTOLFD, ATOLFD); flag = IDASetUserData(mem, data); flag = IDASetId(mem, id); flag = IDASetSuppressAlg(mem, TRUE); /* Call IDADense and set up the linear solver. */ flag = IDADense(mem, NEQ); N_VConst(ZERO, q); IDAQuadInit(mem, rhsQ, q); IDAQuadSStolerances(mem, RTOLQ, ATOLQ); IDASetQuadErrCon(mem, TRUE); IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); IDAGetQuad(mem,&tret,q); G = Ith(q,1); /*printf(" G =%12.6e\n", Ith(q,1));*/ /****************************** * BACKWARD for k ******************************/ data->params[0] -= dp; setIC(yy, yp, data); IDAReInit(mem, TBEGIN, yy, yp); N_VConst(ZERO, q); IDAQuadReInit(mem, q); IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); IDAGetQuad(mem, &tret, q); Gm[0] = Ith(q,1); /*printf("Gm[0]=%12.6e\n", Ith(q,1));*/ /**************************** * FORWARD for k * ****************************/ data->params[0] += (TWO*dp); setIC(yy, yp, data); IDAReInit(mem, TBEGIN, yy, yp); N_VConst(ZERO, q); IDAQuadReInit(mem, q); IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); IDAGetQuad(mem, &tret, q); Gp[0] = Ith(q,1); /*printf("Gp[0]=%12.6e\n", Ith(q,1));*/ /* Backward for c */ data->params[0] = ONE; data->params[1] -= dp; setIC(yy, yp, data); IDAReInit(mem, TBEGIN, yy, yp); N_VConst(ZERO, q); IDAQuadReInit(mem, q); IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); IDAGetQuad(mem, &tret, q); Gm[1] = Ith(q,1); /* Forward for c */ data->params[1] += (TWO*dp); setIC(yy, yp, data); IDAReInit(mem, TBEGIN, yy, yp); N_VConst(ZERO, q); IDAQuadReInit(mem, q); IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL); IDAGetQuad(mem, &tret, q); Gp[1] = Ith(q,1); IDAFree(&mem); printf("\n\n Checking using Finite Differences \n\n"); printf("---------------BACKWARD------------------\n"); printf(" dG/dp: %12.4le %12.4le\n", (G-Gm[0])/dp, (G-Gm[1])/dp); printf("-----------------------------------------\n\n"); printf("---------------FORWARD-------------------\n"); printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-G)/dp, (Gp[1]-G)/dp); printf("-----------------------------------------\n\n"); printf("--------------CENTERED-------------------\n"); printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-Gm[0])/(TWO*dp) ,(Gp[1]-Gm[1])/(TWO*dp)); printf("-----------------------------------------\n\n"); /* Free memory */ free(data); N_VDestroy(id); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(q); return(0); } static void setIC(N_Vector yy, N_Vector yp, UserData data) { realtype pi; realtype a, J1, m2, J2; realtype q, p, x; realtype Q[3]; N_VConst(ZERO, yy); N_VConst(ZERO, yp); pi = FOUR*atan(ONE); a = data->a; J1 = data->J1; m2 = data->m2; J2 = data->J2; q = pi/TWO; p = asin(-a); x = cos(p); NV_Ith_S(yy,0) = q; NV_Ith_S(yy,1) = x; NV_Ith_S(yy,2) = p; force(yy, Q, data); NV_Ith_S(yp,3) = Q[0]/J1; NV_Ith_S(yp,4) = Q[1]/m2; NV_Ith_S(yp,5) = Q[2]/J2; } static void force(N_Vector yy, realtype *Q, UserData data) { realtype a, k, c, l0, F; realtype q, x, p; realtype qd, xd, pd; realtype s1, c1, s2, c2, s21, c21; realtype l2, l, ld; realtype f, fl; a = data->a; k = data->params[0]; c = data->params[1]; l0 = data->l0; F = data->F; q = NV_Ith_S(yy,0); x = NV_Ith_S(yy,1); p = NV_Ith_S(yy,2); qd = NV_Ith_S(yy,3); xd = NV_Ith_S(yy,4); pd = NV_Ith_S(yy,5); s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x*x - x*(c2+a*c1) + (ONE + a*a)/FOUR + a*c21/TWO; l = RSqrt(l2); ld = TWO*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/TWO; ld /= TWO*l; f = k*(l-l0) + c*ld; fl = f/l; Q[0] = - fl * a * (s21/TWO + x*s1) / TWO; Q[1] = fl * (c2/TWO - x + a*c1/TWO) + F; Q[2] = - fl * (x*s2 - a*s21/TWO) / TWO - F*s2; } static int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { UserData data; realtype Q[3]; realtype a, J1, m2, J2; realtype *yval, *ypval, *rval; realtype q, x, p; realtype qd, xd, pd; realtype lam1, lam2, mu1, mu2; realtype s1, c1, s2, c2; data = (UserData) user_data; a = data->a; J1 = data->J1; m2 = data->m2; J2 = data->J2; yval = NV_DATA_S(yy); ypval = NV_DATA_S(yp); rval = NV_DATA_S(rr); q = yval[0]; x = yval[1]; p = yval[2]; qd = yval[3]; xd = yval[4]; pd = yval[5]; lam1 = yval[6]; lam2 = yval[7]; mu1 = yval[8]; mu2 = yval[9]; s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); force(yy, Q, data); rval[0] = ypval[0] - qd + a*s1*mu1 - a*c1*mu2; rval[1] = ypval[1] - xd + mu1; rval[2] = ypval[2] - pd + s2*mu1 - c2*mu2; rval[3] = J1*ypval[3] - Q[0] + a*s1*lam1 - a*c1*lam2; rval[4] = m2*ypval[4] - Q[1] + lam1; rval[5] = J2*ypval[5] - Q[2] + s2*lam1 - c2*lam2; rval[6] = x - c2 - a*c1; rval[7] = -s2 - a*s1; rval[8] = a*s1*qd + xd + s2*pd; rval[9] = -a*c1*qd - c2*pd; return(0); } static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data) { realtype v1, v2, v3; realtype m1, J1, m2, J2, a; UserData data; data = (UserData) user_data; J1 = data->J1; m1 = data->m1; m2 = data->m2; J2 = data->J2; a = data->a; v1 = Ith(yy,4); v2 = Ith(yy,5); v3 = Ith(yy,6); Ith(qdot,1) = HALF*(J1*v1*v1 + m2*v2*v2 + J2*v3*v3); return(0); } static int rhsQS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *rhsQS, void *user_data, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS) { realtype v1, v2, v3; realtype m1, J1, m2, J2, a; UserData data; realtype s1, s2, s3; data = (UserData) user_data; J1 = data->J1; m1 = data->m1; m2 = data->m2; J2 = data->J2; a = data->a; v1 = Ith(yy,4); v2 = Ith(yy,5); v3 = Ith(yy,6); /* Sensitivities of v. */ s1 = Ith(yyS[0],4); s2 = Ith(yyS[0],5); s3 = Ith(yyS[0],6); Ith(rhsQS[0], 1) = J1*v1*s1 + m2*v2*s2 + J2*v3*s3; s1 = Ith(yyS[1],4); s2 = Ith(yyS[1],5); s3 = Ith(yyS[1],6); Ith(rhsQS[1], 1) = J1*v1*s1 + m2*v2*s2 + J2*v3*s3; return(0); } static void PrintFinalStats(void *mem) { int flag; long int nst, nni, nje, nre, nreLS, netf, ncfn; flag = IDAGetNumSteps(mem, &nst); flag = IDAGetNumResEvals(mem, &nre); flag = IDADlsGetNumJacEvals(mem, &nje); flag = IDAGetNumNonlinSolvIters(mem, &nni); flag = IDAGetNumErrTestFails(mem, &netf); flag = IDAGetNumNonlinSolvConvFails(mem, &ncfn); flag = IDADlsGetNumResEvals(mem, &nreLS); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); } static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasHeat2D_bnd.c0000600000175000017500000003075611741421242023137 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, serial, banded. * * This example solves a discretized 2D heat equation problem. * This version uses the band solver IDABand, and IDACalcIC. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). * The PDE is treated with central differences on a uniform M x M * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the banded linear system * solver, half-bandwidths equal to M, and default * difference-quotient Jacobian. For purposes of illustration, * IDACalcIC is called to compute correct values at the boundary, * given incorrect values as input initial guesses. The constraints * u >= 0 are posed for all components. Output is taken at * t = 0, .01, .02, .04, ..., 10.24. (Output at t = 0 is for * IDACalcIC cost statistics only.) * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define BVAL RCONST(0.1) /* Type: UserData */ typedef struct { long int mm; realtype dx; realtype coeff; } *UserData; /* Prototypes of functions called by IDA */ int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); /* Prototypes of private functions */ static void PrintHeader(realtype rtol, realtype atol); static void PrintOutput(void *mem, realtype t, N_Vector u); static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector id, N_Vector res); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { void *mem; UserData data; N_Vector uu, up, constraints, id, res; int ier, iout; long int mu, ml, netf, ncfn; realtype rtol, atol, t0, t1, tout, tret; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Create vectors uu, up, res, constraints, id. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); id = N_VNew_Serial(NEQ); if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1); /* Create and load problem data block. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2)) return(1); data->mm = MGRID; data->dx = ONE/(MGRID - ONE); data->coeff = ONE/( (data->dx) * (data->dx) ); /* Initialize uu, up, id. */ SetInitialProfile(data, uu, up, id, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Set remaining input parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* Call IDABand to specify the linear solver. */ mu = MGRID; ml = MGRID; ier = IDABand(mem, NEQ, mu, ml); if(check_flag(&ier, "IDABand", 1)) return(1); /* Call IDACalcIC to correct the initial values. */ ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1); if(check_flag(&ier, "IDACalcIC", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol); PrintOutput(mem, t0, uu); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters and free memory. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); printf("\n netf = %ld, ncfn = %ld \n", netf, ncfn); IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(id); N_VDestroy_Serial(res); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * heatres: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data) { long int mm, i, j, offset, loc; realtype *uv, *upv, *resv, coeff; UserData data; uv = NV_DATA_S(uu); upv = NV_DATA_S(up); resv = NV_DATA_S(resval); data = (UserData)user_data; mm = data->mm; coeff = data->coeff; /* Initialize resval to uu, to take care of boundary equations. */ N_VScale(ONE, uu, resval); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < mm-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; resv[loc] = upv[loc] - coeff * (uv[loc-1] + uv[loc+1] + uv[loc-mm] + uv[loc+mm] - RCONST(4.0)*uv[loc]); } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u, up, and id vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector id, N_Vector res) { realtype xfact, yfact, *udata, *updata, *iddata; long int mm, mm1, i, j, offset, loc; mm = data->mm; mm1 = mm - 1; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); iddata = NV_DATA_S(id); /* Initialize id to 1's. */ N_VConst(ONE, id); /* Initialize uu on all grid points. */ for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* heatres sets res to negative of ODE RHS values at interior points. */ heatres(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Finally, set values of u, up, and id at boundary points. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0;i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) { udata[loc] = BVAL; updata[loc] = ZERO; iddata[loc] = ZERO; } } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol) { printf("\nidasHeat2D_bnd: Heat equation, serial example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("Linear solver: IDABAND, banded direct solver \n"); printf(" difference quotient Jacobian, half-bandwidths = %d \n",MGRID); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("IDACalcIC called with input boundary values = %Lg \n",BVAL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("IDACalcIC called with input boundary values = %lg \n",BVAL); #else printf("IDACalcIC called with input boundary values = %g \n",BVAL); #endif /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h \n" ); printf(" . . . . . . . . . . . . . . . . . . . . . \n"); } /* * Print Output */ static void PrintOutput(void *mem, realtype t, N_Vector uu) { int ier; realtype umax, hused; long int nst, nni, nje, nre, nreLS; int kused; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDADlsGetNumJacEvals(mem, &nje); check_flag(&ier, "IDADlsGetNumJacEvals", 1); ier = IDADlsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDADlsGetNumResEvals", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasFoodWeb_bnd.c0000600000175000017500000005251711741421242023414 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web problem. * * This example program (serial version) uses the IDABAND linear * solver, and IDACalcIC for initial condition calculation. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh. * * The DAE system is solved by IDA using the IDABAND linear solver. * Output is printed at t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, Journal * of Applied Mathematics and Computation, Vol. 31 (May 1989), * pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants. */ #define NPREY 1 /* No. of prey (= no. of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) #define FOURPI (RCONST(4.0)*PI) #define MX 20 /* MX = number of x mesh points */ #define MY 20 /* MY = number of y mesh points */ #define NSMX (NUM_SPECIES * MX) #define NEQ (NUM_SPECIES*MX*MY) #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* Relative tolerance */ #define ATOL RCONST(1.e-5) /* Absolute tolerance */ #define NOUT 6 /* Number of output times */ #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ #define ZERO RCONST(0.) #define ONE RCONST(1.0) /* * User-defined vector and accessor macro: IJ_Vptr. * IJ_Vptr is defined in order to express the underlying 3-D structure of * the dependent variable vector from its underlying 1-D storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_S(vv, (i)*NUM_SPECIES + (j)*NSMX)) /* Type: UserData. Contains problem constants, etc. */ typedef struct { long int Neq, ns, np, mx, my; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES]; N_Vector rates; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int resweb(realtype time, N_Vector cc, N_Vector cp, N_Vector resval, void *user_data); /* Prototypes for private Helper Functions. */ static void InitUserData(UserData webdata); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, UserData webdata); static void PrintHeader(long int mu, long int ml, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector c, realtype t); static void PrintFinalStats(void *mem); static void Fweb(realtype tcalc, N_Vector cc, N_Vector crate, UserData webdata); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(long int size, realtype *x1, realtype *x2); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { void *mem; UserData webdata; N_Vector cc, cp, id; int iout, retval; long int mu, ml; realtype rtol, atol, t0, tout, tret; mem = NULL; webdata = NULL; cc = cp = id = NULL; /* Allocate and initialize user data block webdata. */ webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Serial(NEQ); webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); InitUserData(webdata); /* Allocate N-vectors and initialize cc, cp, and id. */ cc = N_VNew_Serial(NEQ); if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1); cp = N_VNew_Serial(NEQ); if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1); id = N_VNew_Serial(NEQ); if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1); SetInitialProfiles(cc, cp, id, webdata); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize IDA. */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); retval = IDASetUserData(mem, webdata); if(check_flag(&retval, "IDASetUserData", 1)) return(1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1)) return(1); retval = IDAInit(mem, resweb, t0, cc, cp); if(check_flag(&retval, "IDAInit", 1)) return(1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1)) return(1); /* Call IDABand to specify the IDA linear solver. */ mu = ml = NSMX; retval = IDABand(mem, NEQ, mu, ml); if(check_flag(&retval, "IDABand", 1)) return(1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1)) return(1); /* Print heading, basic parameters, and initial values. */ PrintHeader(mu, ml, rtol, atol); PrintOutput(mem, cc, ZERO); /* Loop over iout, call IDASolve (normal mode), print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1)) return(retval); PrintOutput(mem, cc, tret); if (iout < 3) tout *= TMULT; else tout += TADD; } /* Print final statistics and free memory. */ PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Serial(cc); N_VDestroy_Serial(cp); N_VDestroy_Serial(id); destroyMat(webdata->acoef); N_VDestroy_Serial(webdata->rates); free(webdata); return(0); } /* Define lines for readability in later routines */ #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) #define cox (webdata->cox) #define coy (webdata->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * This routine calls Fweb to get all the right-hand sides of the * equations, then loads the residual vector accordingly, * using cp in the case of prey species. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { long int jx, jy, is, yloc, loc, np; realtype *resv, *cpv; UserData webdata; webdata = (UserData)user_data; cpv = NV_DATA_S(cp); resv = NV_DATA_S(res); np = webdata->np; /* Call Fweb to set res to vector of right-hand sides. */ Fweb(tt, cc, res, webdata); /* Loop over all grid points, setting residual values appropriately for differential or algebraic components. */ for (jy = 0; jy < MY; jy++) { yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { loc = yloc + NUM_SPECIES * jx; for (is = 0; is < NUM_SPECIES; is++) { if (is < np) resv[loc+is] = cpv[loc+is] - resv[loc+is]; else resv[loc+is] = -resv[loc+is]; } } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2; webdata->mx = MX; webdata->my = MY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->Neq= NEQ; /* Set up the coefficients a and b, and others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, UserData webdata) { long int loc, yloc, is, jx, jy, np; realtype xx, yy, xyfactor, fac; realtype *ccv, *cpv, *idv; ccv = NV_DATA_S(cc); cpv = NV_DATA_S(cp); idv = NV_DATA_S(id); np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < MY; jy++) { yy = jy * webdata->dy; yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { xx = jx * webdata->dx; xyfactor = RCONST(16.0)*xx*(ONE-xx)*yy*(ONE-yy); xyfactor *= xyfactor; loc = yloc + NUM_SPECIES*jx; fac = ONE + ALPHA * xx * yy + BETA * sin(FOURPI*xx) * sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) { ccv[loc+is] = RCONST(10.0) + (realtype)(is+1) * xyfactor; idv[loc+is] = ONE; } else { ccv[loc+is] = RCONST(1.0e5); idv[loc+is] = ZERO; } } } } /* Set c' for the prey by calling the function Fweb. */ Fweb(ZERO, cc, cp, webdata); /* Set c' for predators to 0. */ for (jy = 0; jy < MY; jy++) { yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { loc = yloc + NUM_SPECIES * jx; for (is = np; is < NUM_SPECIES; is++) { cpv[loc+is] = ZERO; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(long int mu, long int ml, realtype rtol, realtype atol) { printf("\nidasFoodWeb_bnd: Predator-prey DAE serial example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" System size: %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDABAND, Band parameters mu = %ld, ml = %ld\n",mu,ml); printf("CalcIC called to correct initial predator concentrations.\n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of the concentrations * are printed for the bottom left and top right grid points only. */ static void PrintOutput(void *mem, N_Vector c, realtype t) { int i, kused, flag; long int nst; realtype *c_bl, *c_tr, hused; flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1); c_bl = IJ_Vptr(c,0,0); c_tr = IJ_Vptr(c,MX-1,MY-1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", t, c_bl[0], c_tr[1], nst, kused, hused); for (i=1;idy) * jy ; idyu = (jy!=MY-1) ? NSMX : -NSMX; idyl = (jy!= 0 ) ? NSMX : -NSMX; for (jx = 0; jx < MX; jx++) { xx = (webdata->dx) * jx; idxu = (jx!= MX-1) ? NUM_SPECIES : -NUM_SPECIES; idxl = (jx!= 0 ) ? NUM_SPECIES : -NUM_SPECIES; cxy = IJ_Vptr(cc,jx,jy); ratesxy = IJ_Vptr(webdata->rates,jx,jy); cratexy = IJ_Vptr(crate,jx,jy); /* Get interaction vector at this grid point. */ WebRates(xx, yy, cxy, ratesxy, webdata); /* Loop over species, do differencing, load crate segment. */ for (is = 0; is < NUM_SPECIES; is++) { /* Differencing in y. */ dcyli = *(cxy+is) - *(cxy - idyl + is) ; dcyui = *(cxy + idyu + is) - *(cxy+is); /* Differencing in x. */ dcxli = *(cxy+is) - *(cxy - idxl + is); dcxui = *(cxy + idxu +is) - *(cxy+is); /* Compute the crate values at (xx,yy). */ cratexy[is] = coy[is] * (dcyui - dcyli) + cox[is] * (dcxui - dcxli) + ratesxy[is]; } /* End is loop */ } /* End of jx loop */ } /* End of jy loop */ } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(long int size, realtype *x1, realtype *x2) { long int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasHessian_ASA_FSA.c0000600000175000017500000005110111741421242023777 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:39 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2007, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * * Hessian using adjoint sensitivity example problem. * * This simple example problem for IDAS, due to Robertson, * is from chemical kinetics, and consists of the following three * equations: * * [ y1' + p1 * y1 - p2 * y2 * y3 = 0 * [ y2' - p1 * y1 + p2 * y2 * y3 + p3 * y2^2 = 0 * [ y1 + y2 + y3 -1 = 0 * * [1] [-p1] * y(0)=[0] y'(0)=[ p1] p1 = 0.04 p2 = 1e4 p3 = 1e07 * [0] [ 0 ] * * 80 * / * G = | 0.5 * (y1^2 + y2^2 + y3^2) dt * / * 0 * Compute the gradient (using FSA and ASA) and Hessian (FSA over ASA) * of G with respect to parameters p1 and p2. * * Reference: D.B. Ozyurt and P.I. Barton, SISC 26(5) 1725-1743, 2005. * * Error handling was suppressed for code readibility reasons. */ #include #include #include #include #include #include #include /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i= 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* (i,j)-th matrix component i,j = 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define NP 2 /* number of sensitivities */ #define T0 RCONST(0.0) /* Initial time. */ #define TF RCONST(80.0) /* Final time. */ /* Tolerances */ #define RTOL RCONST(1e-08) /* scalar relative tolerance */ #define ATOL RCONST(1e-10) /* vector absolute tolerance components */ #define RTOLA RCONST(1e-08) /* for adjoint integration */ #define ATOLA RCONST(1e-08) /* for adjoint integration */ /* Parameters */ #define P1 RCONST(0.04) #define P2 RCONST(1.0e4) #define P3 RCONST(3.0e7) /* Predefined consts */ #define HALF RCONST(0.5) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* User defined struct */ typedef struct { realtype p[3]; } *UserData; /* residual for forward problem */ static int res(realtype t, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int resS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static int rhsQS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *rhsQS, void *user_data, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); static int resBS1(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector resvalBQ, void *user_dataB); static int rhsQBS1(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsBQS, void *user_dataB); static int resBS2(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector resvalBQ, void *user_dataB); static int rhsQBS2(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsBQS, void *user_dataB); int main(int argc, char *argv[]) { N_Vector yy, yp, q, *yyS, *ypS, *qS; N_Vector yyB1, ypB1, qB1, yyB2, ypB2, qB2; void *ida_mem; UserData data; realtype time, ti, tf; int flag, nckp, indexB1, indexB2; realtype G, Gm, Gp, dp1, dp2, grdG_fwd[2], grdG_bck[2], grdG_cntr[2], H11, H22; realtype rtolFD, atolFD; /* Print problem description */ printf("\nAdjoint Sensitivity Example for Chemical Kinetics\n"); printf("---------------------------------------------------------\n"); printf("DAE: dy1/dt + p1*y1 - p2*y2*y3 = 0\n"); printf(" dy2/dt - p1*y1 + p2*y2*y3 + p3*(y2)^2 = 0\n"); printf(" y1 + y2 + y3 = 0\n\n"); printf("Find dG/dp and d^2G/dp^2, where p=[p1,p2] for\n"); printf(" G = int_t0^tB0 g(t,p,y) dt\n"); printf(" g(t,p,y) = y3\n\n\n"); /* Alocate and initialize user data. */ data = (UserData) malloc(sizeof(*data)); data->p[0] = P1; data->p[1] = P2; data->p[2] = P3; /* Consistent IC */ yy = N_VNew_Serial(NEQ); yp = N_VNew_Serial(NEQ); Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; Ith(yp,1) = -P1; Ith(yp,2) = P1; Ith(yp,3) = 0; q = N_VNew_Serial(1); N_VConst(ZERO, q); yyS = N_VCloneVectorArray_Serial(NP, yy); ypS = N_VCloneVectorArray_Serial(NP, yp); N_VConst(ZERO, yyS[0]); N_VConst(ZERO, yyS[1]); N_VConst(ZERO, ypS[0]); N_VConst(ZERO, ypS[1]); qS = N_VCloneVectorArray_Serial(NP, q); N_VConst(ZERO, qS[0]); ida_mem = IDACreate(); ti = T0; flag = IDAInit(ida_mem, res, ti, yy, yp); /* Forward problem's setup. */ flag = IDASStolerances(ida_mem, RTOL, ATOL); flag = IDADense(ida_mem, NEQ); flag = IDASetUserData(ida_mem, data); flag = IDASetMaxNumSteps(ida_mem, 1500); /* Quadrature's setup. */ flag = IDAQuadInit(ida_mem, rhsQ, q); flag = IDAQuadSStolerances(ida_mem, RTOL, ATOL); flag = IDASetQuadErrCon(ida_mem, TRUE); /* Sensitivity's setup. */ flag = IDASensInit(ida_mem, NP, IDA_SIMULTANEOUS, resS, yyS, ypS); flag = IDASensEEtolerances(ida_mem); flag = IDASetSensErrCon(ida_mem, TRUE); /* Setup of quadrature's sensitivities */ flag = IDAQuadSensInit(ida_mem, rhsQS, qS); flag = IDAQuadSensEEtolerances(ida_mem); flag = IDASetQuadSensErrCon(ida_mem, TRUE); /* Initialize ASA. */ flag = IDAAdjInit(ida_mem, 100, IDA_HERMITE); printf("---------------------------------------------------------\n"); printf("Forward integration\n"); printf("---------------------------------------------------------\n\n"); tf = TF; flag = IDASolveF(ida_mem, tf, &time, yy, yp, IDA_NORMAL, &nckp); IDAGetQuad(ida_mem, &time, q); G = Ith(q,1); printf(" G: %12.4le\n", G); /* Sensitivities are needed for IC of backward problems. */ IDAGetSensDky(ida_mem, tf, 0, yyS); IDAGetSensDky(ida_mem, tf, 1, ypS); IDAGetQuadSens(ida_mem, &time, qS); printf(" dG/dp: %12.4le %12.4le\n", Ith(qS[0],1), Ith(qS[1],1)); printf("\n"); /****************************** * BACKWARD PROBLEM #1 *******************************/ /* Consistent IC. */ yyB1 = N_VNew_Serial(2*NEQ); ypB1 = N_VNew_Serial(2*NEQ); N_VConst(ZERO, yyB1); Ith(yyB1,3) = Ith(yy,3); Ith(yyB1,6) = Ith(yyS[0], 3); N_VConst(ZERO, ypB1); Ith(ypB1,1) = Ith(yy,3)-Ith(yy,1); Ith(ypB1,2) = Ith(yy,3)-Ith(yy,2); Ith(ypB1,4) = Ith(yyS[0],3) - Ith(yyS[0],1); Ith(ypB1,5) = Ith(yyS[0],3) - Ith(yyS[0],2); qB1 = N_VNew_Serial(2*NP); N_VConst(ZERO, qB1); flag = IDACreateB(ida_mem, &indexB1); flag = IDAInitBS(ida_mem, indexB1, resBS1, tf, yyB1, ypB1); flag = IDASStolerancesB(ida_mem, indexB1, RTOLA, ATOLA); flag = IDASetUserDataB(ida_mem, indexB1, data); flag = IDASetMaxNumStepsB(ida_mem, indexB1, 5000); flag = IDADenseB(ida_mem, indexB1, 2*NEQ); flag = IDAQuadInitBS(ida_mem, indexB1, rhsQBS1, qB1); /****************************** * BACKWARD PROBLEM #2 *******************************/ /* Consistent IC. */ yyB2 = N_VNew_Serial(2*NEQ); ypB2 = N_VNew_Serial(2*NEQ); N_VConst(ZERO, yyB2); Ith(yyB2,3) = Ith(yy,3); Ith(yyB2,6) = Ith(yyS[1],3); N_VConst(ZERO, ypB2); Ith(ypB2,1) = Ith(yy,3)-Ith(yy,1); Ith(ypB2,2) = Ith(yy,3)-Ith(yy,2); Ith(ypB2,4) = Ith(yyS[1],3) - Ith(yyS[1],1); Ith(ypB2,5) = Ith(yyS[1],3) - Ith(yyS[1],2); qB2 = N_VNew_Serial(2*NP); N_VConst(ZERO, qB2); flag = IDACreateB(ida_mem, &indexB2); flag = IDAInitBS(ida_mem, indexB2, resBS2, tf, yyB2, ypB2); flag = IDASStolerancesB(ida_mem, indexB2, RTOLA, ATOLA); flag = IDASetUserDataB(ida_mem, indexB2, data); flag = IDASetMaxNumStepsB(ida_mem, indexB2, 2500); flag = IDADenseB(ida_mem, indexB2, 2*NEQ); flag = IDAQuadInitBS(ida_mem, indexB2, rhsQBS2, qB2); /* Integrate backward problems. */ printf("---------------------------------------------------------\n"); printf("Backward integration \n"); printf("---------------------------------------------------------\n\n"); flag = IDASolveB(ida_mem, ti, IDA_NORMAL); flag = IDAGetB(ida_mem, indexB1, &time, yyB1, ypB1); //flag = IDAGetNumSteps(IDAGetAdjIDABmem(ida_mem, indexB1), &nst); //printf("at time=%g \tpb 1 Num steps:%d\n", time, nst); //flag = IDAGetNumSteps(IDAGetAdjIDABmem(ida_mem, indexB2), &nst); //printf("at time=%g \tpb 2 Num steps:%d\n\n", time, nst); flag = IDAGetQuadB(ida_mem, indexB1, &time, qB1); flag = IDAGetQuadB(ida_mem, indexB2, &time, qB2); printf(" dG/dp: %12.4le %12.4le (from backward pb. 1)\n", Ith(qB1,1), Ith(qB1,2)); printf(" dG/dp: %12.4le %12.4le (from backward pb. 2)\n", Ith(qB2,1), Ith(qB2,2)); printf("\n"); printf(" H = d2G/dp2:\n"); printf(" (1) (2)\n"); printf(" %12.4le %12.4le\n", Ith(qB1,3), Ith(qB2,3)); printf(" %12.4le %12.4le\n", Ith(qB1,4), Ith(qB2,4)); IDAFree(&ida_mem); /********************************* * Use Finite Differences to verify **********************************/ /* Perturbations are of different magnitudes as p1 and p2 are. */ dp1 = RCONST(1.0e-3); dp2 = RCONST(2.5e+2); printf("\n"); printf("---------------------------------------------------------\n"); printf("Finite Differences ( dp1=%6.1e and dp2 = %6.1e )\n", dp1, dp2); printf("---------------------------------------------------------\n\n"); ida_mem = IDACreate(); /******************** * Forward FD for p1 ********************/ data->p[0] += dp1; Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; Ith(yp,1) = -data->p[0]; Ith(yp,2) = -Ith(yp,1); Ith(yp,3) = 0; N_VConst(ZERO, q); ti = T0; tf = TF; flag = IDAInit(ida_mem, res, ti, yy, yp); rtolFD = RCONST(1.0e-12); atolFD = RCONST(1.0e-14); flag = IDASStolerances(ida_mem, rtolFD, atolFD); flag = IDADense(ida_mem, NEQ); flag = IDASetUserData(ida_mem, data); flag = IDASetMaxNumSteps(ida_mem, 10000); flag = IDAQuadInit(ida_mem, rhsQ, q); flag = IDAQuadSStolerances(ida_mem, rtolFD, atolFD); flag = IDASetQuadErrCon(ida_mem, TRUE); flag = IDASolve(ida_mem, tf, &time, yy, yp, IDA_NORMAL); flag = IDAGetQuad(ida_mem, &time, q); Gp = Ith(q,1); /******************** * Backward FD for p1 ********************/ data->p[0] -= 2*dp1; Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; Ith(yp,1) = -data->p[0]; Ith(yp,2) = -Ith(yp,1); Ith(yp,3) = 0; N_VConst(ZERO, q); flag = IDAReInit(ida_mem, ti, yy, yp); flag = IDAQuadReInit(ida_mem, q); flag = IDASolve(ida_mem, tf, &time, yy, yp, IDA_NORMAL); flag = IDAGetQuad(ida_mem, &time, q); Gm = Ith(q,1); /* Compute FD for p1. */ grdG_fwd[0] = (Gp-G)/dp1; grdG_bck[0] = (G-Gm)/dp1; grdG_cntr[0] = (Gp-Gm)/(2.0*dp1); H11 = (Gp - 2.0*G + Gm) / (dp1*dp1); /******************** * Forward FD for p2 ********************/ /*restore p1*/ data->p[0] += dp1; data->p[1] += dp2; Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; Ith(yp,1) = -data->p[0]; Ith(yp,2) = -Ith(yp,1); Ith(yp,3) = 0; N_VConst(ZERO, q); flag = IDAReInit(ida_mem, ti, yy, yp); flag = IDAQuadReInit(ida_mem, q); flag = IDASolve(ida_mem, tf, &time, yy, yp, IDA_NORMAL); flag = IDAGetQuad(ida_mem, &time, q); Gp = Ith(q,1); /******************** * Backward FD for p2 ********************/ data->p[1] -= 2*dp2; Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; Ith(yp,1) = -data->p[0]; Ith(yp,2) = -Ith(yp,1); Ith(yp,3) = 0; N_VConst(ZERO, q); flag = IDAReInit(ida_mem, ti, yy, yp); flag = IDAQuadReInit(ida_mem, q); flag = IDASolve(ida_mem, tf, &time, yy, yp, IDA_NORMAL); flag = IDAGetQuad(ida_mem, &time, q); Gm = Ith(q,1); /* Compute FD for p2. */ grdG_fwd[1] = (Gp-G)/dp2; grdG_bck[1] = (G-Gm)/dp2; grdG_cntr[1] = (Gp-Gm)/(2.0*dp2); H22 = (Gp - 2.0*G + Gm) / (dp2*dp2); printf("\n"); printf(" dG/dp: %12.4le %12.4le (fwd FD)\n", grdG_fwd[0], grdG_fwd[1]); printf(" %12.4le %12.4le (bck FD)\n", grdG_bck[0], grdG_bck[1]); printf(" %12.4le %12.4le (cntr FD)\n", grdG_cntr[0], grdG_cntr[1]); printf("\n"); printf(" H(1,1): %12.4le\n", H11); printf(" H(2,2): %12.4le\n", H22); IDAFree(&ida_mem); N_VDestroy_Serial(yyB1); N_VDestroy_Serial(ypB1); N_VDestroy_Serial(qB1); N_VDestroy_Serial(yyB2); N_VDestroy_Serial(ypB2); N_VDestroy_Serial(qB2); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(q); N_VDestroyVectorArray_Serial(yyS, NP); N_VDestroyVectorArray_Serial(ypS, NP); N_VDestroyVectorArray_Serial(qS, NP); free(data); return 0; } static int res(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { realtype y1, y2, y3, yp1, yp2, yp3, *rval; UserData data; realtype p1, p2, p3; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); yp1 = Ith(yp,1); yp2 = Ith(yp,2); yp3 = Ith(yp,3); rval = NV_DATA_S(rr); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; rval[0] = p1*y1-p2*y2*y3; rval[1] = -rval[0] + p3*y2*y2 + yp2; rval[0]+= yp1; rval[2] = y1+y2+y3-1; return(0); } static int resS(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { UserData data; realtype p1, p2, p3; realtype y1, y2, y3; realtype yp1, yp2, yp3; realtype s1, s2, s3; realtype sd1, sd2, sd3; realtype rs1, rs2, rs3; int is; data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); yp1 = Ith(yp,1); yp2 = Ith(yp,2); yp3 = Ith(yp,3); for (is=0; isp[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector. */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector. */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* The mu vector. */ m1 = Ith(yyB,4); m2 = Ith(yyB,5); m3 = Ith(yyB,6); /* The lambda dot vector. */ lp1 = Ith(ypB,1); lp2 = Ith(ypB,2); /* The mu dot vector. */ mp1 = Ith(ypB,4); mp2 = Ith(ypB,5); /* The sensitivity with respect to p1 */ s1 = Ith(yyS[0],1); s2 = Ith(yyS[0],2); s3 = Ith(yyS[0],3); /* Temporary variables */ l21 = l2-l1; Ith(rrBS,1) = lp1 + p1*l21 - l3 + y1; Ith(rrBS,2) = lp2 - p2*y3*l21 - TWO*p3*y2*l2 - l3 + y2; Ith(rrBS,3) = -p2*y2*l21 - l3 + y3; Ith(rrBS,4) = mp1 + p1*(-m1+m2) - m3 + l21 + s1; Ith(rrBS,5) = mp2 + p2*y3*m1 - (p2*y3+TWO*p3*y2)*m2 - m3 + p2*s3*l1 - (TWO*p3*s2+p2*s3)*l2 + s2; Ith(rrBS,6) = p2*y2*(m1-m2) - m3 - p2*s2*l21 + s3; return(0); } static int rhsQBS1(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsBQS, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3, m1, m2, m3; realtype s1, s2, s3; realtype l21; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector. */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* The mu vector. */ m1 = Ith(yyB,4); m2 = Ith(yyB,5); m3 = Ith(yyB,6); /* The sensitivity with respect to p1 */ s1 = Ith(yyS[0],1); s2 = Ith(yyS[0],2); s3 = Ith(yyS[0],3); /* Temporary variables */ l21 = l2-l1; Ith(rhsBQS,1) = -y1*l21; Ith(rhsBQS,2) = y2*y3*l21; Ith(rhsBQS,3) = y1*(m1-m2) - s1*l21; Ith(rhsBQS,4) = y2*y3*(m2-m1) + (y3*s2+y2*s3)*l21; return(0); } static int resBS2(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrBS, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3, m1, m2, m3; realtype lp1, lp2, mp1, mp2; realtype s1, s2, s3; realtype l21; data = (UserData) user_dataB; /* The parameters. */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector. */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector. */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* The mu vector. */ m1 = Ith(yyB,4); m2 = Ith(yyB,5); m3 = Ith(yyB,6); /* The lambda dot vector. */ lp1 = Ith(ypB,1); lp2 = Ith(ypB,2); /* The mu dot vector. */ mp1 = Ith(ypB,4); mp2 = Ith(ypB,5); /* The sensitivity with respect to p2 */ s1 = Ith(yyS[1],1); s2 = Ith(yyS[1],2); s3 = Ith(yyS[1],3); /* Temporary variables */ l21 = l2-l1; Ith(rrBS,1) = lp1 + p1*l21 - l3 + y1; Ith(rrBS,2) = lp2 - p2*y3*l21 - TWO*p3*y2*l2 - l3 + y2; Ith(rrBS,3) = -p2*y2*l21 - l3 + y3; Ith(rrBS,4) = mp1 + p1*(-m1+m2) - m3 + s1; Ith(rrBS,5) = mp2 + p2*y3*m1 - (p2*y3+TWO*p3*y2)*m2 - m3 + (y3+p2*s3)*l1 - (y3+TWO*p3*s2+p2*s3)*l2 + s2; Ith(rrBS,6) = p2*y2*(m1-m2) - m3 - (y2+p2*s2)*l21 + s3; return(0); } static int rhsQBS2(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsBQS, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3, m1, m2, m3; realtype s1, s2, s3; realtype l21; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector. */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* The mu vector. */ m1 = Ith(yyB,4); m2 = Ith(yyB,5); m3 = Ith(yyB,6); /* The sensitivity with respect to p2 */ s1 = Ith(yyS[1],1); s2 = Ith(yyS[1],2); s3 = Ith(yyS[1],3); /* Temporary variables */ l21 = l2-l1; Ith(rhsBQS,1) = -y1*l21; Ith(rhsBQS,2) = y2*y3*l21; Ith(rhsBQS,3) = y1*(m1-m2) - s1*l21; Ith(rhsBQS,4) = y2*y3*(m2-m1) + (y3*s2+y2*s3)*l21; return(0); } sundials-2.5.0/examples/idas/serial/idasHeat2D_bnd.out0000600000175000017500000000271111741421242023512 0ustar sylvestresylvestre idasHeat2D_bnd: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDABAND, banded direct solver difference quotient Jacobian, half-bandwidths = 10 IDACalcIC called with input boundary values = 0.1 Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h . . . . . . . . . . . . . . . . . . . . . 0.00 9.75461e-01 0 0 1 2 3 42 1.00e-05 0.01 8.24113e-01 2 12 15 10 17 210 2.56e-03 0.02 6.88124e-01 3 15 19 10 21 210 5.12e-03 0.04 4.71054e-01 3 19 23 10 25 210 5.12e-03 0.08 2.16451e-01 3 23 28 11 30 231 1.02e-02 0.16 4.50382e-02 4 28 35 12 37 252 2.05e-02 0.32 2.14520e-03 5 34 43 13 45 273 4.10e-02 0.64 2.89374e-18 1 39 52 15 54 315 1.64e-01 1.28 1.17136e-32 1 41 54 17 56 357 6.55e-01 2.56 1.31711e-35 1 42 55 18 57 378 1.31e+00 5.12 1.18294e-37 1 43 56 19 58 399 2.62e+00 10.24 1.26706e-39 1 44 57 20 59 420 5.24e+00 netf = 0, ncfn = 0 sundials-2.5.0/examples/idas/serial/idasAkzoNob_dns.c0000600000175000017500000002445311741421242023451 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2007, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Adjoint sensitivity example problem * * This IVP is a stiff system of 6 non-linear DAEs of index 1. The * problem originates from Akzo Nobel Central research in Arnhern, * The Netherlands, and describes a chemical process in which 2 * species are mixed, while carbon dioxide is continuously added. * See http://pitagora.dm.uniba.it/~testset/report/chemakzo.pdf * * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component */ /* Problem Constants */ #define NEQ 6 #define T0 RCONST(0.0) #define T1 RCONST(1e-8) /* first time for output */ #define TF RCONST(180.0) /* Final time. */ #define NF 25 /* Total number of outputs. */ #define RTOL RCONST(1.0e-08) #define ATOL RCONST(1.0e-10) #define RTOLQ RCONST(1.0e-10) #define ATOLQ RCONST(1.0e-12) #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) typedef struct { realtype k1, k2, k3, k4; realtype K, klA, Ks, pCO2, H; } *UserData; static int res(realtype t, N_Vector yy, N_Vector yd, N_Vector res, void *userdata); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static void PrintHeader(realtype rtol, realtype avtol, N_Vector y); static void PrintOutput(void *mem, realtype t, N_Vector y); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* Main program */ int main() { UserData data; void *mem; N_Vector yy, yp, rr, q; int flag; realtype time, tout, incr; int nout; mem = NULL; yy = yp = NULL; /* Allocate user data. */ data = (UserData) malloc(sizeof(*data)); /* Fill user's data with the appropriate values for coefficients. */ data->k1 = RCONST(18.7); data->k2 = RCONST(0.58); data->k3 = RCONST(0.09); data->k4 = RCONST(0.42); data->K = RCONST(34.4); data->klA = RCONST(3.3); data->Ks = RCONST(115.83); data->pCO2 = RCONST(0.9); data->H = RCONST(737.0); /* Allocate N-vectors. */ yy = N_VNew_Serial(NEQ); if (check_flag((void *)yy, "N_VNew_Serial", 0)) return(1); yp = N_VNew_Serial(NEQ); if (check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); /* Consistent IC for y, y'. */ #define y01 0.444 #define y02 0.00123 #define y03 0.00 #define y04 0.007 #define y05 0.0 Ith(yy,1) = RCONST(y01); Ith(yy,2) = RCONST(y02); Ith(yy,3) = RCONST(y03); Ith(yy,4) = RCONST(y04); Ith(yy,5) = RCONST(y05); Ith(yy,6) = data->Ks * RCONST(y01) * RCONST(y04); /* Get y' = - res(t0, y, 0) */ N_VConst(ZERO, yp); rr = N_VNew_Serial(NEQ); res(T0, yy, yp, rr, data); N_VScale(-ONE, rr, yp); N_VDestroy_Serial(rr); /* Create and initialize q0 for quadratures. */ q = N_VNew_Serial(1); if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1); Ith(q,1) = ZERO; /* Call IDACreate and IDAInit to initialize IDA memory */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); flag = IDAInit(mem, res, T0, yy, yp); if(check_flag(&flag, "IDAInit", 1)) return(1); /* Set tolerances. */ flag = IDASStolerances(mem, RTOL, ATOL); if(check_flag(&flag, "IDASStolerances", 1)) return(1); /* Attach user data. */ flag = IDASetUserData(mem, data); if(check_flag(&flag, "IDASetUserData", 1)) return(1); /* Attach linear solver. */ flag = IDADense(mem, NEQ); /* Initialize QUADRATURE(S). */ flag = IDAQuadInit(mem, rhsQ, q); if (check_flag(&flag, "IDAQuadInit", 1)) return(1); /* Set tolerances and error control for quadratures. */ flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ); if (check_flag(&flag, "IDAQuadSStolerances", 1)) return(1); flag = IDASetQuadErrCon(mem, TRUE); if (check_flag(&flag, "IDASetQuadErrCon", 1)) return(1); PrintHeader(RTOL, ATOL, yy); /* Print initial states */ PrintOutput(mem,0.0,yy); tout = T1; nout = 0; incr = RPowerR(TF/T1,ONE/NF); /* FORWARD run. */ while (1) { flag = IDASolve(mem, tout, &time, yy, yp, IDA_NORMAL); if (check_flag(&flag, "IDASolve", 1)) return(1); PrintOutput(mem, time, yy); nout++; tout *= incr; if (nout>NF) break; } flag = IDAGetQuad(mem, &time, q); if (check_flag(&flag, "IDAGetQuad", 1)) return(1); printf("\n--------------------------------------------------------\n"); printf("G: %24.16f \n",Ith(q,1)); printf("--------------------------------------------------------\n\n"); PrintFinalStats(mem); IDAFree(&mem); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(q); return(0); } static int res(realtype t, N_Vector yy, N_Vector yd, N_Vector res, void *userdata) { UserData data; realtype k1, k2, k3, k4; realtype K, klA, Ks, pCO2, H; realtype y1, y2, y3, y4, y5, y6; realtype yd1, yd2, yd3, yd4, yd5; realtype r1, r2, r3, r4, r5, Fin; data = (UserData) userdata; k1 = data->k1; k2 = data->k2; k3 = data->k3; k4 = data->k4; K = data->K; klA = data->klA; Ks = data->Ks; pCO2 = data->pCO2; H = data->H; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); y4 = Ith(yy,4); y5 = Ith(yy,5); y6 = Ith(yy,6); yd1 = Ith(yd,1); yd2 = Ith(yd,2); yd3 = Ith(yd,3); yd4 = Ith(yd,4); yd5 = Ith(yd,5); r1 = k1 * RPowerI(y1,4) * RSqrt(y2); r2 = k2 * y3 * y4; r3 = k2/K * y1 * y5; r4 = k3 * y1 * y4 * y4; r5 = k4 * y6 * y6 * RSqrt(y2); Fin = klA * ( pCO2/H - y2 ); Ith(res,1) = yd1 + TWO*r1 - r2 + r3 + r4; Ith(res,2) = yd2 + HALF*r1 + r4 + HALF*r5 - Fin; Ith(res,3) = yd3 - r1 + r2 - r3; Ith(res,4) = yd4 + r2 - r3 + TWO*r4; Ith(res,5) = yd5 - r2 + r3 - r5; Ith(res,6) = Ks*y1*y4 - y6; return(0); } /* * rhsQ routine. Computes quadrature(t,y). */ static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data) { Ith(qdot,1) = Ith(yy,1); return(0); } static void PrintHeader(realtype rtol, realtype avtol, N_Vector y) { printf("\nidasAkzoNob_dns: Akzo Nobel chemical kinetics DAE serial example problem for IDAS\n"); printf("Linear solver: IDADENSE, Jacobian is computed by IDAS.\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, avtol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, avtol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, avtol); #endif printf("---------------------------------------------------------------------------------\n"); printf(" t y1 y2 y3 y4 y5"); printf(" y6 | nst k h\n"); printf("---------------------------------------------------------------------------------\n"); } static void PrintOutput(void *mem, realtype t, N_Vector y) { realtype *yval; int retval, kused; long int nst; realtype hused; yval = NV_DATA_S(y); retval = IDAGetLastOrder(mem, &kused); check_flag(&retval, "IDAGetLastOrder", 1); retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetLastStep(mem, &hused); check_flag(&retval, "IDAGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %8.2Le %8.2Le %8.2Le %8.2Le %8.2Le %8.2Le | %3ld %1d %8.2Le\n", t, yval[0], yval[1], yval[2], yval[3], yval[4], yval[5], nst, kused, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.2le %8.2le %8.2le %8.2le %8.2le %8.2le %8.2le | %3ld %1d %8.2le\n", t, yval[0], yval[1], yval[2], yval[3], yval[4], yval[5], nst, kused, hused); #else printf("%8.2e %8.2e %8.2e %8.2e %8.2e %8.2e %8.2e | %3ld %1d %8.2e\n", t, yval[0], yval[1], yval[2], yval[3], yval[4], yval[5], nst, kused, hused); #endif } static void PrintFinalStats(void *mem) { int flag; long int nst, nni, nje, nre, nreLS, netf, ncfn; flag = IDAGetNumSteps(mem, &nst); flag = IDAGetNumResEvals(mem, &nre); flag = IDADlsGetNumJacEvals(mem, &nje); flag = IDAGetNumNonlinSolvIters(mem, &nni); flag = IDAGetNumErrTestFails(mem, &netf); flag = IDAGetNumNonlinSolvConvFails(mem, &ncfn); flag = IDADlsGetNumResEvals(mem, &nreLS); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasKrylovDemo_ls.c0000600000175000017500000004255611741421242024037 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * * This example loops through the available iterative linear solvers: * SPGMR, SPBCG and SPTFQMR. * * Example problem for IDA: 2D heat equation, serial, GMRES. * * This example solves a discretized 2D heat equation problem. * This version loops through the Krylov solvers IDASpgmr, IDASpbcg * and IDASptfqmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform M x M grid. * The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the following Krylov * linear solvers: IDASPGMR, IDASPBCG and IDASPTFQMR. The * preconditioner uses the diagonal elements of the Jacobian only. * Routines for preconditioning, required by IDASP*, are supplied * here. The constraints u >= 0 are posed for all components. Output * is taken at t = 0, .01, .02, .04,..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FOUR RCONST(4.0) /* Linear Solver Loop Constants */ #define USE_SPGMR 0 #define USE_SPBCG 1 #define USE_SPTFQMR 2 /* User data type */ typedef struct { long int mm; /* number of grid points */ realtype dx; realtype coeff; N_Vector pp; /* vector of prec. diag. elements */ } *UserData; /* Prototypes for functions called by IDA */ int resHeat(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); /* Prototypes for private functions */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res); static void PrintHeader(realtype rtol, realtype atol, int linsolver); static void PrintOutput(void *mem, realtype t, N_Vector uu, int linsolver); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { void *mem; UserData data; N_Vector uu, up, constraints, res; int ier, iout, linsolver; realtype rtol, atol, t0, t1, tout, tret; long int netf, ncfn, ncfl; mem = NULL; data = NULL; uu = up = constraints = res = NULL; /* Allocate N-vectors and the user data structure. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2)) return(1); /* Assign parameters in the user data structure. */ data->mm = MGRID; data->dx = ONE/(MGRID-ONE); data->coeff = ONE/(data->dx * data->dx); data->pp = N_VNew_Serial(NEQ); if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1); /* Initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Assign various parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ for (linsolver = 0; linsolver < 3; ++linsolver) { if (linsolver != 0) { /* Re-initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Re-initialize IDA */ ier = IDAReInit(mem, t0, uu, up); if (check_flag(&ier, "IDAReInit", 1)) return(1); } /* Attach a linear solver module */ switch(linsolver) { /* (a) SPGMR */ case(USE_SPGMR): /* Print header */ printf(" -------"); printf(" \n| SPGMR |\n"); printf(" -------\n"); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1)) return(1); break; /* (b) SPBCG */ case(USE_SPBCG): /* Print header */ printf(" -------"); printf(" \n| SPBCG |\n"); printf(" -------\n"); /* Call IDASpbcg to specify the linear solver. */ ier = IDASpbcg(mem, 0); if(check_flag(&ier, "IDASpbcg", 1)) return(1); break; /* (c) SPTFQMR */ case(USE_SPTFQMR): /* Print header */ printf(" ---------"); printf(" \n| SPTFQMR |\n"); printf(" ---------\n"); /* Call IDASptfqmr to specify the linear solver. */ ier = IDASptfqmr(mem, 0); if(check_flag(&ier, "IDASptfqmr", 1)) return(1); break; } /* Specify preconditioner */ ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol, linsolver); /* Print output table heading, and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu, linsolver); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); if (linsolver < 2) printf("\n======================================================================\n\n"); } /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ /* Free Memory */ IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(res); N_VDestroy_Serial(data->pp); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function (user-supplied) * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { long int i, j, offset, loc, mm; realtype *uu_data, *up_data, *rr_data, coeff, dif1, dif2; UserData data; uu_data = NV_DATA_S(uu); up_data = NV_DATA_S(up); rr_data = NV_DATA_S(rr); data = (UserData) user_data; coeff = data->coeff; mm = data->mm; /* Initialize rr to uu, to take care of boundary equations. */ N_VScale(ONE, uu, rr); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < MGRID-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; dif1 = uu_data[loc-1] + uu_data[loc+1] - TWO * uu_data[loc]; dif2 = uu_data[loc-mm] + uu_data[loc+mm] - TWO * uu_data[loc]; rr_data[loc]= up_data[loc] - coeff * ( dif1 + dif2 ); } } return(0); } /* * PsetupHeat: setup for diagonal preconditioner. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupdHeat argument list. */ int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, offset, loc, mm; realtype *ppv, pelinv; UserData data; data = (UserData) user_data; ppv = NV_DATA_S(data->pp); mm = data->mm; /* Initialize the entire vector to 1., then set the interior points to the correct value for preconditioning. */ N_VConst(ONE,data->pp); /* Compute the inverse of the preconditioner diagonal elements. */ pelinv = ONE/(c_j + FOUR*data->coeff); for (j = 1; j < mm-1; j++) { offset = mm * j; for (i = 1; i < mm-1; i++) { loc = offset + i; ppv[loc] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PrecondHeateq), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { UserData data; data = (UserData) user_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u and up vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res) { long int mm, mm1, i, j, offset, loc; realtype xfact, yfact, *udata, *updata; mm = data->mm; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); /* Initialize uu on all grid points. */ mm1 = mm - 1; for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Set up at boundary points to zero. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0; i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) updata[loc] = ZERO; } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol, int linsolver) { printf("\nidasKrylovDemo_ls: Heat equation, serial example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); switch(linsolver) { case(USE_SPGMR): printf("Linear solver: IDASPGMR, preconditioner using diagonal elements. \n"); break; case(USE_SPBCG): printf("Linear solver: IDASPBCG, preconditioner using diagonal elements. \n"); break; case(USE_SPTFQMR): printf("Linear solver: IDASPTFQMR, preconditioner using diagonal elements. \n"); break; } } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(void *mem, realtype t, N_Vector uu, int linsolver) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasRoberts_dns.c0000600000175000017500000002720111741421242023520 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 23:05:10 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * This simple example problem for IDA, due to Robertson, * is from chemical kinetics, and consists of the following three * equations: * * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2 * 0 = y1 + y2 + y3 - 1 * * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1, y2 = y3 = 0. * * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. * * The problem is solved with IDA using IDADENSE for the linear * solver, with a user-supplied Jacobian. Output is printed at * t = .4, 4, 40, ..., 4e10. * ----------------------------------------------------------------- */ #include #include #include #include #include #include /* Problem Constants */ #define NEQ 3 #define NOUT 12 #define ZERO RCONST(0.0); #define ONE RCONST(1.0); /* Macro to define dense matrix elements, indexed from 1. */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* Prototypes of functions called by IDA */ int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout, void *user_data); int jacrob(long int Neq, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat JJ, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); /* Prototypes of private functions */ static void PrintHeader(realtype rtol, N_Vector avtol, N_Vector y); static void PrintOutput(void *mem, realtype t, N_Vector y); static void PrintRootInfo(int root_f1, int root_f2); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * Main Program *-------------------------------------------------------------------- */ int main(void) { void *mem; N_Vector yy, yp, avtol; realtype rtol, *yval, *ypval, *atval; realtype t0, tout1, tout, tret; int iout, retval, retvalr; int rootsfound[2]; mem = NULL; yy = yp = avtol = NULL; yval = ypval = atval = NULL; /* Allocate N-vectors. */ yy = N_VNew_Serial(NEQ); if(check_flag((void *)yy, "N_VNew_Serial", 0)) return(1); yp = N_VNew_Serial(NEQ); if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); avtol = N_VNew_Serial(NEQ); if(check_flag((void *)avtol, "N_VNew_Serial", 0)) return(1); /* Create and initialize y, y', and absolute tolerance vectors. */ yval = NV_DATA_S(yy); yval[0] = ONE; yval[1] = ZERO; yval[2] = ZERO; ypval = NV_DATA_S(yp); ypval[0] = RCONST(-0.04); ypval[1] = RCONST(0.04); ypval[2] = ZERO; rtol = RCONST(1.0e-4); atval = NV_DATA_S(avtol); atval[0] = RCONST(1.0e-8); atval[1] = RCONST(1.0e-6); atval[2] = RCONST(1.0e-6); /* Integration limits */ t0 = ZERO; tout1 = RCONST(0.4); PrintHeader(rtol, avtol, yy); /* Call IDACreate and IDAMalloc to initialize IDA memory */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); retval = IDAInit(mem, resrob, t0, yy, yp); if(check_flag(&retval, "IDAInit", 1)) return(1); retval = IDASVtolerances(mem, rtol, avtol); if(check_flag(&retval, "IDASVtolerances", 1)) return(1); /* Free avtol */ N_VDestroy_Serial(avtol); /* Call IDARootInit to specify the root function grob with 2 components */ retval = IDARootInit(mem, 2, grob); if (check_flag(&retval, "IDARootInit", 1)) return(1); /* Call IDADense and set up the linear solver. */ retval = IDADense(mem, NEQ); if(check_flag(&retval, "IDADense", 1)) return(1); retval = IDADlsSetDenseJacFn(mem, jacrob); if(check_flag(&retval, "IDADlsSetDenseJacFn", 1)) return(1); /* In loop, call IDASolve, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ iout = 0; tout = tout1; while(1) { retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL); PrintOutput(mem,tret,yy); if(check_flag(&retval, "IDASolve", 1)) return(1); if (retval == IDA_ROOT_RETURN) { retvalr = IDAGetRootInfo(mem, rootsfound); check_flag(&retvalr, "IDAGetRootInfo", 1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (retval == IDA_SUCCESS) { iout++; tout *= RCONST(10.0); } if (iout == NOUT) break; } PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); return(0); } /* *-------------------------------------------------------------------- * Functions called by IDA *-------------------------------------------------------------------- */ /* * Define the system residual function. */ int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { realtype *yval, *ypval, *rval; yval = NV_DATA_S(yy); ypval = NV_DATA_S(yp); rval = NV_DATA_S(rr); rval[0] = RCONST(-0.04)*yval[0] + RCONST(1.0e4)*yval[1]*yval[2]; rval[1] = -rval[0] - RCONST(3.0e7)*yval[1]*yval[1] - ypval[1]; rval[0] -= ypval[0]; rval[2] = yval[0] + yval[1] + yval[2] - ONE; return(0); } /* * Root function routine. Compute functions g_i(t,y) for i = 0,1. */ static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout, void *user_data) { realtype *yval, y1, y3; yval = NV_DATA_S(yy); y1 = yval[0]; y3 = yval[2]; gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Define the Jacobian function. */ int jacrob(long int Neq, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat JJ, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { realtype *yval; yval = NV_DATA_S(yy); IJth(JJ,1,1) = RCONST(-0.04) - cj; IJth(JJ,2,1) = RCONST(0.04); IJth(JJ,3,1) = ONE; IJth(JJ,1,2) = RCONST(1.0e4)*yval[2]; IJth(JJ,2,2) = RCONST(-1.0e4)*yval[2] - RCONST(6.0e7)*yval[1] - cj; IJth(JJ,3,2) = ONE; IJth(JJ,1,3) = RCONST(1.0e4)*yval[1]; IJth(JJ,2,3) = RCONST(-1.0e4)*yval[1]; IJth(JJ,3,3) = ONE; return(0); } /* *-------------------------------------------------------------------- * Private functions *-------------------------------------------------------------------- */ /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, N_Vector avtol, N_Vector y) { realtype *atval, *yval; atval = NV_DATA_S(avtol); yval = NV_DATA_S(y); printf("\nidasRoberts_dns: Robertson kinetics DAE serial example problem for IDA.\n"); printf(" Three equation chemical kinetics problem.\n\n"); printf("Linear solver: IDADENSE, with user-supplied Jacobian.\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg %Lg %Lg \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%Lg %Lg %Lg)\n", yval[0], yval[1], yval[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg %lg %lg \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%lg %lg %lg)\n", yval[0], yval[1], yval[2]); #else printf("Tolerance parameters: rtol = %g atol = %g %g %g \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%g %g %g)\n", yval[0], yval[1], yval[2]); #endif printf("Constraints and id not used.\n\n"); printf("-----------------------------------------------------------------------\n"); printf(" t y1 y2 y3"); printf(" | nst k h\n"); printf("-----------------------------------------------------------------------\n"); } /* * Print Output */ static void PrintOutput(void *mem, realtype t, N_Vector y) { realtype *yval; int retval, kused; long int nst; realtype hused; yval = NV_DATA_S(y); retval = IDAGetLastOrder(mem, &kused); check_flag(&retval, "IDAGetLastOrder", 1); retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetLastStep(mem, &hused); check_flag(&retval, "IDAGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.4Le %12.4Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.4le %12.4le %12.4le %12.4le | %3ld %1d %12.4le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #else printf("%10.4e %12.4e %12.4e %12.4e | %3ld %1d %12.4e\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #endif } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Print final integrator statistics */ static void PrintFinalStats(void *mem) { int retval; long int nst, nni, nje, nre, nreLS, netf, ncfn, nge; retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetNumResEvals(mem, &nre); check_flag(&retval, "IDAGetNumResEvals", 1); retval = IDADlsGetNumJacEvals(mem, &nje); check_flag(&retval, "IDADlsGetNumJacEvals", 1); retval = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&retval, "IDAGetNumNonlinSolvIters", 1); retval = IDAGetNumErrTestFails(mem, &netf); check_flag(&retval, "IDAGetNumErrTestFails", 1); retval = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&retval, "IDAGetNumNonlinSolvConvFails", 1); retval = IDADlsGetNumResEvals(mem, &nreLS); check_flag(&retval, "IDADlsGetNumResEvals", 1); retval = IDAGetNumGEvals(mem, &nge); check_flag(&retval, "IDAGetNumGEvals", 1); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); printf("Number of root fn. evaluations = %ld\n", nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasHessian_ASA_FSA.out0000600000175000017500000000235211741421242024370 0ustar sylvestresylvestre Adjoint Sensitivity Example for Chemical Kinetics --------------------------------------------------------- DAE: dy1/dt + p1*y1 - p2*y2*y3 = 0 dy2/dt - p1*y1 + p2*y2*y3 + p3*(y2)^2 = 0 y1 + y2 + y3 = 0 Find dG/dp and d^2G/dp^2, where p=[p1,p2] for G = int_t0^tB0 g(t,p,y) dt g(t,p,y) = y3 --------------------------------------------------------- Forward integration --------------------------------------------------------- G: 2.5042e+01 dG/dp: -1.3753e+02 4.1552e-04 --------------------------------------------------------- Backward integration --------------------------------------------------------- dG/dp: -1.3753e+02 4.1552e-04 (from backward pb. 1) dG/dp: -1.3753e+02 4.1552e-04 (from backward pb. 2) H = d2G/dp2: (1) (2) 4.4243e+03 -2.7779e-03 -2.7779e-03 -2.4173e-08 --------------------------------------------------------- Finite Differences ( dp1=1.0e-03 and dp2 = 2.5e+02 ) --------------------------------------------------------- dG/dp: -1.3534e+02 4.1250e-04 (fwd FD) -1.3977e+02 4.1855e-04 (bck FD) -1.3755e+02 4.1552e-04 (cntr FD) H(1,1): 4.4247e+03 H(2,2): -2.4174e-08 sundials-2.5.0/examples/idas/serial/idasSlCrank_dns.out0000600000175000017500000000471511741421242024027 0ustar sylvestresylvestre idasSlCrank_dns: Slider-Crank DAE serial example problem for IDAS Linear solver: IDADENSE, Jacobian is computed by IDAS. Tolerance parameters: rtol = 1e-06 atol = 1e-07 ----------------------------------------------------------------------- t y1 y2 y3 | nst k h ----------------------------------------------------------------------- 0.00 1.5708e+00 8.6603e-01 -5.2360e-01 | 0 0 0.0000e+00 0.40 1.5299e+00 8.8672e-01 -5.2312e-01 | 40 5 4.6748e-02 0.80 1.4072e+00 9.5128e-01 -5.1591e-01 | 48 5 4.6748e-02 1.20 1.2039e+00 1.0638e+00 -4.8559e-01 | 57 5 3.7866e-02 1.60 9.2524e-01 1.2176e+00 -4.1084e-01 | 68 4 3.4080e-02 2.00 5.7904e-01 1.3803e+00 -2.7714e-01 | 78 5 6.8159e-02 2.40 1.7783e-01 1.4882e+00 -8.8565e-02 | 86 5 4.3666e-02 2.80 -2.4460e-01 1.4778e+00 1.2138e-01 | 96 5 3.9299e-02 3.20 -6.3618e-01 1.3570e+00 3.0161e-01 | 107 5 3.1832e-02 3.60 -9.6169e-01 1.1981e+00 4.2254e-01 | 121 5 2.8649e-02 4.00 -1.2064e+00 1.0623e+00 4.8609e-01 | 128 5 5.7298e-02 4.40 -1.3632e+00 9.7518e-01 5.1125e-01 | 136 5 4.6412e-02 4.80 -1.4300e+00 9.3903e-01 5.1789e-01 | 146 5 4.1770e-02 5.20 -1.4081e+00 9.5081e-01 5.1599e-01 | 155 5 4.1770e-02 5.60 -1.2995e+00 1.0103e+00 5.0261e-01 | 164 5 8.3541e-02 6.00 -1.1080e+00 1.1176e+00 4.6386e-01 | 169 5 7.5187e-02 6.40 -8.4049e-01 1.2616e+00 3.8168e-01 | 175 5 7.5187e-02 6.80 -5.0621e-01 1.4075e+00 2.4487e-01 | 180 5 6.0901e-02 7.20 -1.2091e-01 1.4945e+00 6.0346e-02 | 188 5 4.4397e-02 7.60 2.7894e-01 1.4712e+00 -1.3811e-01 | 198 5 3.5962e-02 8.00 6.4422e-01 1.3536e+00 -3.0500e-01 | 211 5 2.8980e-02 8.40 9.4289e-01 1.2082e+00 -4.1657e-01 | 220 5 5.2163e-02 8.80 1.1604e+00 1.0882e+00 -4.7630e-01 | 227 5 5.2163e-02 9.20 1.2895e+00 1.0159e+00 -5.0105e-01 | 235 5 5.2163e-02 9.60 1.3276e+00 9.9477e-01 -5.0669e-01 | 243 5 4.6947e-02 10.00 1.2757e+00 1.0236e+00 -4.9881e-01 | 251 5 4.6947e-02 Final Run Statistics: Number of steps = 251 Number of residual evaluations = 1066 Number of Jacobian evaluations = 39 Number of nonlinear iterations = 676 Number of error test failures = 1 Number of nonlinear conv. failures = 0 -------------------------------------------- G = 3.3366160663212514 -------------------------------------------- sundials-2.5.0/examples/idas/serial/idasRoberts_ASAi_dns.c0000600000175000017500000005161511741421242024363 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:05:10 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2007, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Adjoint sensitivity example problem. * * This simple example problem for IDAS, due to Robertson, * is from chemical kinetics, and consists of the following three * equations: * * dy1/dt + p1*y1 - p2*y2*y3 = 0 * dy2/dt - p1*y1 + p2*y2*y3 + p3*y2**2 = 0 * y1 + y2 + y3 - 1 = 0 * * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1, y2 = y3 = 0.The reaction rates are: p1=0.04, * p2=1e4, and p3=3e7 * * It uses a scalar relative tolerance and a vector absolute * tolerance. * * IDAS can also compute sensitivities with respect to * the problem parameters p1, p2, and p3 of the following quantity: * G = int_t0^t1 g(t,p,y) dt * where * g(t,p,y) = y3 * * The gradient dG/dp is obtained as: * dG/dp = int_t0^t1 (g_p - lambda^T F_p ) dt - * lambda^T*F_y'*y_p | _t0^t1 * = int_t0^t1 (lambda^T*F_p) dt * where lambda and are solutions of the adjoint system: * d(lambda^T * F_y' )/dt -lambda^T F_y = -g_y * * During the backward integration, IDAS also evaluates G as * G = - phi(t0) * where * d(phi)/dt = g(t,y,p) * phi(t1) = 0 * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i= 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* (i,j)-th matrix component i,j = 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define RTOL RCONST(1e-06) /* scalar relative tolerance */ #define ATOL1 RCONST(1e-08) /* vector absolute tolerance components */ #define ATOL2 RCONST(1e-12) #define ATOL3 RCONST(1e-08) #define ATOLA RCONST(1e-08) /* absolute tolerance for adjoint vars. */ #define ATOLQ RCONST(1e-06) /* absolute tolerance for quadratures */ #define T0 RCONST(0.0) /* initial time */ #define TOUT RCONST(4e10) /* final time */ #define TB1 RCONST(50.0) /* starting point for adjoint problem */ #define TB2 TOUT /* starting point for adjoint problem */ #define T1B RCONST(49.0) /* for IDACalcICB */ #define STEPS 100 /* number of steps between check points */ #define NP 3 /* number of problem parameters */ #define ONE RCONST(1.0) #define ZERO RCONST(0.0) /* Type : UserData */ typedef struct { realtype p[3]; } *UserData; /* Prototypes of user-supplied functions */ static int res(realtype t, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int Jac(long int Neq, realtype t, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static int ewt(N_Vector y, N_Vector w, void *user_data); static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); static int JacB(long int NeqB, realtype tt, realtype cjB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *user_data, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int rhsQB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrQB, void *user_dataB); /* Prototypes of private functions */ static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector ypB, N_Vector qB); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { UserData data; void *ida_mem; realtype reltolQ, abstolQ; N_Vector yy, yp, q; N_Vector yyTB1, ypTB1; N_Vector id; int steps; int indexB; realtype reltolB, abstolB, abstolQB; N_Vector yB, ypB, qB; realtype time; int flag, ncheck; IDAadjCheckPointRec *ckpnt; long int nst, nstB; data = NULL; ckpnt = NULL; ida_mem = NULL; yy = yp = yB = qB = NULL; /* Print problem description */ printf("\nAdjoint Sensitivity Example for Chemical Kinetics\n"); printf("-------------------------------------------------\n\n"); printf("DAE: dy1/dt + p1*y1 - p2*y2*y3 = 0\n"); printf(" dy2/dt - p1*y1 + p2*y2*y3 + p3*(y2)^2 = 0\n"); printf(" y1 + y2 + y3 = 0\n\n"); printf("Find dG/dp for\n"); printf(" G = int_t0^tB0 g(t,p,y) dt\n"); printf(" g(t,p,y) = y3\n\n\n"); /* User data structure */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2)) return(1); data->p[0] = RCONST(0.04); data->p[1] = RCONST(1.0e4); data->p[2] = RCONST(3.0e7); /* Initialize y */ yy = N_VNew_Serial(NEQ); if (check_flag((void *)yy, "N_VNew_Serial", 0)) return(1); Ith(yy,1) = ONE; Ith(yy,2) = ZERO; Ith(yy,3) = ZERO; /* Initialize yprime */ yp = N_VNew_Serial(NEQ); if (check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); Ith(yp,1) = RCONST(-0.04); Ith(yp,2) = RCONST( 0.04); Ith(yp,3) = ZERO; /* Initialize q */ q = N_VNew_Serial(1); if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1); Ith(q,1) = ZERO; /* Set the scalar realtive and absolute tolerances reltolQ and abstolQ */ reltolQ = RTOL; abstolQ = ATOLQ; /* Create and allocate IDAS memory for forward run */ printf("Create and allocate IDAS memory for forward runs\n"); ida_mem = IDACreate(); if (check_flag((void *)ida_mem, "IDACreate", 0)) return(1); flag = IDAInit(ida_mem, res, T0, yy, yp); if (check_flag(&flag, "IDAInit", 1)) return(1); flag = IDAWFtolerances(ida_mem, ewt); if (check_flag(&flag, "IDAWFtolerances", 1)) return(1); flag = IDASetUserData(ida_mem, data); if (check_flag(&flag, "IDASetUserData", 1)) return(1); flag = IDADense(ida_mem, NEQ); if (check_flag(&flag, "IDADense", 1)) return(1); flag = IDADlsSetDenseJacFn(ida_mem, Jac); if (check_flag(&flag, "IDADlsSetDenseJacFn", 1)) return(1); flag = IDAQuadInit(ida_mem, rhsQ, q); if (check_flag(&flag, "IDAQuadInit", 1)) return(1); flag = IDAQuadSStolerances(ida_mem, reltolQ, abstolQ); if (check_flag(&flag, "IDAQuadSStolerances", 1)) return(1); flag = IDASetQuadErrCon(ida_mem, TRUE); if (check_flag(&flag, "IDASetQuadErrCon", 1)) return(1); /* Allocate global memory */ steps = STEPS; flag = IDAAdjInit(ida_mem, steps, IDA_HERMITE); /*flag = IDAAdjInit(ida_mem, steps, IDA_POLYNOMIAL);*/ if (check_flag(&flag, "IDAAdjInit", 1)) return(1); /* Perform forward run */ printf("Forward integration ... "); /* Integrate till TB1 and get the solution (y, y') at that time. */ flag = IDASolveF(ida_mem, TB1, &time, yy, yp, IDA_NORMAL, &ncheck); if (check_flag(&flag, "IDASolveF", 1)) return(1); yyTB1 = N_VClone(yy); ypTB1 = N_VClone(yp); /* Save the states at t=TB1. */ N_VScale(ONE, yy, yyTB1); N_VScale(ONE, yp, ypTB1); /* Continue integrating till TOUT is reached. */ flag = IDASolveF(ida_mem, TOUT, &time, yy, yp, IDA_NORMAL, &ncheck); if (check_flag(&flag, "IDASolveF", 1)) return(1); flag = IDAGetNumSteps(ida_mem, &nst); if (check_flag(&flag, "IDAGetNumSteps", 1)) return(1); printf("done ( nst = %ld )\n",nst); flag = IDAGetQuad(ida_mem, &time, q); if (check_flag(&flag, "IDAGetQuad", 1)) return(1); printf("--------------------------------------------------------\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("G: %12.4Le \n",Ith(q,1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("G: %12.4le \n",Ith(q,1)); #else printf("G: %12.4e \n",Ith(q,1)); #endif printf("--------------------------------------------------------\n\n"); /* Test check point linked list (uncomment next block to print check point information) */ /* { int i; printf("\nList of Check Points (ncheck = %d)\n\n", ncheck); ckpnt = (IDAadjCheckPointRec *) malloc ( (ncheck+1)*sizeof(IDAadjCheckPointRec)); IDAGetAdjCheckPointsInfo(ida_mem, ckpnt); for (i=0;i<=ncheck;i++) { printf("Address: %p\n",ckpnt[i].my_addr); printf("Next: %p\n",ckpnt[i].next_addr); printf("Time interval: %le %le\n",ckpnt[i].t0, ckpnt[i].t1); printf("Step number: %ld\n",ckpnt[i].nstep); printf("Order: %d\n",ckpnt[i].order); printf("Step size: %le\n",ckpnt[i].step); printf("\n"); } } */ /* Create BACKWARD problem. */ /* Allocate yB (i.e. lambda_0). */ yB = N_VNew_Serial(NEQ); if (check_flag((void *)yB, "N_VNew_Serial", 0)) return(1); /* Consistently initialize yB. */ Ith(yB,1) = ZERO; Ith(yB,2) = ZERO; Ith(yB,3) = ONE; /* Allocate ypB (i.e. lambda'_0). */ ypB = N_VNew_Serial(NEQ); if (check_flag((void *)ypB, "N_VNew_Serial", 0)) return(1); /* Consistently initialize ypB. */ Ith(ypB,1) = ONE; Ith(ypB,2) = ONE; Ith(ypB,3) = ZERO; /* Set the scalar relative tolerance reltolB */ reltolB = RTOL; /* Set the scalar absolute tolerance abstolB */ abstolB = ATOLA; /* Set the scalar absolute tolerance abstolQB */ abstolQB = ATOLQ; /* Create and allocate IDAS memory for backward run */ printf("Create and allocate IDAS memory for backward run\n"); flag = IDACreateB(ida_mem, &indexB); if (check_flag(&flag, "IDACreateB", 1)) return(1); flag = IDAInitB(ida_mem, indexB, resB, TB2, yB, ypB); if (check_flag(&flag, "IDAInitB", 1)) return(1); flag = IDASStolerancesB(ida_mem, indexB, reltolB, abstolB); if (check_flag(&flag, "IDASStolerancesB", 1)) return(1); flag = IDASetUserDataB(ida_mem, indexB, data); if (check_flag(&flag, "IDASetUserDataB", 1)) return(1); flag = IDASetMaxNumStepsB(ida_mem, indexB, 1000); flag = IDADenseB(ida_mem, indexB, NEQ); if (check_flag(&flag, "IDADenseB", 1)) return(1); flag = IDADlsSetDenseJacFnB(ida_mem, indexB, JacB); if (check_flag(&flag, "IDASetDenseJacB", 1)) return(1); /* Quadrature for backward problem. */ /* Initialize qB */ qB = N_VNew_Serial(NP); if (check_flag((void *)qB, "N_VNew", 0)) return(1); Ith(qB,1) = ZERO; Ith(qB,2) = ZERO; Ith(qB,3) = ZERO; flag = IDAQuadInitB(ida_mem, indexB, rhsQB, qB); if (check_flag(&flag, "IDAQuadInitB", 1)) return(1); flag = IDAQuadSStolerancesB(ida_mem, indexB, reltolB, abstolQB); if (check_flag(&flag, "IDAQuadSStolerancesB", 1)) return(1); /* Include quadratures in error control. */ flag = IDASetQuadErrConB(ida_mem, indexB, TRUE); if (check_flag(&flag, "IDASetQuadErrConB", 1)) return(1); /* Backward Integration */ printf("Backward integration ... "); flag = IDASolveB(ida_mem, T0, IDA_NORMAL); if (check_flag(&flag, "IDASolveB", 1)) return(1); IDAGetNumSteps(IDAGetAdjIDABmem(ida_mem, indexB), &nstB); printf("done ( nst = %ld )\n", nstB); flag = IDAGetB(ida_mem, indexB, &time, yB, ypB); if (check_flag(&flag, "IDAGetB", 1)) return(1); flag = IDAGetQuadB(ida_mem, indexB, &time, qB); if (check_flag(&flag, "IDAGetB", 1)) return(1); PrintOutput(TB2, yB, ypB, qB); /* Reinitialize backward phase and start from a different time (TB1). */ printf("Re-initialize IDAS memory for backward run\n"); /* Both algebraic part from y and the entire y' are computed by IDACalcIC. */ Ith(yB,1) = ZERO; Ith(yB,2) = ZERO; Ith(yB,3) = RCONST(0.50); /* not consistent */ /* Rough guess for ypB. */ Ith(ypB,1) = RCONST(0.80); Ith(ypB,2) = RCONST(0.75); Ith(ypB,3) = ZERO; /* Initialize qB */ Ith(qB,1) = ZERO; Ith(qB,2) = ZERO; Ith(qB,3) = ZERO; flag = IDAReInitB(ida_mem, indexB, TB1, yB, ypB); if (check_flag(&flag, "IDAReInitB", 1)) return(1); /* Also reinitialize quadratures. */ flag = IDAQuadInitB(ida_mem, indexB, rhsQB, qB); if (check_flag(&flag, "IDAQuadInitB", 1)) return(1); /* Use IDACalcICB to compute consistent initial conditions for this backward problem. */ id = N_VNew_Serial(NEQ); Ith(id,1) = 1.0; Ith(id,2) = 1.0; Ith(id,3) = 0.0; /* Specify which variables are differential (1) and which algebraic (0).*/ flag = IDASetIdB(ida_mem, indexB, id); if (check_flag(&flag, "IDASetId", 1)) return(1); flag = IDACalcICB(ida_mem, indexB, T1B, yyTB1, ypTB1); if (check_flag(&flag, "IDACalcICB", 1)) return(1); /* Get the consistent IC found by IDAS. */ flag = IDAGetConsistentICB(ida_mem, indexB, yB, ypB); if (check_flag(&flag, "IDAGetConsistentICB", 1)) return(1); printf("Backward integration ... "); flag = IDASolveB(ida_mem, T0, IDA_NORMAL); if (check_flag(&flag, "IDASolveB", 1)) return(1); IDAGetNumSteps(IDAGetAdjIDABmem(ida_mem, indexB), &nstB); printf("done ( nst = %ld )\n", nstB); flag = IDAGetB(ida_mem, indexB, &time, yB, ypB); if (check_flag(&flag, "IDAGetB", 1)) return(1); flag = IDAGetQuadB(ida_mem, indexB, &time, qB); if (check_flag(&flag, "IDAGetQuadB", 1)) return(1); PrintOutput(TB1, yB, ypB, qB); /* Free any memory used.*/ printf("Free memory\n\n"); IDAFree(ida_mem); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(q); N_VDestroy_Serial(yB); N_VDestroy_Serial(ypB); N_VDestroy_Serial(qB); N_VDestroy_Serial(id); N_VDestroy_Serial(yyTB1); N_VDestroy_Serial(ypTB1); if (ckpnt != NULL) free(ckpnt); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDAS *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,y). */ static int res(realtype t, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data) { realtype y1, y2, y3,yp1, yp2, yp3, *rval; UserData data; realtype p1, p2, p3; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); yp1 = Ith(yp,1); yp2 = Ith(yp,2); yp3 = Ith(yp,3); rval = NV_DATA_S(resval); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; rval[0] = p1*y1-p2*y2*y3; rval[1] = -rval[0] + p3*y2*y2 + yp2; rval[0]+= yp1; rval[2] = y1+y2+y3-1; return(0); } /* * Jacobian routine. Compute J(t,y). */ static int Jac(long int Neq, realtype t, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; UserData data; realtype p1, p2, p3; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(J,1,1) = p1+cj; IJth(J,2,1) = -p1; IJth(J,3,1) = ONE; IJth(J,1,2) = -p2*y3; IJth(J,2,2) = p2*y3+2*p3*y2+cj; IJth(J,3,2) = ONE; IJth(J,1,3) = -p2*y2; IJth(J,2,3) = p2*y2; IJth(J,3,3) = ONE; return(0); } /* * rhsQ routine. Compute fQ(t,y). */ static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data) { Ith(qdot,1) = Ith(yy,3); return(0); } /* * EwtSet function. Computes the error weights at the current solution. */ static int ewt(N_Vector y, N_Vector w, void *user_data) { int i; realtype yy, ww, rtol, atol[3]; rtol = RTOL; atol[0] = ATOL1; atol[1] = ATOL2; atol[2] = ATOL3; for (i=1; i<=3; i++) { yy = Ith(y,i); ww = rtol * ABS(yy) + atol[i-1]; if (ww <= 0.0) return (-1); Ith(w,i) = 1.0/ww; } return(0); } /* * resB routine. */ static int resB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3; realtype lp1, lp2, lp3; realtype l21, l32, y23; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* The lambda dot vector */ lp1 = Ith(ypB,1); lp2 = Ith(ypB,2); lp3 = Ith(ypB,3); /* Temporary variables */ l21 = l2-l1; l32 = l3-l2; y23 = y2*y3; /* Load residual. */ Ith(rrB,1) = lp1 + p1*l21 - l3; Ith(rrB,2) = lp2 - p2*y3*l21 - RCONST(2.0)*p3*y2*l2-l3; Ith(rrB,3) = - p2*y2*l21 -l3 + RCONST(1.0); return(0); } /*Jacobian for backward problem. */ static int JacB(long int NeqB, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JB, void *user_data, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { realtype y1, y2, y3, l1, l2, l3; UserData data; realtype p1, p2, p3; y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(JB,1,1) = -p1+cj; IJth(JB,1,2) = p1; IJth(JB,1,3) = -ONE; IJth(JB,2,1) = p2*y3; IJth(JB,2,2) = -(p2*y3+RCONST(2.0)*p3*y2)+cj; IJth(JB,2,3) = -ONE; IJth(JB,3,1) = p2*y2; IJth(JB,3,2) = -p2*y2; IJth(JB,3,3) = -ONE; return(0); } static int rhsQB(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrQB, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3; realtype l21; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(yy,1); y2 = Ith(yy,2); y3 = Ith(yy,3); /* The lambda vector */ l1 = Ith(yyB,1); l2 = Ith(yyB,2); l3 = Ith(yyB,3); /* Temporary variables */ l21 = l2-l1; Ith(rrQB,1) = y1*l21; Ith(rrQB,2) = -y3*y2*l21; Ith(rrQB,3) = -y2*y2*l2; return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Print results after backward integration */ static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector ypB, N_Vector qB) { printf("--------------------------------------------------------\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("tB0: %12.4Le\n",tfinal); printf("dG/dp: %12.4Le %12.4Le %12.4Le\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4Le %12.4Le %12.4Le\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("tB0: %12.4le\n",tfinal); printf("dG/dp: %12.4le %12.4le %12.4le\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4le %12.4le %12.4le\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #else printf("tB0: %12.4e\n",tfinal); printf("dG/dp: %12.4e %12.4e %12.4e\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4e %12.4e %12.4e\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #endif printf("--------------------------------------------------------\n\n"); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasRoberts_dns.out0000600000175000017500000000354411741421242024111 0ustar sylvestresylvestre idasRoberts_dns: Robertson kinetics DAE serial example problem for IDA. Three equation chemical kinetics problem. Linear solver: IDADENSE, with user-supplied Jacobian. Tolerance parameters: rtol = 0.0001 atol = 1e-08 1e-06 1e-06 Initial conditions y0 = (1 0 0) Constraints and id not used. ----------------------------------------------------------------------- t y1 y2 y3 | nst k h ----------------------------------------------------------------------- 2.6402e-01 9.8997e-01 3.4706e-05 1.0000e-02 | 27 2 4.4012e-02 rootsfound[] = 0 1 4.0000e-01 9.8517e-01 3.3864e-05 1.4794e-02 | 29 3 8.8024e-02 4.0000e+00 9.0553e-01 2.2406e-05 9.4452e-02 | 43 4 6.3377e-01 4.0000e+01 7.1579e-01 9.1838e-06 2.8420e-01 | 68 4 3.1932e+00 4.0000e+02 4.5044e-01 3.2218e-06 5.4956e-01 | 95 4 3.3201e+01 4.0000e+03 1.8320e-01 8.9444e-07 8.1680e-01 | 126 3 3.1458e+02 4.0000e+04 3.8992e-02 1.6221e-07 9.6101e-01 | 161 5 2.5058e+03 4.0000e+05 4.9369e-03 1.9842e-08 9.9506e-01 | 202 3 2.6370e+04 4.0000e+06 5.1674e-04 2.0684e-09 9.9948e-01 | 250 3 1.7186e+05 2.0788e+07 1.0000e-04 4.0004e-10 9.9990e-01 | 280 5 1.0513e+06 rootsfound[] = -1 0 4.0000e+07 5.2009e-05 2.0805e-10 9.9995e-01 | 293 4 2.3655e+06 4.0000e+08 5.2012e-06 2.0805e-11 9.9999e-01 | 325 4 2.6809e+07 4.0000e+09 5.1850e-07 2.0740e-12 1.0000e-00 | 348 3 7.4307e+08 4.0000e+10 4.8641e-08 1.9456e-13 1.0000e-00 | 362 2 7.5482e+09 Final Run Statistics: Number of steps = 362 Number of residual evaluations = 537 Number of Jacobian evaluations = 60 Number of nonlinear iterations = 537 Number of error test failures = 15 Number of nonlinear conv. failures = 0 Number of root fn. evaluations = 404 sundials-2.5.0/examples/idas/serial/idasFoodWeb_bnd.out0000600000175000017500000000274011741421242023772 0ustar sylvestresylvestre idasFoodWeb_bnd: Predator-prey DAE serial example problem for IDA Number of species ns: 2 Mesh dimensions: 20 x 20 System size: 800 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDABAND, Band parameters mu = 40, ml = 40 CalcIC called to correct initial predator concentrations. ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+05 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0822e+05 | 32 4 1.0823e-04 1.0319e+05 1.0822e+05 | 1.00e-02 1.6188e+02 1.9734e+06 | 127 4 1.4203e-04 1.6189e+06 1.9734e+06 | 1.00e-01 2.4019e+02 2.7072e+06 | 235 1 3.9160e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+06 | 238 1 3.1328e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+06 | 239 1 6.2657e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+06 | 239 1 6.2657e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final run statistics: Number of steps = 239 Number of residual evaluations = 3339 Number of Jacobian evaluations = 36 Number of nonlinear iterations = 421 Number of error test failures = 3 Number of nonlinear conv. failures = 0 sundials-2.5.0/examples/idas/serial/idasSlCrank_dns.c0000600000175000017500000002522111741421242023435 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2009/09/30 23:33:29 $ * ----------------------------------------------------------------- * Programmer: Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * Simulation of a slider-crank mechanism modelled with 3 generalized * coordinates: crank angle, connecting bar angle, and slider location. * The mechanism moves under the action of a constant horizontal * force applied to the connecting rod and a spring-damper connecting * the crank and connecting rod. * * The equations of motion are formulated as a system of stabilized * index-2 DAEs (Gear-Gupta-Leimkuhler formulation). * * IDAS also computes the average kinetic energy as the quadrature: * G = int_t0^tend g(t,y,p) dt, * where * g(t,y,p) = 0.5*J1*v1^2 + 0.5*J2*v3^2 + 0.5*m2*v2^2 * * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i= 1..NEQ */ /* Problem Constants */ #define NEQ 10 #define TBEGIN RCONST(0.0) #define TEND RCONST(10.0) #define NOUT 25 #define RTOLF RCONST(1.0e-06) #define ATOLF RCONST(1.0e-07) #define RTOLQ RCONST(1.0e-06) #define ATOLQ RCONST(1.0e-08) #define ZERO RCONST(0.00) #define QUARTER RCONST(0.25) #define HALF RCONST(0.50) #define ONE RCONST(1.00) #define TWO RCONST(2.00) #define FOUR RCONST(4.00) typedef struct { realtype a; realtype J1, J2, m1, m2; realtype l0; realtype params[2]; realtype F; } *UserData; static int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data); static void setIC(N_Vector yy, N_Vector yp, UserData data); static void force(N_Vector yy, realtype *Q, UserData data); static void PrintHeader(realtype rtol, realtype avtol, N_Vector y); static void PrintOutput(void *mem, realtype t, N_Vector y); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * Main Program *-------------------------------------------------------------------- */ int main(void) { UserData data; void *mem; N_Vector yy, yp, id, q; realtype tret, tout; int flag; id = N_VNew_Serial(NEQ); yy = N_VNew_Serial(NEQ); yp = N_VNew_Serial(NEQ); q = N_VNew_Serial(1); data = (UserData) malloc(sizeof *data); data->a = 0.5; /* half-length of crank */ data->J1 = 1.0; /* crank moment of inertia */ data->m2 = 1.0; /* mass of connecting rod */ data->m1 = 1.0; data->J2 = 2.0; /* moment of inertia of connecting rod */ data->params[0] = 1.0; /* spring constant */ data->params[1] = 1.0; /* damper constant */ data->l0 = 1.0; /* spring free length */ data->F = 1.0; /* external constant force */ N_VConst(ONE, id); NV_Ith_S(id, 9) = ZERO; NV_Ith_S(id, 8) = ZERO; NV_Ith_S(id, 7) = ZERO; NV_Ith_S(id, 6) = ZERO; /* Consistent IC*/ setIC(yy, yp, data); /* IDAS initialization */ mem = IDACreate(); flag = IDAInit(mem, ressc, TBEGIN, yy, yp); flag = IDASStolerances(mem, RTOLF, ATOLF); flag = IDASetUserData(mem, data); flag = IDASetId(mem, id); flag = IDASetSuppressAlg(mem, TRUE); flag = IDASetMaxNumSteps(mem, 20000); /* Call IDADense and set up the linear solver. */ flag = IDADense(mem, NEQ); N_VConst(ZERO, q); flag = IDAQuadInit(mem, rhsQ, q); flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ); flag = IDASetQuadErrCon(mem, TRUE); PrintHeader(RTOLF, ATOLF, yy); /* Print initial states */ PrintOutput(mem,0.0,yy); /* Perform forward run */ tout = TEND/NOUT; while (1) { flag = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL); if (check_flag(&flag, "IDASolve", 1)) return(1); PrintOutput(mem,tret,yy); tout += TEND/NOUT; if (tret > TEND) break; } PrintFinalStats(mem); IDAGetQuad(mem, &tret, q); printf("--------------------------------------------\n"); printf(" G = %24.16f\n", Ith(q,1)); printf("--------------------------------------------\n\n"); IDAFree(&mem); /* Free memory */ free(data); N_VDestroy(id); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); N_VDestroy_Serial(q); return(0); } static void setIC(N_Vector yy, N_Vector yp, UserData data) { realtype pi; realtype a, J1, m2, J2; realtype q, p, x; realtype Q[3]; N_VConst(ZERO, yy); N_VConst(ZERO, yp); pi = FOUR*atan(ONE); a = data->a; J1 = data->J1; m2 = data->m2; J2 = data->J2; q = pi/TWO; p = asin(-a); x = cos(p); NV_Ith_S(yy,0) = q; NV_Ith_S(yy,1) = x; NV_Ith_S(yy,2) = p; force(yy, Q, data); NV_Ith_S(yp,3) = Q[0]/J1; NV_Ith_S(yp,4) = Q[1]/m2; NV_Ith_S(yp,5) = Q[2]/J2; } static void force(N_Vector yy, realtype *Q, UserData data) { realtype a, k, c, l0, F; realtype q, x, p; realtype qd, xd, pd; realtype s1, c1, s2, c2, s21, c21; realtype l2, l, ld; realtype f, fl; a = data->a; k = data->params[0]; c = data->params[1]; l0 = data->l0; F = data->F; q = NV_Ith_S(yy,0); x = NV_Ith_S(yy,1); p = NV_Ith_S(yy,2); qd = NV_Ith_S(yy,3); xd = NV_Ith_S(yy,4); pd = NV_Ith_S(yy,5); s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x*x - x*(c2+a*c1) + (ONE + a*a)/FOUR + a*c21/TWO; l = RSqrt(l2); ld = TWO*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/TWO; ld /= TWO*l; f = k*(l-l0) + c*ld; fl = f/l; Q[0] = - fl * a * (s21/TWO + x*s1) / TWO; Q[1] = fl * (c2/TWO - x + a*c1/TWO) + F; Q[2] = - fl * (x*s2 - a*s21/TWO) / TWO - F*s2; } static int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { UserData data; realtype Q[3]; realtype a, J1, m2, J2; realtype *yval, *ypval, *rval; realtype q, x, p; realtype qd, xd, pd; realtype lam1, lam2, mu1, mu2; realtype s1, c1, s2, c2; data = (UserData) user_data; a = data->a; J1 = data->J1; m2 = data->m2; J2 = data->J2; yval = NV_DATA_S(yy); ypval = NV_DATA_S(yp); rval = NV_DATA_S(rr); q = yval[0]; x = yval[1]; p = yval[2]; qd = yval[3]; xd = yval[4]; pd = yval[5]; lam1 = yval[6]; lam2 = yval[7]; mu1 = yval[8]; mu2 = yval[9]; s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); force(yy, Q, data); rval[0] = ypval[0] - qd + a*s1*mu1 - a*c1*mu2; rval[1] = ypval[1] - xd + mu1; rval[2] = ypval[2] - pd + s2*mu1 - c2*mu2; rval[3] = J1*ypval[3] - Q[0] + a*s1*lam1 - a*c1*lam2; rval[4] = m2*ypval[4] - Q[1] + lam1; rval[5] = J2*ypval[5] - Q[2] + s2*lam1 - c2*lam2; rval[6] = x - c2 - a*c1; rval[7] = -s2 - a*s1; rval[8] = a*s1*qd + xd + s2*pd; rval[9] = -a*c1*qd - c2*pd; return(0); } static int rhsQ(realtype t, N_Vector yy, N_Vector yp, N_Vector qdot, void *user_data) { realtype v1, v2, v3; realtype m1, J1, m2, J2, a; UserData data; data = (UserData) user_data; J1 = data->J1; m1 = data->m1; m2 = data->m2; J2 = data->J2; a = data->a; v1 = Ith(yy,4); v2 = Ith(yy,5); v3 = Ith(yy,6); Ith(qdot,1) = HALF*(J1*v1*v1 + m2*v2*v2 + J2*v3*v3); return(0); } static void PrintHeader(realtype rtol, realtype avtol, N_Vector y) { printf("\nidasSlCrank_dns: Slider-Crank DAE serial example problem for IDAS\n"); printf("Linear solver: IDADENSE, Jacobian is computed by IDAS.\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, avtol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, avtol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, avtol); #endif printf("-----------------------------------------------------------------------\n"); printf(" t y1 y2 y3"); printf(" | nst k h\n"); printf("-----------------------------------------------------------------------\n"); } static void PrintOutput(void *mem, realtype t, N_Vector y) { realtype *yval; int retval, kused; long int nst; realtype hused; yval = NV_DATA_S(y); retval = IDAGetLastOrder(mem, &kused); check_flag(&retval, "IDAGetLastOrder", 1); retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetLastStep(mem, &hused); check_flag(&retval, "IDAGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%5.2Lf %12.4Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%5.2lf %12.4le %12.4le %12.4le | %3ld %1d %12.4le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #else printf("%5.2f %12.4e %12.4e %12.4e | %3ld %1d %12.4e\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #endif } static void PrintFinalStats(void *mem) { int flag; long int nst, nni, nje, nre, nreLS, netf, ncfn; flag = IDAGetNumSteps(mem, &nst); flag = IDAGetNumResEvals(mem, &nre); flag = IDADlsGetNumJacEvals(mem, &nje); flag = IDAGetNumNonlinSolvIters(mem, &nni); flag = IDAGetNumErrTestFails(mem, &netf); flag = IDAGetNumNonlinSolvConvFails(mem, &ncfn); flag = IDADlsGetNumResEvals(mem, &nreLS); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); } static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/idas/serial/idasAkzoNob_dns.out0000600000175000017500000000573711741421242024042 0ustar sylvestresylvestre idasAkzoNob_dns: Akzo Nobel chemical kinetics DAE serial example problem for IDAS Linear solver: IDADENSE, Jacobian is computed by IDAS. Tolerance parameters: rtol = 1e-08 atol = 1e-10 --------------------------------------------------------------------------------- t y1 y2 y3 y4 y5 y6 | nst k h --------------------------------------------------------------------------------- 0.00e+00 4.44e-01 1.23e-03 0.00e+00 7.00e-03 0.00e+00 3.60e-01 | 0 0 0.00e+00 1.00e-08 4.44e-01 1.23e-03 2.55e-10 7.00e-03 1.91e-11 3.60e-01 | 15 1 9.23e-09 2.57e-08 4.44e-01 1.23e-03 6.55e-10 7.00e-03 4.91e-11 3.60e-01 | 16 1 1.85e-08 6.61e-08 4.44e-01 1.23e-03 1.69e-09 7.00e-03 1.26e-10 3.60e-01 | 17 1 3.69e-08 1.70e-07 4.44e-01 1.23e-03 4.33e-09 7.00e-03 3.25e-10 3.60e-01 | 19 1 1.48e-07 4.37e-07 4.44e-01 1.23e-03 1.11e-08 7.00e-03 8.35e-10 3.60e-01 | 20 1 2.95e-07 1.12e-06 4.44e-01 1.23e-03 2.87e-08 7.00e-03 2.15e-09 3.60e-01 | 21 1 5.90e-07 2.89e-06 4.44e-01 1.23e-03 7.37e-08 7.00e-03 5.52e-09 3.60e-01 | 23 1 2.36e-06 7.44e-06 4.44e-01 1.23e-03 1.90e-07 7.00e-03 1.42e-08 3.60e-01 | 25 1 2.36e-06 1.91e-05 4.44e-01 1.23e-03 4.88e-07 7.00e-03 3.65e-08 3.60e-01 | 28 2 4.72e-06 4.92e-05 4.44e-01 1.23e-03 1.25e-06 7.00e-03 9.39e-08 3.60e-01 | 30 2 1.89e-05 1.27e-04 4.44e-01 1.23e-03 3.22e-06 7.00e-03 2.41e-07 3.60e-01 | 32 2 7.56e-05 3.25e-04 4.44e-01 1.23e-03 8.28e-06 7.00e-03 6.20e-07 3.60e-01 | 34 2 1.51e-04 8.37e-04 4.44e-01 1.22e-03 2.13e-05 7.00e-03 1.59e-06 3.60e-01 | 37 3 3.02e-04 2.15e-03 4.44e-01 1.20e-03 5.45e-05 7.00e-03 4.08e-06 3.60e-01 | 41 3 6.05e-04 5.53e-03 4.44e-01 1.16e-03 1.39e-04 7.00e-03 1.04e-05 3.60e-01 | 45 3 8.45e-04 1.42e-02 4.43e-01 1.05e-03 3.47e-04 7.00e-03 2.61e-05 3.59e-01 | 52 4 3.38e-03 3.66e-02 4.42e-01 8.07e-04 8.35e-04 7.00e-03 6.29e-05 3.59e-01 | 58 5 3.38e-03 9.41e-02 4.40e-01 4.01e-04 1.81e-03 7.00e-03 1.37e-04 3.57e-01 | 69 5 6.76e-03 2.42e-01 4.37e-01 1.18e-04 3.26e-03 7.00e-03 2.50e-04 3.55e-01 | 91 5 6.76e-03 6.22e-01 4.32e-01 1.08e-04 5.87e-03 6.99e-03 4.59e-04 3.50e-01 | 132 5 1.35e-02 1.60e+00 4.19e-01 1.30e-04 1.24e-02 6.96e-03 1.02e-03 3.38e-01 | 150 4 1.08e-01 4.12e+00 3.87e-01 2.07e-04 2.81e-02 6.77e-03 2.59e-03 3.04e-01 | 165 4 1.42e-01 1.06e+01 3.21e-01 4.82e-04 6.10e-02 5.86e-03 6.80e-03 2.18e-01 | 194 5 2.84e-01 2.72e+01 2.32e-01 9.50e-04 1.04e-01 3.07e-03 1.34e-02 8.27e-02 | 279 4 1.52e-01 7.00e+01 1.62e-01 1.15e-03 1.38e-01 7.40e-04 1.66e-02 1.39e-02 | 375 4 3.60e-01 1.80e+02 1.15e-01 1.20e-03 1.61e-01 3.66e-04 1.71e-02 4.87e-03 | 500 4 1.03e+00 -------------------------------------------------------- G: 31.2642162723035995 -------------------------------------------------------- Final Run Statistics: Number of steps = 500 Number of residual evaluations = 846 Number of Jacobian evaluations = 43 Number of nonlinear iterations = 588 Number of error test failures = 2 Number of nonlinear conv. failures = 0 sundials-2.5.0/examples/idas/serial/README0000600000175000017500000000227311741421242021111 0ustar sylvestresylvestreList of serial IDAS examples idasAkzoNob_ASAi_dns : adjoint sensitivity for the chemical Akzo-Nobel problem idasAkzoNob_dns : chemical Akzo-Nobel problem idasFoodWeb_bnd : 2-D food web system, banded Jacobian idasHeat2D_bnd : 2-D heat equation, banded Jacobian idasHeat2D_kry : 2-D heat equation, diagonal preconditioner idasHessian_ASA_FSA : computation of Hessian for Robertson kinetics system idasKrylovDemo_ls : demonstration program with 3 Krylov solvers idasRoberts_ASAi_dns : adjoint sensitivity for Robertson kinetics system idasRoberts_dns : 3-species Robertson kinetics system with a user-supplied Jacobian idasRoberts_FSA_dns : forward sensitivity for Robertson kinetics system idasSlCrank_dns : slider-crank simulation idasSlCrank_FSA_dns : forward sensitivity for slider-crank Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 sundials-2.5.0/examples/idas/serial/idasSlCrank_FSA_dns.out0000600000175000017500000000173311741421242024515 0ustar sylvestresylvestre Slider-Crank example for IDAS: Forward integration ... done! Final Run Statistics: Number of steps = 234 Number of residual evaluations = 1194 Number of Jacobian evaluations = 48 Number of nonlinear iterations = 714 Number of error test failures = 0 Number of nonlinear conv. failures = 1 -------------------------------------------- G = 3.3366156512592133 -------------------------------------------- -------------F O R W A R D------------------ dG/dp: 3.3346e-01 -3.6375e-01 -------------------------------------------- Checking using Finite Differences ---------------BACKWARD------------------ dG/dp: 3.3345e-01 -3.6375e-01 ----------------------------------------- ---------------FORWARD------------------- dG/dp: 3.3345e-01 -3.6375e-01 ----------------------------------------- --------------CENTERED------------------- dG/dp: 3.3345e-01 -3.6375e-01 ----------------------------------------- sundials-2.5.0/examples/ida/0000755000175000017500000000000011767174700016607 5ustar sylvestresylvestresundials-2.5.0/examples/ida/fcmix_parallel/0000755000175000017500000000000011767174700021571 5ustar sylvestresylvestresundials-2.5.0/examples/ida/fcmix_parallel/CMakeLists.txt0000600000175000017500000001011311741421215024301 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FIDA parallel examples # Add variable ida_examples with the names of the parallel IDA examples SET(FIDA_examples fidaHeat2D_kry_bbd_p ) # Check whether we use MPI compiler scripts. # If yes, then change the Fortran compiler to the MPIF77 script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPIF77 ) # use MPI_MPIF77 as the compiler SET(CMAKE_Fortran_COMPILER ${MPI_MPIF77}) ELSE(MPI_MPIF77) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPIF77) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_static) SET(NVECP_LIB sundials_nvecparallel_static) SET(FNVECP_LIB sundials_fnvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_shared) SET(NVECP_LIB sundials_nvecparallel_shared) SET(FNVECP_LIB sundials_fnvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FIDA_LIB sundials_fida_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FIDA_LIB} ${IDA_LIB} ${FNVECP_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each IDA example FOREACH(example ${FIDA_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPIF77) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPIF77) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FIDA_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDA") SET(SOLVER_LIB "sundials_ida") SET(SOLVER_FLIB "sundials_fida") LIST2STRING(FIDA_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/ida/fcmix_parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/fcmix_parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/ida/fcmix_parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/fcmix_parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/ida/fcmix_parallel/Makefile.in0000600000175000017500000000736411741421215023624 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2005, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FIDA parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ FFLAGS = @FFLAGS@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ MPIF77 = @MPIF77@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_FLAGS = @MPI_FLAGS@ MPIF77_LNKR = @MPIF77_LNKR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/ida/fcmix/libsundials_fida.la \ $(top_builddir)/src/ida/libsundials_ida.la \ $(top_builddir)/src/nvec_par/libsundials_fnvecparallel.la \ $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fidaHeat2D_kry_bbd_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${MPIF77} ${MPI_FLAGS} -I${MPI_INC_DIR} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${MPIF77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${MPI_FLAGS} ${F77_LDFLAGS} ${SUNDIALS_LIBS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${F77_LIBS} $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/ida/fcmix_parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/ida/fcmix_parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_parallel/README $(EXS_INSTDIR)/ida/fcmix_parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_parallel/$${i}.f $(EXS_INSTDIR)/ida/fcmix_parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_parallel/$${i}.out $(EXS_INSTDIR)/ida/fcmix_parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/ida/fcmix_parallel/Makefile rm -f $(EXS_INSTDIR)/ida/fcmix_parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/ida/fcmix_parallel/$${i}.f ; \ rm -f $(EXS_INSTDIR)/ida/fcmix_parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/ida/fcmix_parallel $(rminstalldirs) $(EXS_INSTDIR)/ida clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/ida/fcmix_parallel/fidaHeat2D_kry_bbd_p.f0000600000175000017500000005531411741421215025632 0ustar sylvestresylvestrec ---------------------------------------------------------------- c $Revision: 1.3 $ c $Date: 2009/09/30 23:29:59 $ c ---------------------------------------------------------------- c Example problem for FIDA: 2D heat equation, parallel, GMRES, c IDABBDPRE. c c This example solves a discretized 2D heat equation problem. c This version uses the Krylov solver IDASPGMR and BBD c preconditioning. c c The DAE system solved is a spatial discretization of the PDE c du/dt = d^2u/dx^2 + d^2u/dy^2 c on the unit square. The boundary condition is u = 0 on all edges. c Initial conditions are given by u = 16 x (1 - x) y (1 - y). The c PDE is treated with central differences on a uniform MX x MY c grid. The values of u at the interior points satisfy ODEs, and c equations u = 0 at the boundaries are appended, to form a DAE c system of size N = MX * MY. Here MX = MY = 10. c c The system is actually implemented on submeshes, processor by c processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY c processors. c c The system is solved with FIDA using the Krylov linear solver c IDASPGMR in conjunction with the preconditioner module IDABBDPRE. c The preconditioner uses a tridiagonal approximation c (half-bandwidths = 1). The constraints u >= 0 are posed for all c components. Local error testing on the boundary values is c suppressed. Output is taken at t = 0, .01, .02, .04, ..., 10.24. c ---------------------------------------------------------------- c program fidaHeat2D_kry_bbd_p c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 mudq, mldq, mukeep, mlkeep integer*4 iout(25), ipar double precision rout(10), rpar integer nout, ier parameter (nout = 11) integer npes, inopt, maxl, gstype, maxrs, itask, iatol double precision t0, t1, tout, tret, dqrely, eplifac, dqincfac double precision atol, rtol double precision constr(nlocalg), uu(nlocalg), up(nlocalg) double precision res(nlocalg), id(nlocalg) c data atol/1.0d-3/, rtol/0.0d0/ c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c c Initialize variables c npex = 2 npey = 2 mxsub = 5 mysub = 5 mx = npex*mxsub my = npey*mysub neq = mx*my nlocal = mxsub*mysub inopt = 1 t0 = 0.0d0 t1 = 0.01d0 mudq = mxsub mldq = mxsub mukeep = 1 mlkeep = 1 dqrely = 0.0d0 maxl = 0 gstype = 0 maxrs = 0 eplifac = 0.0d0 dqincfac = 0.0d0 itask = 1 iatol = 1 c c Initialize MPI environment c call mpi_init(ier) if (ier .ne. 0) then write(*,2) ier 2 format(///' MPI_ERROR: MPI_INIT returned IER = ', i5) stop endif c call mpi_comm_size(mpi_comm_world, npes, ier) if (ier .ne. 0) then write(*,3) ier 3 format(///' MPI_ERROR: MPI_COMM_SIZE returned IER = ', i5) call mpi_abort(mpi_comm_world, 1, ier) stop endif c call mpi_comm_rank(mpi_comm_world, thispe, ier) if (ier .ne. 0) then write(*,4) ier 4 format(///' MPI_ERROR: MPI_COMM_RANK returned IER = ', i5) call mpi_abort(mpi_comm_world, 1, ier) stop endif c if (npes .ne. npex*npey) then if (thispe .eq. 0) then write(*,5) npes, npex*npey 5 format(///' MPI_ERROR: npes = ', i5, ' is not equal to ', & 'NPEX*NPEY = ', i5) call mpi_finalize(ier) stop endif endif c call fnvinitp(mpi_comm_world, 2, nlocal, neq, ier) if (ier .ne. 0) then write(*,6) ier 6 format(///' SUNDIALS_ERROR: FNVINITP returned IER = ', i5) call mpi_finalize(ier) stop endif c jysub = int(thispe/npex) ixsub = thispe-jysub*npex c c Initialize problem data c call setinitprofile(uu, up, id, res, constr, ipar, rpar) c c Initialize IDA environment c call fidamalloc(t0, uu, up, iatol, rtol, atol, & iout, rout, ipar, rpar, ier) if (ier .ne. 0) then write(*,7) ier 7 format(///' SUNDIALS_ERROR: FIDAMALLOC returned IER = ', i5) call mpi_abort(mpi_comm_world, 1, ier) stop endif c c Set optional inputs c call fidasetiin('SUPPRESS_ALG', 1, ier) call fidasetvin('ID_VEC', id, ier) call fidasetvin('CONSTR_VEC', constr, ier) c c Initialize and attach BBDSPGMR module c call fidaspgmr(maxl, gstype, maxrs, eplifac, dqincfac, ier) if (ier .ne. 0) then write(*,9) ier 9 format(///' SUNDIALS_ERROR: FIDABBDSPGMR returned IER = ', i5) call mpi_abort(mpi_comm_world, 1, ier) stop endif c call fidabbdinit(nlocal, mudq, mldq, mukeep, mlkeep, dqrely, ier) if (ier .ne. 0) then write(*,8) ier 8 format(///' SUNDIALS_ERROR: FIDABBDINIT returned IER = ', i5) call mpi_abort(mpi_comm_world, 1, ier) stop endif c c Print header c if (thispe .eq. 0) then call prntintro(rtol, atol) call prntcase(1, mudq, mukeep) endif c tout = t1 do 10 jout = 1, nout c call fidasolve(tout, tret, uu, up, itask, ier) c call prntoutput(tret, uu, iout, rout) c if (ier .ne. 0) then write(*,11) ier 11 format(///' SUNDIALS_ERROR: FIDASOLVE returned IER = ', i5) call fidafree stop endif c tout = tout*2.0d0 c 10 continue c c Print statistics c if (thispe .eq. 0) then call prntfinalstats(iout) endif c c Reinitialize variables and data for second problem c mudq = 1 mldq = 1 c call setinitprofile(uu, up, id, res, constr, ipar, rpar) c call fidareinit(t0, uu, up, iatol, rtol, atol, ier) if (ier .ne. 0) then write(*,33) ier 33 format(///' SUNDIALS_ERROR: FIDAREINIT returned IER = ', i5) endif c call fidabbdreinit(nlocal, mudq, mldq, dqrely, ier) if (ier .ne. 0) then write(*,34) ier 34 format(///' SUNDIALS_ERROR: FIDABBDREINIT returned IER = ', i5) call fidafree stop endif c c Print header c if (thispe .eq. 0) then call prntcase(2, mudq, mukeep) endif c tout = t1 do 12 jout = 1, nout c call fidasolve(tout, tret, uu, up, itask, ier) c call prntoutput(tret, uu, iout, rout) c if (ier .ne. 0) then write(*,13) ier 13 format(///' SUNDIALS_ERROR: FIDASOLVE returned IER = ', i5) call fidafree stop endif c tout = tout*2.0d0 c 12 continue c c Print statistics c if (thispe .eq. 0) then call prntfinalstats(iout) endif c c Free memory c call fidafree c call mpi_finalize(ier) c stop end c c ========== c subroutine setinitprofile(uu, up, id, res, constr, ipar, rpar) c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub, ipar(*) integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy, rpar(*) double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 i, iloc, j, jloc, offset, loc integer*4 ixbegin, ixend, jybegin, jyend integer reserr double precision xfact, yfact double precision uu(*), up(*), id(*), res(*), constr(*) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c c Initialize variables c dx = 1.0d0/dble(mx-1) dy = 1.0d0/dble(my-1) coeffx = 1.0d0/(dx*dx) coeffy = 1.0d0/(dy*dy) coeffxy = 2.0d0/(dx*dx)+2.0d0/(dy*dy) ixbegin = mxsub*ixsub ixend = mxsub*(ixsub+1)-1 jybegin = mysub*jysub jyend = mysub*(jysub+1)-1 c do 14 i = 1, nlocal id(i) = 1.0d0 14 continue c jloc = 0 do 15 j = jybegin, jyend yfact = dy*dble(j) offset = jloc*mxsub iloc = 0 do 16 i = ixbegin, ixend xfact = dx*dble(i) loc = offset+iloc uu(loc+1) = 16.0d0*xfact*(1.0d0-xfact)*yfact*(1.0d0-yfact) if (i .eq. 0 .or. i .eq. mx-1) then id(loc+1) = 0.0d0 endif if (j .eq. 0 .or. j .eq. my-1) then id(loc+1) = 0.0d0 endif iloc = iloc+1 16 continue jloc = jloc+1 15 continue c do 17 i = 1, nlocal up(i) = 0.0d0 constr(i) = 1.0d0 17 continue c call fidaresfun(0.0d0, uu, up, res, ipar, rpar, reserr) c do 18 i = 1, nlocal up(i) = -1.0d0*res(i) 18 continue c return end c c ========== c subroutine fidaresfun(tres, u, up, res, ipar, rpar, reserr) c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub, ipar(*) integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy, rpar(*) double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer reserr double precision tres double precision u(*), up(*), res(*) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c call fidacommfn(nlocal, tres, u, up, ipar, rpar, reserr) c call fidaglocfn(nlocal, tres, u, up, res, ipar, rpar, reserr) c return end c c ========== c subroutine fidacommfn(nloc, tres, u, up, ipar, rpar, reserr) c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub, ipar(*) integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy, rpar(*) double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 nloc integer reserr double precision tres, u(*), up(*) c integer request(mpi_status_size) double precision buffer(2*mysub) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c call brecvpost(request, mxsub, mysub, buffer) c call bsend(mxsub, mysub, u) c call brecvwait(request, mxsub, buffer) c return end c c ========== c subroutine fidaglocfn(nloc, tres, u, up, res, ipar, rpar, reserr) c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub, ipar(*) integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy, rpar(*) double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 nloc integer reserr double precision tres, u(*), up(*), res(*) c integer*4 i, lx, ly, offsetu, offsetue, locu, locue integer*4 ixbegin, ixend, jybegin, jyend, mxsub2 double precision termx, termy, termctr c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c mxsub2 = mxsub+2 c do 19 i = 1, nlocal res(i) = u(i) 19 continue c offsetu = 0 offsetue = mxsub2+1 do 20 ly = 0, mysub-1 do 21 lx = 0, mxsub-1 uext(offsetue+lx+1) = u(offsetu+lx+1) 21 continue offsetu = offsetu+mxsub offsetue = offsetue+mxsub2 20 continue c ixbegin = 0 ixend = mxsub-1 jybegin = 0 jyend = mysub-1 if (ixsub .eq. 0) then ixbegin = ixbegin+1 endif if (ixsub .eq. npex-1) then ixend = ixend-1 endif if (jysub .eq. 0) then jybegin = jybegin+1 endif if (jysub .eq. npey-1) then jyend = jyend-1 endif c do 22 ly = jybegin, jyend do 23 lx = ixbegin, ixend locu = lx+ly*mxsub locue = (lx+1)+(ly+1)*mxsub2 termx = coeffx*(uext(locue)+uext(locue+2)) termy = coeffy*(uext(locue-mxsub2+1)+uext(locue+mxsub2+1)) termctr = coeffxy*uext(locue+1) res(locu+1) = up(locu+1)-(termx+termy-termctr) 23 continue 22 continue c return end c c ========== c subroutine bsend(dsizex, dsizey, uarray) c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 dsizex, dsizey double precision uarray(*) c integer ier, offsetu double precision bufleft(mysub), bufright(mysub) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c if (jysub .ne. 0) then call mpi_send(uarray(1), dsizex, mpi_double_precision, & thispe-npex, 0, mpi_comm_world, ier) endif c if (jysub .ne. npey-1) then offsetu = (mysub-1)*dsizex call mpi_send(uarray(offsetu+1), dsizex, mpi_double_precision, & thispe+npex, 0, mpi_comm_world, ier) endif c if (ixsub .ne. 0) then do 24 ly = 0, mysub-1 offsetu = ly*dsizex bufleft(ly+1) = uarray(offsetu+1) 24 continue call mpi_send(bufleft(1), dsizey, mpi_double_precision, & thispe-1, 0, mpi_comm_world, ier) endif c if (ixsub .ne. npex-1) then do 25 ly = 0, mysub-1 offsetu = ly*mxsub+(mxsub-1) bufright(ly+1) = uarray(offsetu+1) 25 continue call mpi_send(bufright(1), dsizey, mpi_double_precision, & thispe+1, 0, mpi_comm_world, ier) endif c return end c c ========== c subroutine brecvpost(request, dsizex, dsizey, buffer) c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 dsizex, dsizey integer request(*) double precision buffer(*) c integer ier integer*4 offsetue c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c if (jysub .ne. 0) then call mpi_irecv(uext(2), dsizex, mpi_double_precision, & thispe-npex, 0, mpi_comm_world, request(1), & ier) endif c if (jysub .ne. npey-1) then offsetue = (1+(mysub+1)*(mxsub+2)) call mpi_irecv(uext(offsetue+1), dsizex, mpi_double_precision, & thispe+npex, 0, mpi_comm_world, request(2), & ier) endif c if (ixsub .ne. 0) then call mpi_irecv(buffer(1), dsizey, mpi_double_precision, & thispe-1, 0, mpi_comm_world, request(3), & ier) endif c if (ixsub .ne. npex-1) then call mpi_irecv(buffer(1+mysub), dsizey, mpi_double_precision, & thispe+1, 0, mpi_comm_world, request(4), & ier) endif c return end c c ========== c subroutine brecvwait(request, dsizex, buffer) c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer request(*) integer*4 dsizex double precision buffer(*) c integer*4 ly, dsizex2, offsetue integer ier, status(mpi_status_size) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c dsizex2 = dsizex+2 c if (jysub .ne. 0) then call mpi_wait(request(1), status, ier) endif c if (jysub .ne. npey-1) then call mpi_wait(request(2), status, ier) endif c if (ixsub .ne. 0) then call mpi_wait(request(3), status, ier) do 26 ly = 0, mysub-1 offsetue = (ly+1)*dsizex2 uext(offsetue+1) = buffer(ly+1) 26 continue endif c if (ixsub .ne. npex-1) then call mpi_wait(request(4), status, ier) do 27 ly = 0, mysub-1 offsetue = (ly+2)*dsizex2-1 uext(offsetue+1) = buffer(ly+mysub+1) 27 continue endif c return end c c ========== c subroutine prntoutput(tret, u, iout, rout) c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 iout(*), lenrwbbd, leniwbbd, ngebbd double precision tret, umax, u(*), rout(*) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c call maxnorm(u, umax) c if (thispe .eq. 0) then call fidabbdopt(lenrwbbd, leniwbbd, ngebbd) write(*,28) tret, umax, iout(9), iout(3), iout(7), & iout(20), iout(4), iout(16), ngebbd, rout(2), & iout(18), iout(19) 28 format(' ', e10.4, ' ', e13.5, ' ', i1, ' ', i2, & ' ', i3, ' ', i3, ' ', i2,'+',i2, ' ', & i3, ' ', e9.2, ' ', i2, ' ', i3) endif c return end c c ========== c subroutine maxnorm(u, unorm) c include "mpif.h" c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c integer*4 i integer ier double precision temp, unorm, u(*) c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c temp = 0.0d0 c do 29 i = 1, nlocal temp = max(abs(u(i)), temp) 29 continue c call mpi_allreduce(temp, unorm, 1, mpi_double_precision, & mpi_max, mpi_comm_world, ier) c c unorm = temp c return end c c ========== c subroutine prntintro(rtol, atol) c c global variables c integer*4 nlocal, neq, npex, npey, mxsub, mysub, mx, my integer*4 ixsub, jysub integer thispe integer mxsubg, mysubg, nlocalg parameter (mxsubg = 5, mysubg = 5) parameter (nlocalg = mxsubg*mysubg) double precision dx, dy, coeffx, coeffy, coeffxy double precision uext((mxsubg+2)*(mysubg+2)) c c local variables c double precision rtol, atol c common /pcom/ dx, dy, coeffx, coeffy, coeffxy, uext, & nlocal, neq, mx, my, mxsub, mysub, npey, npex, & ixsub, jysub, thispe c write(*,30) mx, my, neq, mxsub, mysub, npex, npey, rtol, atol 30 format(/'fidaHeat2D_kry_bbd_p: Heat equation, parallel example', & ' for FIDA', /, 16x,'Discretized heat equation', & ' on 2D unit square.', /, 16x,'Zero boundary', & ' conditions, polynomial conditions.', /, & 16x,'Mesh dimensions: ', i2, ' x ', i2, & ' Total system size: ', i3, //, & 'Subgrid dimensions: ', i2, ' x ', i2, & ' Processor array: ', i2, ' x ', i2, /, & 'Tolerance parameters: rtol = ', e8.2, ' atol = ', & e8.2, /, 'Constraints set to force all solution', & ' components >= 0.', /, 'SUPPRESSALG = TRUE to remove', & ' boundary components from the error test.', /, & 'Linear solver: SPGMR. Preconditioner: BBDPRE - ', & 'Banded-block-diagonal.') c return end c c ========== c subroutine prntcase(num, mudq, mukeep) c c local variables c integer*4 mudq, mukeep integer num c write(*,31) num, mudq, mukeep 31 format(//, 'Case ', i2, /, ' Difference quotient half-', & 'bandwidths =', i2, /, ' Retained matrix half-bandwidths =', & i2, //, 'Output Summary',/,' umax = max-norm of solution', & /,' nre = nre + nreLS (total number of RES evals.)', & //, ' time umax k nst nni nli nre', & ' nge h npe nps', /, & '-------------------------------------------------------', & '-------------------') c return end c c ========== c subroutine prntfinalstats(iout) c c local variables c integer*4 iout(*) c write(*,32) iout(5), iout(6), iout(21) 32 format(/, 'Error test failures =', i3, /, & 'Nonlinear convergence failures =', i3, /, & 'Linear convergence failures =', i3) c return end sundials-2.5.0/examples/ida/fcmix_parallel/fidaHeat2D_kry_bbd_p.out0000600000175000017500000000607011741421215026207 0ustar sylvestresylvestre fidaHeat2D_kry_bbd_p: Heat equation, parallel example problem for FIDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Subgrid dimensions: 5 x 5 Processor array: 2 x 2 Tolerance parameters: rtol = 0.00E+00 atol = 0.10E-02 Constraints set to force all solution components >= 0. SUPPRESSALG = TRUE to remove boundary components from the error test. Linear solver: SPGMR. Preconditioner: BBDPRE - Banded-block-diagonal. Case 1 Difference quotient half-bandwidths = 5 Retained matrix half-bandwidths = 1 Output Summary umax = max-norm of solution nre = nre + nreLS (total number of RES evals.) time umax k nst nni nli nre nge h npe nps -------------------------------------------------------------------------- 0.1000E-01 0.82411E+00 2 12 14 7 14+ 7 96 0.26E-02 8 21 0.2000E-01 0.68812E+00 3 15 18 12 18+12 96 0.51E-02 8 30 0.4000E-01 0.47075E+00 3 18 24 22 24+22 108 0.66E-02 9 46 0.8000E-01 0.21660E+00 3 22 29 30 29+30 108 0.13E-01 9 59 0.1600E+00 0.45659E-01 4 28 37 43 37+43 120 0.26E-01 10 80 0.3200E+00 0.21096E-02 4 35 45 59 45+59 120 0.24E-01 10 104 0.6400E+00 0.55368E-04 1 40 54 71 54+71 156 0.19E+00 13 125 0.1280E+01 0.15597E-18 1 42 56 71 56+71 180 0.76E+00 15 127 0.2560E+01 0.33865E-20 1 43 57 71 57+71 192 0.15E+01 16 128 0.5120E+01 0.86074E-20 1 44 58 71 58+71 204 0.30E+01 17 129 0.1024E+02 0.16630E-19 1 45 59 71 59+71 216 0.61E+01 18 130 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 Case 2 Difference quotient half-bandwidths = 1 Retained matrix half-bandwidths = 1 Output Summary umax = max-norm of solution nre = nre + nreLS (total number of RES evals.) time umax k nst nni nli nre nge h npe nps -------------------------------------------------------------------------- 0.1000E-01 0.82411E+00 2 12 14 7 14+ 7 32 0.26E-02 8 21 0.2000E-01 0.68812E+00 3 15 18 12 18+12 32 0.51E-02 8 30 0.4000E-01 0.47093E+00 3 19 23 20 23+20 36 0.10E-01 9 43 0.8000E-01 0.21655E+00 3 23 27 32 27+32 36 0.10E-01 9 59 0.1600E+00 0.45225E-01 4 27 33 44 33+44 40 0.20E-01 10 77 0.3200E+00 0.21868E-02 3 34 41 67 41+67 44 0.41E-01 11 108 0.6400E+00 0.48847E-18 1 39 49 86 49+86 52 0.16E+00 13 135 0.1280E+01 0.53982E-18 1 41 51 86 51+86 60 0.66E+00 15 137 0.2560E+01 0.74194E-17 1 42 52 86 52+86 64 0.13E+01 16 138 0.5120E+01 0.61081E-16 1 43 53 86 53+86 68 0.26E+01 17 139 0.1024E+02 0.40536E-15 1 44 54 86 54+86 72 0.52E+01 18 140 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/ida/fcmix_parallel/README0000600000175000017500000000075411741421215022433 0ustar sylvestresylvestreList of parallel IDA FCMIX examples fidaHeat2D_kry_bbd_p : 2D heat equation (SPGMR w/FIDABBD preconditioner) Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/ida/parallel/0000755000175000017500000000000011767174700020403 5ustar sylvestresylvestresundials-2.5.0/examples/ida/parallel/idaHeat2D_kry_p.c0000600000175000017500000006770511741421215023473 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2009/09/30 23:28:00 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, parallel, GMRES. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). * The PDE is treated with central differences on a uniform MX x MY * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = MX * MY. Here MX = MY = 10. * * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR. The preconditioner uses the diagonal elements of the * Jacobian only. Routines for preconditioning, required by * IDASPGMR, are supplied here. The constraints u >= 0 are posed * for all components. Local error testing on the boundary values * is suppressed. Output is taken at t = 0, .01, .02, .04, * ..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NOUT 11 /* Number of output times */ #define NPEX 2 /* No. PEs in x direction of PE array */ #define NPEY 2 /* No. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* No. x points per subgrid */ #define MYSUB 5 /* No. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ typedef struct { long int thispe, mx, my, ixsub, jysub, npex, npey, mxsub, mysub; realtype dx, dy, coeffx, coeffy, coeffxy; realtype uext[(MXSUB+2)*(MYSUB+2)]; N_Vector pp; /* vector of diagonal preconditioner elements */ MPI_Comm comm; } *UserData; /* User-supplied residual function and supporting routines */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data); static int rescomm(N_Vector uu, N_Vector up, void *user_data); static int reslocal(realtype tt, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int BSend(MPI_Comm comm, long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uarray[]); static int BRecvPost(MPI_Comm comm, MPI_Request request[], long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static int BRecvWait(MPI_Request request[], long int ixsub, long int jysub, long int dsizex, realtype uext[], realtype buffer[]); /* User-supplied preconditioner routines */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); int PsetupHeat(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private function to check function return values */ static int InitUserData(int thispe, MPI_Comm comm, UserData data); static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data); static void PrintHeader(long int Neq, realtype rtol, realtype atol); static void PrintOutput(int id, void *mem, realtype t, N_Vector uu); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int iout, thispe, ier, npes; long int Neq, local_N; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate and initialize the data structure and N-vectors. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); data->pp = NULL; uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* An N-vector to hold preconditioner. */ data->pp = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)data->pp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and res profiles. */ SetInitialProfile(uu, up, id, res, data); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution. */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only) and intial solution */ if (thispe == 0) PrintHeader(Neq, rtol, atol); PrintOutput(thispe, mem, t0, uu); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print remaining counters. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); N_VDestroy_Parallel(data->pp); free(data); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. * * This parallel implementation uses several supporting routines. * First a call is made to rescomm to do communication of subgrid boundary * data into array uext. Then reslocal is called to compute the residual * on individual processors and their corresponding domains. The routines * BSend, BRecvPost, and BREcvWait handle interprocessor communication * of uu required to calculate the residual. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { int retval; /* Call rescomm to do inter-processor communication. */ retval = rescomm(uu, up, user_data); /* Call reslocal to calculate res. */ retval = reslocal(tt, uu, up, rr, user_data); return(0); } /* * PsetupHeat: setup for diagonal preconditioner for heatsk. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupHeat argument list. * */ int PsetupHeat(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype *ppv, pelinv; long int lx, ly, ixbegin, ixend, jybegin, jyend, locu, mxsub, mysub; long int ixsub, jysub, npex, npey; UserData data; data = (UserData) user_data; ppv = NV_DATA_P(data->pp); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initially set all pp elements to one. */ N_VConst(ONE, data->pp); /* Prepare to loop over subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; pelinv = ONE/(c_j + data->coeffxy); /* Load the inverse of the preconditioner diagonal elements in loop over all the local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; ppv[locu] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PsetupHeat), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { UserData data; data = (UserData) user_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * rescomm routine. This routine performs all inter-processor * communication of data in u needed to calculate G. */ static int rescomm(N_Vector uu, N_Vector up, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*MYSUB]; MPI_Comm comm; long int thispe, ixsub, jysub, mxsub, mysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(uu); /* Get comm, thispe, subgrid indices, data sizes, extended array uext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; uext = data->uext; /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, mxsub, uext, buffer); return(0); } /* * reslocal routine. Compute res = F(t, uu, up). This routine assumes * that all inter-processor communication of data needed to calculate F * has already been done, and that this data is in the work array uext. */ static int reslocal(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { realtype *uext, *uuv, *upv, *resv; realtype termx, termy, termctr; long int lx, ly, offsetu, offsetue, locu, locue; long int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey; long int ixbegin, ixend, jybegin, jyend; UserData data; /* Get subgrid indices, array sizes, extended work array uext. */ data = (UserData) user_data; uext = data->uext; uuv = NV_DATA_P(uu); upv = NV_DATA_P(up); resv = NV_DATA_P(rr); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mxsub2 = data->mxsub + 2; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initialize all elements of rr to uu. This sets the boundary elements simply without indexing hassles. */ N_VScale(ONE, uu, rr); /* Copy local segment of u vector into the working extended array uext. This completes uext prior to the computation of the rr vector. */ offsetu = 0; offsetue = mxsub2 + 1; for (ly = 0; ly < mysub; ly++) { for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx]; offsetu = offsetu + mxsub; offsetue = offsetue + mxsub2; } /* Set loop limits for the interior of the local subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; /* Loop over all grid points in local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; locue = (lx+1) + (ly+1)*mxsub2; termx = data->coeffx *(uext[locue-1] + uext[locue+1]); termy = data->coeffy *(uext[locue-mxsub2] + uext[locue+mxsub2]); termctr = data->coeffxy*uext[locue]; resv[locu] = upv[locu] - (termx + termy - termctr); } } return(0); } /* * Routine to send boundary data to neighboring PEs. */ static int BSend(MPI_Comm comm, long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uarray[]) { long int ly, offsetu; realtype bufleft[MYSUB], bufright[MYSUB]; /* If jysub > 0, send data from bottom x-line of u. */ if (jysub != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of u. */ if (jysub != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of u (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*dsizex; bufleft[ly] = uarray[offsetu]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of u (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*MXSUB + (MXSUB-1); bufright[ly] = uarray[offsetu]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm); } return(0); } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in * both calls also. */ static int BRecvPost(MPI_Comm comm, MPI_Request request[], long int thispe, long int ixsub, long int jysub, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+MYSUB; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Irecv(&uext[1], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) { offsetue = (1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm, &request[3]); } return(0); } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have four entries, and should be passed in both * calls also. */ static int BRecvWait(MPI_Request request[], long int ixsub, long int jysub, long int dsizex, realtype uext[], realtype buffer[]) { long int ly, dsizex2, offsetue; realtype *bufleft = buffer, *bufright = buffer+MYSUB; MPI_Status status; dsizex2 = dsizex + 2; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext. */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+1)*dsizex2; uext[offsetue] = bufleft[ly]; } } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+2)*dsizex2 - 1; uext[offsetue] = bufright[ly]; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData initializes the user's data block data. */ static int InitUserData(int thispe, MPI_Comm comm, UserData data) { data->thispe = thispe; data->dx = ONE/(MX-ONE); /* Assumes a [0,1] interval in x. */ data->dy = ONE/(MY-ONE); /* Assumes a [0,1] interval in y. */ data->coeffx = ONE/(data->dx * data->dx); data->coeffy = ONE/(data->dy * data->dy); data->coeffxy = TWO/(data->dx * data->dx) + TWO/(data->dy * data->dy) ; data->jysub = thispe/NPEX; data->ixsub = thispe - data->jysub * NPEX; data->npex = NPEX; data->npey = NPEY; data->mx = MX; data->my = MY; data->mxsub = MXSUB; data->mysub = MYSUB; data->comm = comm; return(0); } /* * SetInitialProfile sets the initial values for the problem. */ static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data) { long int i, iloc, j, jloc, offset, loc, ixsub, jysub; long int ixbegin, ixend, jybegin, jyend; realtype xfact, yfact, *udata, *iddata, dx, dy; /* Initialize uu. */ udata = NV_DATA_P(uu); iddata = NV_DATA_P(id); /* Set mesh spacings and subgrid indices for this PE. */ dx = data->dx; dy = data->dy; ixsub = data->ixsub; jysub = data->jysub; /* Set beginning and ending locations in the global array corresponding to the portion of that array assigned to this processor. */ ixbegin = MXSUB*ixsub; ixend = MXSUB*(ixsub+1) - 1; jybegin = MYSUB*jysub; jyend = MYSUB*(jysub+1) - 1; /* Loop over the local array, computing the initial profile value. The global indices are (i,j) and the local indices are (iloc,jloc). Also set the id vector to zero for boundary points, one otherwise. */ N_VConst(ONE,id); for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) { yfact = data->dy*j; offset= jloc*MXSUB; for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) { xfact = data->dx * i; loc = offset + iloc; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO; } } /* Initialize up. */ N_VConst(ZERO, up); /* Initially set up = 0. */ /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct initial up values. */ N_VScale(-ONE, res, up); return(0); } /* * Print first lines of output and table heading */ static void PrintHeader(long int Neq, realtype rtol, realtype atol) { printf("\nidaHeat2D_kry_p: Heat equation, parallel example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %ld\n\n", Neq); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("SUPPRESSALG = TRUE to suppress local error testing on "); printf("all boundary components. \n"); printf("Linear solver: IDASPGMR "); printf("Preconditioner: diagonal elements only.\n"); /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nli nre nreLS h npe nps\n"); printf("----------------------------------------------------------------------\n"); } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(int id, void *mem, realtype t, N_Vector uu) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); if (id == 0) { ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1, id); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1, id); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1, id); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1, id); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1, id); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1, id); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1, id); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1, id); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1, id); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1, id); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } } /* * Print some final integrator statistics */ static void PrintFinalStats(void *mem) { long int netf, ncfn, ncfl; IDAGetNumErrTestFails(mem, &netf); IDAGetNumNonlinSolvConvFails(mem, &ncfn); IDASpilsGetNumConvFails(mem, &ncfl); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/parallel/idaHeat2D_kry_bbd_p.out0000600000175000017500000000570211741421215024654 0ustar sylvestresylvestreidaHeat2D_kry_bbd_p: Heat equation, parallel example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Subgrid dimensions: 5 x 5 Processor array: 2 x 2 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. SUPPRESSALG = TRUE to suppress local error testing on all boundary components. Linear solver: IDASPGMR. Preconditioner: IDABBDPRE - Banded-block-diagonal. Case 1. Difference quotient half-bandwidths = 5 Retained matrix half-bandwidths = 1 Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS nge h npe nps . . . . . . . . . . . . . . . . . . . . . . . . 0.01 8.24107e-01 2 12 14 7 14 7 96 2.56e-03 8 21 0.02 6.88124e-01 3 15 18 12 18 12 96 5.12e-03 8 30 0.04 4.70754e-01 3 18 24 22 24 22 108 6.58e-03 9 46 0.08 2.16600e-01 3 22 29 30 29 30 108 1.32e-02 9 59 0.16 4.56595e-02 4 28 37 43 37 43 120 2.63e-02 10 80 0.32 2.10959e-03 4 35 45 59 45 59 120 2.37e-02 10 104 0.64 5.53681e-05 1 40 54 71 54 71 156 1.90e-01 13 125 1.28 1.55972e-19 1 42 56 71 56 71 180 7.58e-01 15 127 2.56 3.38647e-21 1 43 57 71 57 71 192 1.52e+00 16 128 5.12 8.60743e-21 1 44 58 71 58 71 204 3.03e+00 17 129 10.24 1.66301e-20 1 45 59 71 59 71 216 6.06e+00 18 130 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 Case 2. Difference quotient half-bandwidths = 1 Retained matrix half-bandwidths = 1 Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS nge h npe nps . . . . . . . . . . . . . . . . . . . . . . . . 0.01 8.24111e-01 2 12 14 7 14 7 32 2.56e-03 8 21 0.02 6.88118e-01 3 15 18 12 18 12 32 5.12e-03 8 30 0.04 4.70932e-01 3 19 23 20 23 20 36 1.02e-02 9 43 0.08 2.16547e-01 3 23 27 32 27 32 36 1.02e-02 9 59 0.16 4.52248e-02 4 27 33 44 33 44 40 2.05e-02 10 77 0.32 2.18677e-03 3 34 41 67 41 67 44 4.10e-02 11 108 0.64 4.88467e-19 1 39 49 86 49 86 52 1.64e-01 13 135 1.28 5.39822e-19 1 41 51 86 51 86 60 6.55e-01 15 137 2.56 7.41945e-18 1 42 52 86 52 86 64 1.31e+00 16 138 5.12 6.10808e-17 1 43 53 86 53 86 68 2.62e+00 17 139 10.24 4.05358e-16 1 44 54 86 54 86 72 5.24e+00 18 140 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/ida/parallel/CMakeLists.txt0000600000175000017500000000750511741421215023126 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for IDA parallel examples # Add variable IDA_examples with the names of the parallel IDA examples SET(IDA_examples idaFoodWeb_kry_bbd_p idaFoodWeb_kry_p idaHeat2D_kry_bbd_p idaHeat2D_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the C compiler to the MPICC script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_static) SET(NVECP_LIB sundials_nvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_shared) SET(NVECP_LIB sundials_nvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${IDA_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each IDA example FOREACH(example ${IDA_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPICC) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPICC) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDA_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDA") SET(SOLVER_LIB "sundials_ida") LIST2STRING(IDA_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/ida/parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/ida/parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/ida/parallel/Makefile.in0000600000175000017500000000703711741421215022433 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDA parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/ida/libsundials_ida.la $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = idaFoodWeb_kry_bbd_p \ idaFoodWeb_kry_p \ idaHeat2D_kry_bbd_p \ idaHeat2D_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(SUNDIALS_INCS) -I$(MPI_INC_DIR) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(MPICC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}$(OBJ_EXT) $(MPI_FLAGS) $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/ida/parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/ida/parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/ida/parallel/README $(EXS_INSTDIR)/ida/parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/parallel/$${i}.c $(EXS_INSTDIR)/ida/parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/parallel/$${i}.out $(EXS_INSTDIR)/ida/parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/ida/parallel/Makefile rm -f $(EXS_INSTDIR)/ida/parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/ida/parallel/$${i}.c ; \ rm -f $(EXS_INSTDIR)/ida/parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/ida/parallel $(rminstalldirs) $(EXS_INSTDIR)/ida clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/ida/parallel/idaFoodWeb_kry_p.c0000600000175000017500000012041511741421215023735 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 23:03:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web, parallel, GMRES, user * preconditioner. * * This example program for IDA uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses a * block-diagonal preconditioner (setup and solve routines) for the * IDASPGMR package. It was originally run on a Sun SPARC cluster * and used MPICH. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * Note: The above equations are written in 1-based indices, * whereas the code has 0-based indices, being written in C. * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product * MX * MY * NUM_SPECIES. The system is actually implemented on * submeshes, processor by processor, with an MXSUB by MYSUB mesh * on each of NPEX * NPEY processors. * * The DAE system is solved by IDA using the IDASPGMR linear * solver, which uses the preconditioned GMRES iterative method to * solve linear systems. The precondtioner supplied to IDASPGMR is * the block-diagonal part of the Jacobian with ns by ns blocks * arising from the reaction terms only. Output is printed at * t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Journal of Applied Mathematics and Computation, Vol. 31 * (May 1989), pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include /* Problem Constants. */ #define NPREY 1 /* Number of prey (= number of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) /* pi */ #define FOURPI (RCONST(4.0)*PI) /* 4 pi */ #define MXSUB 10 /* Number of x mesh points per processor subgrid */ #define MYSUB 10 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ /* User-defined vector accessor macro IJ_Vptr. */ /* IJ_Vptr is defined in order to express the underlying 3-d structure of the dependent variable vector from its underlying 1-d storage (an N_Vector). IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { long int ns; int np, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES], rhs[NUM_SPECIES], cext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; MPI_Comm comm; N_Vector rates; realtype **PP[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; N_Vector ewt; void *ida_mem; } *UserData; /* Prototypes for user-supplied and supporting functions. */ static int resweb(realtype time, N_Vector cc, N_Vector cp, N_Vector resval, void *user_data); static int Precondbd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); static int PSolvebd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype cj, realtype delta, void *user_data, N_Vector tempv); static int rescomm(N_Vector cc, N_Vector cp, void *user_data); static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static int reslocal(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(int size, realtype *x1, realtype *x2); /* Prototypes for private Helper Functions. */ static UserData AllocUserData(MPI_Comm comm, long int local_N, long int SystemSize); static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm); static void FreeUserData(UserData webdata); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector scrtch, UserData webdata); static void PrintHeader(long int SystemSize, int maxl, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector cc, realtype time, UserData webdata, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData webdata; long int SystemSize, local_N; realtype rtol, atol, t0, tout, tret; N_Vector cc, cp, res, id; int thispe, npes, maxl, iout, flag; cc = cp = res = id = NULL; webdata = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block webdata. */ webdata = AllocUserData(comm, local_N, SystemSize); if (check_flag((void *)webdata, "AllocUserData", 0, thispe)) MPI_Abort(comm, 1); InitUserData(webdata, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector res is used temporarily only. */ cc = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); cp = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if (check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(cc, cp, id, res, webdata); N_VDestroy(res); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize IDA. A pointer to IDA problem memory is returned and stored in idamem. */ mem = IDACreate(); if (check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); flag = IDASetUserData(mem, webdata); if (check_flag(&flag, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); flag = IDASetId(mem, id); if (check_flag(&flag, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); flag = IDAInit(mem, resweb, t0, cc, cp); if (check_flag(&flag, "IDAinit", 1, thispe)) MPI_Abort(comm, 1); flag = IDASStolerances(mem, rtol, atol); if (check_flag(&flag, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); webdata->ida_mem = mem; /* Call IDASpgmr to specify the IDA linear solver IDASPGMR and specify the preconditioner routines supplied (Precondbd and PSolvebd). maxl (max. Krylov subspace dim.) is set to 16. */ maxl = 16; flag = IDASpgmr(mem, maxl); if (check_flag(&flag, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); flag = IDASpilsSetPreconditioner(mem, Precondbd, PSolvebd); if (check_flag(&flag, "IDASpilsSetPreconditioner", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if (check_flag(&flag, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, rtol, atol); PrintOutput(mem, cc, t0, webdata, comm); /* Loop over iout, call IDASolve (normal mode), print selected output. */ for (iout = 1; iout <= NOUT; iout++) { flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if (check_flag(&flag, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, cc, tret, webdata, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* On PE 0, print final set of statistics. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory. */ N_VDestroy_Parallel(cc); N_VDestroy_Parallel(cp); N_VDestroy_Parallel(id); IDAFree(&mem); FreeUserData(webdata); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * AllocUserData: Allocate memory for data structure of type UserData. */ static UserData AllocUserData(MPI_Comm comm, long int local_N, long int SystemSize) { int ix, jy; UserData webdata; webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize); for (ix = 0; ix < MXSUB; ix++) { for (jy = 0; jy < MYSUB; jy++) { (webdata->PP)[ix][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (webdata->pivot)[ix][jy] = newLintArray(NUM_SPECIES); } } webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); webdata->ewt = N_VNew_Parallel(comm, local_N, SystemSize); return(webdata); } /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2, **acoef, *bcoef, *cox, *coy; webdata->jysub = thispe / NPEX; webdata->ixsub = thispe - (webdata->jysub)*NPEX; webdata->mxsub = MXSUB; webdata->mysub = MYSUB; webdata->npex = NPEX; webdata->npey = NPEY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->thispe = thispe; webdata->npes = npes; webdata->nsmxsub = MXSUB * NUM_SPECIES; webdata->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; webdata->comm = comm; /* Set up the coefficients a and b plus others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); acoef = webdata->acoef; bcoef = webdata->bcoef; cox = webdata->cox; coy = webdata->coy; for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * FreeUserData: Free webdata memory. */ static void FreeUserData(UserData webdata) { int ix, jy; for (ix = 0; ix < MXSUB; ix++) { for (jy = 0; jy < MYSUB; jy++) { destroyMat((webdata->PP)[ix][jy]); destroyArray((webdata->pivot)[ix][jy]); } } destroyMat(webdata->acoef); N_VDestroy_Parallel(webdata->rates); N_VDestroy_Parallel(webdata->ewt); free(webdata); } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector res, UserData webdata) { int ixsub, jysub, mxsub, mysub, nsmxsub, np, ix, jy, is; realtype *cxy, *idxy, *cpxy, dx, dy, xx, yy, xyfactor; ixsub = webdata->ixsub; jysub = webdata->jysub; mxsub = webdata->mxsub; mysub = webdata->mxsub; nsmxsub = webdata->nsmxsub; dx = webdata->dx; dy = webdata->dy; np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix + ixsub*mxsub) * dx; xyfactor = RCONST(16.0)*xx*(ONE - xx)*yy*(ONE - yy); xyfactor *= xyfactor; cxy = IJ_Vptr(cc,ix,jy); idxy = IJ_Vptr(id,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) { cxy[is] = RCONST(10.0) + (realtype)(is+1)*xyfactor; idxy[is] = ONE; } else { cxy[is] = 1.0e5; idxy[is] = ZERO; } } } } /* Set c' for the prey by calling the residual function with cp = 0. */ N_VConst(ZERO, cp); resweb(ZERO, cc, cp, res, webdata); N_VScale(-ONE, res, cp); /* Set c' for predators to 0. */ for (jy = 0; jy < mysub; jy++) { for (ix = 0; ix < mxsub; ix++) { cpxy = IJ_Vptr(cp,ix,jy); for (is = np; is < NUM_SPECIES; is++) cpxy[is] = ZERO; } } } /* * Print first lines of output (problem description) */ static void PrintHeader(long int SystemSize, int maxl, realtype rtol, realtype atol) { printf("\nidaFoodWeb_kry_p: Predator-prey DAE parallel example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n",SystemSize); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDASPGMR Max. Krylov dimension maxl: %d\n", maxl); printf("Preconditioner: block diagonal, block size ns,"); printf(" via difference quotients\n"); printf("CalcIC called to correct initial predator concentrations \n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of c1 and c2 * are printed for the bottom left and top right grid points only. * (NOTE: This routine is specific to the case NUM_SPECIES = 2.) */ static void PrintOutput(void *mem, N_Vector cc, realtype tt, UserData webdata, MPI_Comm comm) { MPI_Status status; realtype *cdata, clast[2], hused; long int nst; int i, kused, flag, thispe, npelast, ilast;; thispe = webdata->thispe; npelast = webdata->npes - 1; cdata = NV_DATA_P(cc); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { int flag; UserData webdata; webdata = (UserData)user_data; /* Call rescomm to do inter-processor communication. */ flag = rescomm(cc, cp, webdata); /* Call reslocal to calculate the local portion of residual vector. */ flag = reslocal(tt, cc, cp, res, webdata); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the cc vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(N_Vector cc, N_Vector cp, void *user_data) { UserData webdata; realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; webdata = (UserData) user_data; cdata = NV_DATA_P(cc); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = webdata->comm; thispe = webdata->thispe; ixsub = webdata->ixsub; jysub = webdata->jysub; cext = webdata->cext; nsmxsub = webdata->nsmxsub; nsmysub = (webdata->ns)*(webdata->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, cext, buffer); return(0); } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of cc from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of cc. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of cc. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of cc (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of cc (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (webdata->mxsub) #define mysub (webdata->mysub) #define npex (webdata->npex) #define npey (webdata->npey) #define ixsub (webdata->ixsub) #define jysub (webdata->jysub) #define nsmxsub (webdata->nsmxsub) #define nsmxsub2 (webdata->nsmxsub2) #define np (webdata->np) #define dx (webdata->dx) #define dy (webdata->dy) #define cox (webdata->cox) #define coy (webdata->coy) #define rhs (webdata->rhs) #define cext (webdata->cext) #define rates (webdata->rates) #define ns (webdata->ns) #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) /* * reslocal: Compute res = F(t,cc,cp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the cc vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector webdata->rates * for use by the preconditioner setup routine. */ static int reslocal(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { realtype *cdata, *ratesxy, *cpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui; int ix, jy, is, i, locc, ylocce, locce; UserData webdata; webdata = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ cdata = NV_DATA_P(cc); /* Copy local segment of cc vector into the working extended array cext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext. */ /* If jysub = 0, copy x-line 2 of cc to cext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of cc to cext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of cc to cext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of cc to cext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set res values appropriately for prey/predator components of F. */ for (jy = 0; jy < mysub; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ratesxy = IJ_Vptr(rates,ix,jy); WebRates(xx, yy, &(cext[locce]), ratesxy, webdata); resxy = IJ_Vptr(res,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = cext[locce+is] - cext[locce+is-nsmxsub2]; dcyui = cext[locce+is+nsmxsub2] - cext[locce+is]; dcxli = cext[locce+is] - cext[locce+is-NUM_SPECIES]; dcxui = cext[locce+is+NUM_SPECIES] - cext[locce+is]; rhs[is] = cox[is]*(dcxui-dcxli) + coy[is]*(dcyui-dcyli) + ratesxy[is]; if (is < np) resxy[is] = cpxy[is] - rhs[is]; else resxy[is] = - rhs[is]; } /* End of is (species) loop. */ } /* End of ix loop. */ } /* End of jy loop. */ return(0); } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(int size, realtype *x1, realtype *x2) { int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } /* * Preconbd: Preconditioner setup routine. * This routine generates and preprocesses the block-diagonal * preconditoner PP. At each spatial point, a block of PP is computed * by way of difference quotients on the reaction rates R. * The base value of R are taken from webdata->rates, as set by webres. * Each block is LU-factored, for later solution of the linear systems. */ static int Precondbd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, realtype cj, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { int flag, thispe; realtype uround; realtype xx, yy, *cxy, *ewtxy, cctemp, **Pxy, *ratesxy, *Pxycol, *cpxy; realtype inc, sqru, fac, perturb_rates[NUM_SPECIES]; int is, js, ix, jy, ret; UserData webdata; void *mem; N_Vector ewt; realtype hh; webdata = (UserData)user_data; uround = UNIT_ROUNDOFF; sqru = SQRT(uround); thispe = webdata->thispe; mem = webdata->ida_mem; ewt = webdata->ewt; flag = IDAGetErrWeights(mem, ewt); check_flag(&flag, "IDAGetErrWeights", 1, thispe); flag = IDAGetCurrentStep(mem, &hh); check_flag(&flag, "IDAGetCurrentStep", 1, thispe); for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix+ ixsub*mxsub)*dx; Pxy = (webdata->PP)[ix][jy]; cxy = IJ_Vptr(cc,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); ewtxy= IJ_Vptr(ewt,ix,jy); ratesxy = IJ_Vptr(rates,ix,jy); for (js = 0; js < ns; js++) { inc = sqru*(MAX(ABS(cxy[js]), MAX(hh*ABS(cpxy[js]), ONE/ewtxy[js]))); cctemp = cxy[js]; /* Save the (js,ix,jy) element of cc. */ cxy[js] += inc; /* Perturb the (js,ix,jy) element of cc. */ fac = -ONE/inc; WebRates(xx, yy, cxy, perturb_rates, webdata); Pxycol = Pxy[js]; for (is = 0; is < ns; is++) Pxycol[is] = (perturb_rates[is] - ratesxy[is])*fac; if (js < np) Pxycol[js] += cj; /* Add partial with respect to cp. */ cxy[js] = cctemp; /* Restore (js,ix,jy) element of cc. */ } /* End of js loop. */ /* Do LU decomposition of matrix block for grid point (ix,jy). */ ret = denseGETRF(Pxy, ns, ns, (webdata->pivot)[ix][jy]); if (ret != 0) return(1); } /* End of ix loop. */ } /* End of jy loop. */ return(0); } /* * PSolvebd: Preconditioner solve routine. * This routine applies the LU factorization of the blocks of the * preconditioner PP, to compute the solution of PP * zvec = rvec. */ static int PSolvebd(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype cj, realtype delta, void *user_data, N_Vector tempv) { realtype **Pxy, *zxy; long int *pivot, ix, jy; UserData webdata; webdata = (UserData)user_data; N_VScale(ONE, rvec, zvec); /* Loop through subgrid and apply preconditioner factors at each point. */ for (ix = 0; ix < mxsub; ix++) { for (jy = 0; jy < mysub; jy++) { /* For grid point (ix,jy), do backsolve on local vector. zxy is the address of the local portion of zvec, and Pxy is the address of the corresponding block of PP. */ zxy = IJ_Vptr(zvec,ix,jy); Pxy = (webdata->PP)[ix][jy]; pivot = (webdata->pivot)[ix][jy]; denseGETRS(Pxy, ns, pivot, zxy); } /* End of jy loop. */ } /* End of ix loop. */ return(0); } sundials-2.5.0/examples/ida/parallel/idaFoodWeb_kry_bbd_p.out0000600000175000017500000000353311741421215025132 0ustar sylvestresylvestre idaFoodWeb_kry_bbd_p: Predator-prey DAE parallel example problem Number of species ns: 2 Mesh dimensions: 20 x 20 Total system size: 800 Subgrid dimensions: 10 x 10 Processor array: 2 x 2 Tolerance parameters: relative tolerance = 1e-05 absolute tolerance = 1e-05 Linear solver: scaled preconditioned GMRES (IDASPGMR) max. Krylov dimension: maxl = 16 Preconditioner: band-block-diagonal (IDABBDPRE) mudq = 20, mldq = 20, mukeep = 2, mlkeep = 2 CalcIC called to correct initial predator concentrations ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+01 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0827e+01 | 33 4 9.7404e-05 1.0319e+05 1.0822e+05 | 1.00e-02 1.6189e+02 1.9735e+02 | 123 3 1.9481e-04 1.6189e+06 1.9735e+06 | 1.00e-01 2.4019e+02 2.7072e+02 | 197 1 4.0396e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+02 | 200 1 3.2316e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+02 | 200 1 3.2316e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+02 | 201 1 6.4633e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final statistics: Number of steps = 201 Number of residual evaluations = 1110 Number of nonlinear iterations = 245 Number of error test failures = 0 Number of nonlinear conv. failures = 0 Number of linear iterations = 863 Number of linear conv. failures = 0 Number of preconditioner setups = 26 Number of preconditioner solves = 1110 Number of local residual evals. = 1092 sundials-2.5.0/examples/ida/parallel/idaHeat2D_kry_p.out0000600000175000017500000000326311741421215024045 0ustar sylvestresylvestre idaHeat2D_kry_p: Heat equation, parallel example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Subgrid dimensions: 5 x 5 Processor array: 2 x 2 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. SUPPRESSALG = TRUE to suppress local error testing on all boundary components. Linear solver: IDASPGMR Preconditioner: diagonal elements only. Output Summary (umax = max-norm of solution) time umax k nst nni nli nre nreLS h npe nps ---------------------------------------------------------------------- 0.00 9.75461e-01 0 0 0 0 0 0 0.00e+00 0 0 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 5.54028e-21 1 39 51 77 51 77 1.05e-01 12 128 1.28 3.85107e-20 1 41 53 77 53 77 4.21e-01 14 130 2.56 5.00523e-20 1 43 55 77 55 77 1.69e+00 16 132 5.12 1.50906e-19 1 44 56 77 56 77 3.37e+00 17 133 10.24 4.63224e-19 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/ida/parallel/idaHeat2D_kry_bbd_p.c0000600000175000017500000006437611741421215024303 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 23:03:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, parallel, GMRES, * IDABBDPRE. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr and BBD * preconditioning. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform MX x MY * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = MX * MY. Here MX = MY = 10. * * The system is actually implemented on submeshes, processor by * processor, with an MXSUB by MYSUB mesh on each of NPEX * NPEY * processors. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR in conjunction with the preconditioner module IDABBDPRE. * The preconditioner uses a tridiagonal approximation * (half-bandwidths = 1). The constraints u >= 0 are posed for all * components. Local error testing on the boundary values is * suppressed. Output is taken at t = 0, .01, .02, .04, ..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NOUT 11 /* Number of output times */ #define NPEX 2 /* No. PEs in x direction of PE array */ #define NPEY 2 /* No. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* No. x points per subgrid */ #define MYSUB 5 /* No. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ typedef struct { int thispe, mx, my, ixsub, jysub, npex, npey, mxsub, mysub; long int n_local; realtype dx, dy, coeffx, coeffy, coeffxy; realtype uext[(MXSUB+2)*(MYSUB+2)]; MPI_Comm comm; } *UserData; /* Prototypes of user-supplied and supporting functions */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data); static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data); static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]); static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]); static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]); /* Prototypes of private functions */ static int InitUserData(int thispe, MPI_Comm comm, UserData data); static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data); static void PrintHeader(long int Neq, realtype rtol, realtype atol); static void PrintCase(int case_number, int mudq, int mukeep); static void PrintOutput(int id, void *mem, realtype t, N_Vector uu); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData data; int thispe, iout, ier, npes; long int Neq, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, t1, tout, tret; N_Vector uu, up, constraints, id, res; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Get processor number and total number of pe's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &thispe); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length local_N and global length Neq. */ local_N = MXSUB*MYSUB; Neq = MX * MY; /* Allocate N-vectors. */ uu = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); up = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, Neq); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); /* Allocate and initialize the data structure. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1); InitUserData(thispe, comm, data); /* Initialize the uu, up, id, and constraints profiles. */ SetInitialProfile(uu, up, id, res, data); N_VConst(ONE, constraints); t0 = ZERO; t1 = RCONST(0.01); /* Scalar relative and absolute tolerance. */ rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetSuppressAlg(mem, TRUE); if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1); N_VDestroy_Parallel(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); mudq = MXSUB; mldq = MXSUB; mukeep = 1; mlkeep = 1; /* Print problem description */ if (thispe == 0 ) PrintHeader(Neq, rtol, atol); /* * ----------------------------- * Case 1 -- mldq = mudq = MXSUB * ----------------------------- */ /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize BBD preconditioner. */ ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&ier, "IDABBDPrecAlloc", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only) and initial solution. */ if (thispe == 0) PrintCase(1, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* * ----------------------------- * Case 2 -- mldq = mudq = 1 * ----------------------------- */ mudq = 1; mldq = 1; /* Re-initialize the uu and up profiles. */ SetInitialProfile(uu, up, id, res, data); /* Call IDAReInit to re-initialize IDA. */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecReInit to re-initialize BBD preconditioner. */ ier = IDABBDPrecReInit(mem, mudq, mldq, ZERO); if(check_flag(&ier, "IDABBDPrecReInit", 1, thispe)) MPI_Abort(comm, 1); /* Print output heading (on processor 0 only). */ if (thispe == 0) PrintCase(2, mudq, mukeep); /* Loop over tout, call IDASolve, print output. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(thispe, mem, tret, uu); } /* Print final statistics */ if (thispe == 0) PrintFinalStats(mem); /* Free Memory */ IDAFree(&mem); free(data); N_VDestroy_Parallel(id); N_VDestroy_Parallel(res); N_VDestroy_Parallel(up); N_VDestroy_Parallel(uu); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * heatres: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. * * This parallel implementation uses several supporting routines. * First a call is made to rescomm to do communication of subgrid boundary * data into array uext. Then reslocal is called to compute the residual * on individual processors and their corresponding domains. The routines * BSend, BRecvPost, and BREcvWait handle interprocessor communication * of uu required to calculate the residual. */ static int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { int retval; UserData data; long int Nlocal; data = (UserData) user_data; Nlocal = data->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tres, uu, up, data); /* Call reslocal to calculate res. */ retval = reslocal(Nlocal, tres, uu, up, res, data); return(0); } /* * rescomm routine. This routine performs all inter-processor * communication of data in u needed to calculate G. */ static int rescomm(long int Nlocal, realtype tt, N_Vector uu, N_Vector up, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*MYSUB]; MPI_Comm comm; int thispe, ixsub, jysub, mxsub, mysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(uu); /* Get comm, thispe, subgrid indices, data sizes, extended array uext. */ comm = data->comm; thispe = data->thispe; ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mysub = data->mysub; uext = data->uext; /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, mxsub, mysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, mxsub, mysub, uarray); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, mxsub, uext, buffer); return(0); } /* * reslocal routine. Compute res = F(t, uu, up). This routine assumes * that all inter-processor communication of data needed to calculate F * has already been done, and that this data is in the work array uext. */ static int reslocal(long int Nlocal, realtype tres, N_Vector uu, N_Vector up, N_Vector res, void *user_data) { realtype *uext, *uuv, *upv, *resv; realtype termx, termy, termctr; int lx, ly, offsetu, offsetue, locu, locue; int ixsub, jysub, mxsub, mxsub2, mysub, npex, npey; int ixbegin, ixend, jybegin, jyend; UserData data; /* Get subgrid indices, array sizes, extended work array uext. */ data = (UserData) user_data; uext = data->uext; uuv = NV_DATA_P(uu); upv = NV_DATA_P(up); resv = NV_DATA_P(res); ixsub = data->ixsub; jysub = data->jysub; mxsub = data->mxsub; mxsub2 = data->mxsub + 2; mysub = data->mysub; npex = data->npex; npey = data->npey; /* Initialize all elements of res to uu. This sets the boundary elements simply without indexing hassles. */ N_VScale(ONE, uu, res); /* Copy local segment of u vector into the working extended array uext. This completes uext prior to the computation of the res vector. */ offsetu = 0; offsetue = mxsub2 + 1; for (ly = 0; ly < mysub; ly++) { for (lx = 0; lx < mxsub; lx++) uext[offsetue+lx] = uuv[offsetu+lx]; offsetu = offsetu + mxsub; offsetue = offsetue + mxsub2; } /* Set loop limits for the interior of the local subgrid. */ ixbegin = 0; ixend = mxsub-1; jybegin = 0; jyend = mysub-1; if (ixsub == 0) ixbegin++; if (ixsub == npex-1) ixend--; if (jysub == 0) jybegin++; if (jysub == npey-1) jyend--; /* Loop over all grid points in local subgrid. */ for (ly = jybegin; ly <=jyend; ly++) { for (lx = ixbegin; lx <= ixend; lx++) { locu = lx + ly*mxsub; locue = (lx+1) + (ly+1)*mxsub2; termx = data->coeffx *(uext[locue-1] + uext[locue+1]); termy = data->coeffy *(uext[locue-mxsub2] + uext[locue+mxsub2]); termctr = data->coeffxy*uext[locue]; resv[locu] = upv[locu] - (termx + termy - termctr); } } return(0); } /* * Routine to send boundary data to neighboring PEs. */ static int BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uarray[]) { int ly, offsetu; realtype bufleft[MYSUB], bufright[MYSUB]; /* If jysub > 0, send data from bottom x-line of u. */ if (jysub != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of u. */ if (jysub != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of u (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*dsizex; bufleft[ly] = uarray[offsetu]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of u (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*MXSUB + (MXSUB-1); bufright[ly] = uarray[offsetu]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm); } return(0); } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in * both calls also. */ static int BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype uext[], realtype buffer[]) { int offsetue; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+MYSUB; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Irecv(&uext[1], dsizex, PVEC_REAL_MPI_TYPE, thispe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) { offsetue = (1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, thispe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, thispe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, thispe+1, 0, comm, &request[3]); } return(0); } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have four entries, and should be passed in both * calls also. */ static int BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype uext[], realtype buffer[]) { int ly, dsizex2, offsetue; realtype *bufleft = buffer, *bufright = buffer+MYSUB; MPI_Status status; dsizex2 = dsizex + 2; /* If jysub > 0, receive data for bottom x-line of uext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of uext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of uext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext. */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+1)*dsizex2; uext[offsetue] = bufleft[ly]; } } /* If ixsub < NPEX-1, receive data for right y-line of uext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetue = (ly+2)*dsizex2 - 1; uext[offsetue] = bufright[ly]; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData initializes the user's data block data. */ static int InitUserData(int thispe, MPI_Comm comm, UserData data) { data->thispe = thispe; data->dx = ONE/(MX-ONE); /* Assumes a [0,1] interval in x. */ data->dy = ONE/(MY-ONE); /* Assumes a [0,1] interval in y. */ data->coeffx = ONE/(data->dx * data->dx); data->coeffy = ONE/(data->dy * data->dy); data->coeffxy = TWO/(data->dx * data->dx) + TWO/(data->dy * data->dy) ; data->jysub = thispe/NPEX; data->ixsub = thispe - data->jysub * NPEX; data->npex = NPEX; data->npey = NPEY; data->mx = MX; data->my = MY; data->mxsub = MXSUB; data->mysub = MYSUB; data->comm = comm; data->n_local = MXSUB*MYSUB; return(0); } /* * SetInitialProfile sets the initial values for the problem. */ static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id, N_Vector res, UserData data) { int i, iloc, j, jloc, offset, loc, ixsub, jysub; int ixbegin, ixend, jybegin, jyend; realtype xfact, yfact, *udata, *iddata, dx, dy; /* Initialize uu. */ udata = NV_DATA_P(uu); iddata = NV_DATA_P(id); /* Set mesh spacings and subgrid indices for this PE. */ dx = data->dx; dy = data->dy; ixsub = data->ixsub; jysub = data->jysub; /* Set beginning and ending locations in the global array corresponding to the portion of that array assigned to this processor. */ ixbegin = MXSUB*ixsub; ixend = MXSUB*(ixsub+1) - 1; jybegin = MYSUB*jysub; jyend = MYSUB*(jysub+1) - 1; /* Loop over the local array, computing the initial profile value. The global indices are (i,j) and the local indices are (iloc,jloc). Also set the id vector to zero for boundary points, one otherwise. */ N_VConst(ONE,id); for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) { yfact = data->dy*j; offset= jloc*MXSUB; for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) { xfact = data->dx * i; loc = offset + iloc; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO; } } /* Initialize up. */ N_VConst(ZERO, up); /* Initially set up = 0. */ /* heatres sets res to negative of ODE RHS values at interior points. */ heatres(ZERO, uu, up, res, data); /* Copy -res into up to get correct initial up values. */ N_VScale(-ONE, res, up); return(0); } /* * Print first lines of output (problem description) * and table heading */ static void PrintHeader(long int Neq, realtype rtol, realtype atol) { printf("\nidaHeat2D_kry_bbd_p: Heat equation, parallel example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n\n", Neq); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("SUPPRESSALG = TRUE to suppress local error testing on"); printf(" all boundary components. \n"); printf("Linear solver: IDASPGMR. "); printf("Preconditioner: IDABBDPRE - Banded-block-diagonal.\n"); } /* * Print case and table header */ static void PrintCase(int case_number, int mudq, int mukeep) { printf("\n\nCase %1d. \n", case_number); printf(" Difference quotient half-bandwidths = %d",mudq); printf(" Retained matrix half-bandwidths = %d \n",mukeep); /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nli nre nreLS nge h npe nps\n"); printf(" . . . . . . . . . . . . . . . . . . . . . . . .\n"); } /* * Print integrator statistics and max-norm of solution */ static void PrintOutput(int id, void *mem, realtype t, N_Vector uu) { realtype umax, hused; int kused, ier; long int nst, nni, nre, nli, npe, nps, nreLS, nge; umax = N_VMaxNorm(uu); if (id == 0) { ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1, id); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1, id); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1, id); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1, id); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1, id); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1, id); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1, id); ier = IDABBDPrecGetNumGfnEvals(mem, &nge); check_flag(&ier, "IDABBDPrecGetNumGfnEvals", 1, id); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1, id); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1, id); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nli, nre, nreLS, nge, hused, npe, nps); #endif } } /* * Print some final integrator statistics */ static void PrintFinalStats(void *mem) { long int netf, ncfn, ncfl; IDAGetNumErrTestFails(mem, &netf); IDAGetNumNonlinSolvConvFails(mem, &ncfn); IDASpilsGetNumConvFails(mem, &ncfl); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/parallel/idaFoodWeb_kry_bbd_p.c0000600000175000017500000010775411741421215024557 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 23:03:29 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web, parallel, GMRES, IDABBD * preconditioner. * * This example program for IDA uses IDASPGMR as the linear solver. * It is written for a parallel computer system and uses the * IDABBDPRE band-block-diagonal preconditioner module for the * IDASPGMR package. It was originally run on a Sun SPARC cluster * and used MPICH. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * Note: The above equations are written in 1-based indices, * whereas the code has 0-based indices, being written in C. * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh, and so the system size Neq is the product * MX * MY * NUM_SPECIES. The system is actually implemented on * submeshes, processor by processor, with an MXSUB by MYSUB mesh * on each of NPEX * NPEY processors. * * The DAE system is solved by IDA using the IDASPGMR linear solver, * in conjunction with the preconditioner module IDABBDPRE. The * preconditioner uses a 5-diagonal band-block-diagonal * approximation (half-bandwidths = 2). Output is printed at * t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Journal of Applied Mathematics and Computation, Vol. 31 * (May 1989), pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NPREY 1 /* Number of prey (= number of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) /* pi */ #define FOURPI (RCONST(4.0)*PI) /* 4 pi */ #define MXSUB 10 /* Number of x mesh points per processor subgrid */ #define MYSUB 10 /* Number of y mesh points per processor subgrid */ #define NPEX 2 /* Number of subgrids in the x direction */ #define NPEY 2 /* Number of subgrids in the y direction */ #define MX (MXSUB*NPEX) /* MX = number of x mesh points */ #define MY (MYSUB*NPEY) /* MY = number of y mesh points */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NEQ (NUM_SPECIES*MX*MY) /* Number of equations in system */ #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* rtol tolerance */ #define ATOL RCONST(1.e-5) /* atol tolerance */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define NOUT 6 #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ /* User-defined vector accessor macro IJ_Vptr. */ /* * IJ_Vptr is defined in order to express the underlying 3-d structure of the * dependent variable vector from its underlying 1-d storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, (i)*NUM_SPECIES + (j)*NSMXSUB )) /* Type: UserData. Contains problem constants, preconditioner data, etc. */ typedef struct { int ns, np, thispe, npes, ixsub, jysub, npex, npey; int mxsub, mysub, nsmxsub, nsmxsub2; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES], rhs[NUM_SPECIES], cext[(MXSUB+2)*(MYSUB+2)*NUM_SPECIES]; MPI_Comm comm; N_Vector rates; long int n_local; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data); static int reslocal(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data); static int rescomm(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, void *user_data); /* Prototypes for supporting functions */ static void BSend(MPI_Comm comm, int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype carray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int thispe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(int size, realtype *x1, realtype *x2); /* Prototypes for private functions */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector scrtch, UserData webdata); static void PrintHeader(long int SystemSize, int maxl, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector cc, realtype time, UserData webdata, MPI_Comm comm); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *mem; UserData webdata; long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep; realtype rtol, atol, t0, tout, tret; N_Vector cc, cp, res, id; int thispe, npes, maxl, iout, retval; cc = cp = res = id = NULL; webdata = NULL; mem = NULL; /* Set communicator, and get processor number and total number of PE's. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_rank(comm, &thispe); MPI_Comm_size(comm, &npes); if (npes != NPEX*NPEY) { if (thispe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length (local_N) and global length (SystemSize). */ local_N = MXSUB*MYSUB*NUM_SPECIES; SystemSize = NEQ; /* Set up user data block webdata. */ webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize); webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); InitUserData(webdata, thispe, npes, comm); /* Create needed vectors, and load initial values. The vector res is used temporarily only. */ cc = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); cp = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); res = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); id = N_VNew_Parallel(comm, local_N, SystemSize); if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1); SetInitialProfiles(cc, cp, id, res, webdata); N_VDestroy_Parallel(res); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1); retval = IDASetUserData(mem, webdata); if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1); retval = IDAInit(mem, resweb, t0, cc, cp); if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1); /* Call IDASpgmr to specify the IDA linear solver IDASPGMR */ maxl = 16; retval = IDASpgmr(mem, maxl); if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1); /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner. The half-bandwidths for the difference quotient evaluation are exact for the system Jacobian, but only a 5-diagonal band matrix is retained. */ mudq = mldq = NSMXSUB; mukeep = mlkeep = 2; retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, reslocal, NULL); if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1); /* On PE 0, print heading, basic parameters, initial values. */ if (thispe == 0) PrintHeader(SystemSize, maxl, mudq, mldq, mukeep, mlkeep, rtol, atol); PrintOutput(mem, cc, t0, webdata, comm); /* Call IDA in tout loop, normal mode, and print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1); PrintOutput(mem, cc, tret, webdata, comm); if (iout < 3) tout *= TMULT; else tout += TADD; } /* On PE 0, print final set of statistics. */ if (thispe == 0) PrintFinalStats(mem); /* Free memory. */ N_VDestroy_Parallel(cc); N_VDestroy_Parallel(cp); N_VDestroy_Parallel(id); IDAFree(&mem); destroyMat(webdata->acoef); N_VDestroy_Parallel(webdata->rates); free(webdata); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata, int thispe, int npes, MPI_Comm comm) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2, **acoef, *bcoef, *cox, *coy; webdata->jysub = thispe / NPEX; webdata->ixsub = thispe - (webdata->jysub)*NPEX; webdata->mxsub = MXSUB; webdata->mysub = MYSUB; webdata->npex = NPEX; webdata->npey = NPEY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->thispe = thispe; webdata->npes = npes; webdata->nsmxsub = MXSUB * NUM_SPECIES; webdata->nsmxsub2 = (MXSUB+2)*NUM_SPECIES; webdata->comm = comm; webdata->n_local = MXSUB*MYSUB*NUM_SPECIES; /* Set up the coefficients a and b plus others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); acoef = webdata->acoef; bcoef = webdata->bcoef; cox = webdata->cox; coy = webdata->coy; for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, N_Vector res, UserData webdata) { int ixsub, jysub, mxsub, mysub, nsmxsub, np, ix, jy, is; realtype *cxy, *idxy, *cpxy, dx, dy, xx, yy, xyfactor; ixsub = webdata->ixsub; jysub = webdata->jysub; mxsub = webdata->mxsub; mysub = webdata->mxsub; nsmxsub = webdata->nsmxsub; dx = webdata->dx; dy = webdata->dy; np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < mysub; jy++) { yy = (jy + jysub*mysub) * dy; for (ix = 0; ix < mxsub; ix++) { xx = (ix + ixsub*mxsub) * dx; xyfactor = 16.*xx*(1. - xx)*yy*(1. - yy); xyfactor *= xyfactor; cxy = IJ_Vptr(cc,ix,jy); idxy = IJ_Vptr(id,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) {cxy[is] = RCONST(10.0)+(realtype)(is+1)*xyfactor; idxy[is] = ONE;} else { cxy[is] = 1.0e5; idxy[is] = ZERO; } } } } /* Set c' for the prey by calling the residual function with cp = 0. */ N_VConst(ZERO, cp); resweb(ZERO, cc, cp, res, webdata); N_VScale(-ONE, res, cp); /* Set c' for predators to 0. */ for (jy = 0; jy < mysub; jy++) { for (ix = 0; ix < mxsub; ix++) { cpxy = IJ_Vptr(cp,ix,jy); for (is = np; is < NUM_SPECIES; is++) cpxy[is] = ZERO; } } } /* * Print first lines of output (problem description) * and table headerr */ static void PrintHeader(long int SystemSize, int maxl, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype rtol, realtype atol) { printf("\nidaFoodWeb_kry_bbd_p: Predator-prey DAE parallel example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" Total system size: %d\n",SystemSize); printf("Subgrid dimensions: %d x %d", MXSUB, MYSUB); printf(" Processor array: %d x %d\n", NPEX, NPEY); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDASPGMR Max. Krylov dimension maxl: %d\n", maxl); printf("Preconditioner: band-block-diagonal (IDABBDPRE), with parameters\n"); printf(" mudq = %d, mldq = %d, mukeep = %d, mlkeep = %d\n", mudq, mldq, mukeep, mlkeep); printf("CalcIC called to correct initial predator concentrations \n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of c1 and c2 * are printed for the bottom left and top right grid points only. */ static void PrintOutput(void *mem, N_Vector cc, realtype tt, UserData webdata, MPI_Comm comm) { MPI_Status status; realtype *cdata, clast[2], hused; long int nst; int i, kused, flag, thispe, npelast, ilast;; thispe = webdata->thispe; npelast = webdata->npes - 1; cdata = NV_DATA_P(cc); /* Send conc. at top right mesh point from PE npes-1 to PE 0. */ if (thispe == npelast) { ilast = NUM_SPECIES*MXSUB*MYSUB - 2; if (npelast != 0) MPI_Send(&cdata[ilast], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { clast[0] = cdata[ilast]; clast[1] = cdata[ilast+1]; } } /* On PE 0, receive conc. at top right from PE npes - 1. Then print performance data and sampled solution values. */ if (thispe == 0) { if (npelast != 0) MPI_Recv(&clast[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1, thispe); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1, thispe); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1, thispe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", tt, cdata[0], clast[0], nst, kused, hused); for (i=1;i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA & SUPPORTING FUNCTIONS *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * To compute the residual function F, this routine calls: * rescomm, for needed communication, and then * reslocal, for computation of the residuals on this processor. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data) { int retval; UserData webdata; long int Nlocal; webdata = (UserData) user_data; Nlocal = webdata->n_local; /* Call rescomm to do inter-processor communication. */ retval = rescomm(Nlocal, tt, cc, cp, user_data); /* Call reslocal to calculate the local portion of residual vector. */ retval = reslocal(Nlocal, tt, cc, cp, rr, user_data); return(0); } /* * rescomm: Communication routine in support of resweb. * This routine performs all inter-processor communication of components * of the cc vector needed to calculate F, namely the components at all * interior subgrid boundaries (ghost cell data). It loads this data * into a work array cext (the local portion of c, extended). * The message-passing uses blocking sends, non-blocking receives, * and receive-waiting, in routines BRecvPost, BSend, BRecvWait. */ static int rescomm(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, void *user_data) { UserData webdata; realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB]; int thispe, ixsub, jysub, nsmxsub, nsmysub; MPI_Comm comm; MPI_Request request[4]; webdata = (UserData) user_data; cdata = NV_DATA_P(cc); /* Get comm, thispe, subgrid indices, data sizes, extended array cext. */ comm = webdata->comm; thispe = webdata->thispe; ixsub = webdata->ixsub; jysub = webdata->jysub; cext = webdata->cext; nsmxsub = webdata->nsmxsub; nsmysub = (webdata->ns)*(webdata->mysub); /* Start receiving boundary data from neighboring PEs. */ BRecvPost(comm, request, thispe, ixsub, jysub, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs. */ BSend(comm, thispe, ixsub, jysub, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs. */ BRecvWait(request, ixsub, jysub, nsmxsub, cext, buffer); return(0); } /* * BRecvPost: Start receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cext[], realtype buffer[]) { int offsetce; /* Have bufleft and bufright use the same buffer. */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * BRecvWait: Finish receiving boundary data from neighboring PEs. * (1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * (2) request should have 4 entries, and is also passed in both calls. */ static void BRecvWait(MPI_Request request[], int ixsub, int jysub, int dsizex, realtype cext[], realtype buffer[]) { int i; int ly, dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If jysub > 0, receive data for bottom x-line of cext. */ if (jysub != 0) MPI_Wait(&request[0],&status); /* If jysub < NPEY-1, receive data for top x-line of cext. */ if (jysub != NPEY-1) MPI_Wait(&request[1],&status); /* If ixsub > 0, receive data for left y-line of cext (via bufleft). */ if (ixsub != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If ixsub < NPEX-1, receive data for right y-line of cext (via bufright). */ if (ixsub != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * BSend: Send boundary data to neighboring PEs. * This routine sends components of cc from internal subgrid boundaries * to the appropriate neighbor PEs. */ static void BSend(MPI_Comm comm, int my_pe, int ixsub, int jysub, int dsizex, int dsizey, realtype cdata[]) { int i; int ly, offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If jysub > 0, send data from bottom x-line of cc. */ if (jysub != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If jysub < NPEY-1, send data from top x-line of cc. */ if (jysub != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If ixsub > 0, send data from left y-line of cc (via bufleft). */ if (ixsub != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If ixsub < NPEX-1, send data from right y-line of cc (via bufright). */ if (ixsub != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Define lines are for ease of readability in the following functions. */ #define mxsub (webdata->mxsub) #define mysub (webdata->mysub) #define npex (webdata->npex) #define npey (webdata->npey) #define ixsub (webdata->ixsub) #define jysub (webdata->jysub) #define nsmxsub (webdata->nsmxsub) #define nsmxsub2 (webdata->nsmxsub2) #define np (webdata->np) #define dx (webdata->dx) #define dy (webdata->dy) #define cox (webdata->cox) #define coy (webdata->coy) #define rhs (webdata->rhs) #define cext (webdata->cext) #define rates (webdata->rates) #define ns (webdata->ns) #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) /* * reslocal: Compute res = F(t,cc,cp). * This routine assumes that all inter-processor communication of data * needed to calculate F has already been done. Components at interior * subgrid boundaries are assumed to be in the work array cext. * The local portion of the cc vector is first copied into cext. * The exterior Neumann boundary conditions are explicitly handled here * by copying data from the first interior mesh line to the ghost cell * locations in cext. Then the reaction and diffusion terms are * evaluated in terms of the cext array, and the residuals are formed. * The reaction terms are saved separately in the vector webdata->rates * for use by the preconditioner setup routine. */ static int reslocal(long int Nlocal, realtype tt, N_Vector cc, N_Vector cp, N_Vector rr, void *user_data) { realtype *cdata, *ratesxy, *cpxy, *resxy, xx, yy, dcyli, dcyui, dcxli, dcxui; int ix, jy, is, i, locc, ylocce, locce; UserData webdata; webdata = (UserData) user_data; /* Get data pointers, subgrid data, array sizes, work array cext. */ cdata = NV_DATA_P(cc); /* Copy local segment of cc vector into the working extended array cext. */ locc = 0; locce = nsmxsub2 + NUM_SPECIES; for (jy = 0; jy < mysub; jy++) { for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; locc = locc + nsmxsub; locce = locce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext. */ /* If jysub = 0, copy x-line 2 of cc to cext. */ if (jysub == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If jysub = npey-1, copy x-line mysub-1 of cc to cext. */ if (jysub == npey-1) { locc = (mysub-2)*nsmxsub; locce = (mysub+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[locce+i] = cdata[locc+i]; } /* If ixsub = 0, copy y-line 2 of cc to cext. */ if (ixsub == 0) { for (jy = 0; jy < mysub; jy++) { locc = jy*nsmxsub + NUM_SPECIES; locce = (jy+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* If ixsub = npex-1, copy y-line mxsub-1 of cc to cext. */ if (ixsub == npex-1) { for (jy = 0; jy < mysub; jy++) { locc = (jy+1)*nsmxsub - 2*NUM_SPECIES; locce = (jy+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[locce+i] = cdata[locc+i]; } } /* Loop over all grid points, setting local array rates to right-hand sides. Then set rr values appropriately for prey/predator components of F. */ for (jy = 0; jy < mysub; jy++) { ylocce = (jy+1)*nsmxsub2; yy = (jy+jysub*mysub)*dy; for (ix = 0; ix < mxsub; ix++) { locce = ylocce + (ix+1)*NUM_SPECIES; xx = (ix + ixsub*mxsub)*dx; ratesxy = IJ_Vptr(rates,ix,jy); WebRates(xx, yy, &(cext[locce]), ratesxy, webdata); resxy = IJ_Vptr(rr,ix,jy); cpxy = IJ_Vptr(cp,ix,jy); for (is = 0; is < NUM_SPECIES; is++) { dcyli = cext[locce+is] - cext[locce+is-nsmxsub2]; dcyui = cext[locce+is+nsmxsub2] - cext[locce+is]; dcxli = cext[locce+is] - cext[locce+is-NUM_SPECIES]; dcxui = cext[locce+is+NUM_SPECIES] - cext[locce+is]; rhs[is] = cox[is]*(dcxui-dcxli) + coy[is]*(dcyui-dcyli) + ratesxy[is]; if (is < np) resxy[is] = cpxy[is] - rhs[is]; else resxy[is] = - rhs[is]; } } } return(0); } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(int size, realtype *x1, realtype *x2) { int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } sundials-2.5.0/examples/ida/parallel/README0000600000175000017500000000123511741421215021240 0ustar sylvestresylvestreList of parallel IDA examples idaFoodWeb_kry_bbd_p : 2-D food web, BBD preconditioner idaFoodWeb_kry_p : 2-D food web, block-diagonal preconditioner idaHeat2D_kry_bbd_p : 2-D heat equation, BBD preconditioner idaHeat2D_kry_p : 2-D heat equation, diagonal preconditioner Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/ida/parallel/idaFoodWeb_kry_p.out0000600000175000017500000000334311741421215024322 0ustar sylvestresylvestre idaFoodWeb_kry_p: Predator-prey DAE parallel example problem for IDA Number of species ns: 2 Mesh dimensions: 20 x 20 Total system size: 800 Subgrid dimensions: 10 x 10 Processor array: 2 x 2 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDASPGMR Max. Krylov dimension maxl: 16 Preconditioner: block diagonal, block size ns, via difference quotients CalcIC called to correct initial predator concentrations ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+01 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0827e+01 | 33 4 9.7404e-05 1.0319e+05 1.0822e+05 | 1.00e-02 1.6189e+02 1.9735e+02 | 86 4 1.7533e-04 1.6189e+06 1.9735e+06 | 1.00e-01 2.4019e+02 2.7072e+02 | 162 1 4.0396e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+02 | 165 1 3.2316e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+02 | 166 1 6.4633e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+02 | 166 1 6.4633e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final statistics: Number of steps = 166 Number of residual evaluations = 1257 Number of nonlinear iterations = 206 Number of error test failures = 0 Number of nonlinear conv. failures = 0 Number of linear iterations = 1049 Number of linear conv. failures = 0 Number of preconditioner setups = 25 Number of preconditioner solves = 1257 sundials-2.5.0/examples/ida/serial/0000755000175000017500000000000011767174700020066 5ustar sylvestresylvestresundials-2.5.0/examples/ida/serial/idaFoodWeb_bnd.out0000600000175000017500000000273711741421215023432 0ustar sylvestresylvestre idaFoodWeb_bnd: Predator-prey DAE serial example problem for IDA Number of species ns: 2 Mesh dimensions: 20 x 20 System size: 800 Tolerance parameters: rtol = 1e-05 atol = 1e-05 Linear solver: IDABAND, Band parameters mu = 40, ml = 40 CalcIC called to correct initial predator concentrations. ----------------------------------------------------------- t bottom-left top-right | nst k h ----------------------------------------------------------- 0.00e+00 1.0000e+01 1.0000e+05 | 0 0 1.6310e-08 1.0000e+05 1.0000e+05 | 1.00e-03 1.0318e+01 1.0822e+05 | 32 4 1.0823e-04 1.0319e+05 1.0822e+05 | 1.00e-02 1.6188e+02 1.9734e+06 | 127 4 1.4203e-04 1.6189e+06 1.9734e+06 | 1.00e-01 2.4019e+02 2.7072e+06 | 235 1 3.9160e-02 2.4019e+06 2.7072e+06 | 4.00e-01 2.4019e+02 2.7072e+06 | 238 1 3.1328e-01 2.4019e+06 2.7072e+06 | 7.00e-01 2.4019e+02 2.7072e+06 | 239 1 6.2657e-01 2.4019e+06 2.7072e+06 | 1.00e+00 2.4019e+02 2.7072e+06 | 239 1 6.2657e-01 2.4019e+06 2.7072e+06 | ----------------------------------------------------------- Final run statistics: Number of steps = 239 Number of residual evaluations = 3339 Number of Jacobian evaluations = 36 Number of nonlinear iterations = 421 Number of error test failures = 3 Number of nonlinear conv. failures = 0 sundials-2.5.0/examples/ida/serial/idaSlCrank_dns.out0000600000175000017500000000667411741421215023467 0ustar sylvestresylvestre idaSlCrank_dns: Slider-Crank DAE serial example problem for IDAS Linear solver: IDADENSE, Jacobian is computed by IDAS. Tolerance parameters: rtol = 1e-06 atol = 1e-06 ----------------------------------------------------------------------- t y1 y2 y3 | nst k h ----------------------------------------------------------------------- 0.0000e+00 1.5708e+00 8.6603e-01 -5.2360e-01 0 0 0.0000e+00 2.5000e-01 1.5548e+00 8.7406e-01 -5.2352e-01 25 4 6.5436e-02 5.0000e-01 1.5069e+00 8.9855e-01 -5.2242e-01 28 4 6.5436e-02 7.5000e-01 1.4270e+00 9.4063e-01 -5.1765e-01 32 5 6.5436e-02 1.0000e+00 1.3154e+00 1.0015e+00 -5.0497e-01 36 5 6.5436e-02 1.2500e+00 1.1731e+00 1.0811e+00 -4.7909e-01 40 5 6.5436e-02 1.5000e+00 1.0016e+00 1.1765e+00 -4.3472e-01 44 5 5.8893e-02 1.7500e+00 8.0288e-01 1.2804e+00 -3.6792e-01 48 4 5.3003e-02 2.0000e+00 5.7904e-01 1.3803e+00 -2.7715e-01 53 4 4.7703e-02 2.2500e+00 3.3326e-01 1.4590e+00 -1.6430e-01 58 5 4.7703e-02 2.5000e+00 7.2238e-02 1.4980e+00 -3.6096e-02 64 5 4.7703e-02 2.7500e+00 -1.9245e-01 1.4862e+00 9.5777e-02 70 5 3.6885e-02 3.0000e+00 -4.4711e-01 1.4272e+00 2.1790e-01 79 4 2.4398e-02 3.2500e+00 -6.8090e-01 1.3377e+00 3.2019e-01 89 4 2.4398e-02 3.5000e+00 -8.8750e-01 1.2374e+00 3.9819e-01 97 4 4.8796e-02 3.7500e+00 -1.0634e+00 1.1424e+00 4.5228e-01 102 5 4.8796e-02 4.0000e+00 -1.2064e+00 1.0623e+00 4.8609e-01 107 5 4.8796e-02 4.2500e+00 -1.3150e+00 1.0017e+00 5.0491e-01 112 5 4.8796e-02 4.5000e+00 -1.3883e+00 9.6149e-01 5.1404e-01 117 5 4.8796e-02 4.7500e+00 -1.4265e+00 9.4088e-01 5.1761e-01 123 4 4.8796e-02 5.0000e+00 -1.4300e+00 9.3903e-01 5.1790e-01 128 4 4.3916e-02 5.2500e+00 -1.3992e+00 9.5560e-01 5.1514e-01 134 5 4.3916e-02 5.5000e+00 -1.3346e+00 9.9087e-01 5.0765e-01 138 5 8.7832e-02 5.7500e+00 -1.2371e+00 1.0451e+00 4.9204e-01 140 5 8.7832e-02 6.0000e+00 -1.1080e+00 1.1176e+00 4.6386e-01 143 5 7.9049e-02 6.2500e+00 -9.4916e-01 1.2048e+00 4.1858e-01 146 5 7.9049e-02 6.5000e+00 -7.6277e-01 1.2999e+00 3.5273e-01 150 5 6.4030e-02 6.7500e+00 -5.5125e-01 1.3910e+00 2.6497e-01 154 5 6.4030e-02 7.0000e+00 -3.1828e-01 1.4626e+00 1.5711e-01 158 5 5.1864e-02 7.2500e+00 -7.0713e-02 1.4981e+00 3.5334e-02 164 5 4.6678e-02 7.5000e+00 1.8041e-01 1.4879e+00 -8.9839e-02 169 5 4.6678e-02 7.7500e+00 4.2223e-01 1.4349e+00 -2.0636e-01 175 4 3.3481e-02 8.0000e+00 6.4422e-01 1.3536e+00 -3.0500e-01 183 3 3.0133e-02 8.2500e+00 8.3984e-01 1.2619e+00 -3.8145e-01 189 4 5.2811e-02 8.5000e+00 1.0053e+00 1.1745e+00 -4.3582e-01 194 4 5.2811e-02 8.7500e+00 1.1380e+00 1.1008e+00 -4.7113e-01 199 5 5.2811e-02 9.0000e+00 1.2363e+00 1.0456e+00 -4.9189e-01 203 5 5.2811e-02 9.2500e+00 1.2992e+00 1.0105e+00 -5.0257e-01 208 5 5.2811e-02 9.5000e+00 1.3266e+00 9.9533e-01 -5.0655e-01 213 5 5.2811e-02 9.7500e+00 1.3185e+00 9.9977e-01 -5.0542e-01 218 5 5.2811e-02 1.0000e+01 1.2757e+00 1.0236e+00 -4.9881e-01 222 5 5.2811e-02 Final Run Statistics: Number of steps = 222 Number of residual evaluations = 874 Number of Jacobian evaluations = 32 Number of nonlinear iterations = 554 Number of error test failures = 3 Number of nonlinear conv. failures = 0 sundials-2.5.0/examples/ida/serial/idaKrylovDemo_ls.c0000600000175000017500000004254511741421215023467 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:25:59 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * * This example loops through the available iterative linear solvers: * SPGMR, SPBCG and SPTFQMR. * * Example problem for IDA: 2D heat equation, serial, GMRES. * * This example solves a discretized 2D heat equation problem. * This version loops through the Krylov solvers IDASpgmr, IDASpbcg * and IDASptfqmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform M x M grid. * The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the following Krylov * linear solvers: IDASPGMR, IDASPBCG and IDASPTFQMR. The * preconditioner uses the diagonal elements of the Jacobian only. * Routines for preconditioning, required by IDASP*, are supplied * here. The constraints u >= 0 are posed for all components. Output * is taken at t = 0, .01, .02, .04,..., 10.24. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FOUR RCONST(4.0) /* Linear Solver Loop Constants */ #define USE_SPGMR 0 #define USE_SPBCG 1 #define USE_SPTFQMR 2 /* User data type */ typedef struct { long int mm; /* number of grid points */ realtype dx; realtype coeff; N_Vector pp; /* vector of prec. diag. elements */ } *UserData; /* Prototypes for functions called by IDA */ int resHeat(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp); /* Prototypes for private functions */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res); static void PrintHeader(realtype rtol, realtype atol, int linsolver); static void PrintOutput(void *mem, realtype t, N_Vector uu, int linsolver); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { void *mem; UserData data; N_Vector uu, up, constraints, res; int ier, iout, linsolver; realtype rtol, atol, t0, t1, tout, tret; long int netf, ncfn, ncfl; mem = NULL; data = NULL; uu = up = constraints = res = NULL; /* Allocate N-vectors and the user data structure. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2)) return(1); /* Assign parameters in the user data structure. */ data->mm = MGRID; data->dx = ONE/(MGRID-ONE); data->coeff = ONE/(data->dx * data->dx); data->pp = N_VNew_Serial(NEQ); if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1); /* Initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Assign various parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ for (linsolver = 0; linsolver < 3; ++linsolver) { if (linsolver != 0) { /* Re-initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Re-initialize IDA */ ier = IDAReInit(mem, t0, uu, up); if (check_flag(&ier, "IDAReInit", 1)) return(1); } /* Attach a linear solver module */ switch(linsolver) { /* (a) SPGMR */ case(USE_SPGMR): /* Print header */ printf(" -------"); printf(" \n| SPGMR |\n"); printf(" -------\n"); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1)) return(1); break; /* (b) SPBCG */ case(USE_SPBCG): /* Print header */ printf(" -------"); printf(" \n| SPBCG |\n"); printf(" -------\n"); /* Call IDASpbcg to specify the linear solver. */ ier = IDASpbcg(mem, 0); if(check_flag(&ier, "IDASpbcg", 1)) return(1); break; /* (c) SPTFQMR */ case(USE_SPTFQMR): /* Print header */ printf(" ---------"); printf(" \n| SPTFQMR |\n"); printf(" ---------\n"); /* Call IDASptfqmr to specify the linear solver. */ ier = IDASptfqmr(mem, 0); if(check_flag(&ier, "IDASptfqmr", 1)) return(1); break; } /* Specify preconditioner */ ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol, linsolver); /* Print output table heading, and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu, linsolver); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); if (linsolver < 2) printf("\n======================================================================\n\n"); } /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ /* Free Memory */ IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(res); N_VDestroy_Serial(data->pp); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function (user-supplied) * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { long int i, j, offset, loc, mm; realtype *uu_data, *up_data, *rr_data, coeff, dif1, dif2; UserData data; uu_data = NV_DATA_S(uu); up_data = NV_DATA_S(up); rr_data = NV_DATA_S(rr); data = (UserData) user_data; coeff = data->coeff; mm = data->mm; /* Initialize rr to uu, to take care of boundary equations. */ N_VScale(ONE, uu, rr); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < MGRID-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; dif1 = uu_data[loc-1] + uu_data[loc+1] - TWO * uu_data[loc]; dif2 = uu_data[loc-mm] + uu_data[loc+mm] - TWO * uu_data[loc]; rr_data[loc]= up_data[loc] - coeff * ( dif1 + dif2 ); } } return(0); } /* * PsetupHeat: setup for diagonal preconditioner. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupdHeat argument list. */ int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, offset, loc, mm; realtype *ppv, pelinv; UserData data; data = (UserData) user_data; ppv = NV_DATA_S(data->pp); mm = data->mm; /* Initialize the entire vector to 1., then set the interior points to the correct value for preconditioning. */ N_VConst(ONE,data->pp); /* Compute the inverse of the preconditioner diagonal elements. */ pelinv = ONE/(c_j + FOUR*data->coeff); for (j = 1; j < mm-1; j++) { offset = mm * j; for (i = 1; i < mm-1; i++) { loc = offset + i; ppv[loc] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PrecondHeateq), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data, N_Vector tmp) { UserData data; data = (UserData) user_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u and up vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res) { long int mm, mm1, i, j, offset, loc; realtype xfact, yfact, *udata, *updata; mm = data->mm; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); /* Initialize uu on all grid points. */ mm1 = mm - 1; for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Set up at boundary points to zero. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0; i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) updata[loc] = ZERO; } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol, int linsolver) { printf("\nidaKrylovDemo_ls: Heat equation, serial example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); switch(linsolver) { case(USE_SPGMR): printf("Linear solver: IDASPGMR, preconditioner using diagonal elements. \n"); break; case(USE_SPBCG): printf("Linear solver: IDASPBCG, preconditioner using diagonal elements. \n"); break; case(USE_SPTFQMR): printf("Linear solver: IDASPTFQMR, preconditioner using diagonal elements. \n"); break; } } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(void *mem, realtype t, N_Vector uu, int linsolver) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/serial/CMakeLists.txt0000600000175000017500000001007311741421215022603 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.6 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for IDA serial examples # Add variable IDA_examples with the names of the serial IDA examples SET(IDA_examples idaFoodWeb_bnd idaHeat2D_bnd idaHeat2D_kry idaKrylovDemo_ls idaRoberts_dns idaSlCrank_dns ) # Add variable IDA_examples_BL with the names of the serial IDA examples # that use Lapack SET(IDA_examples_BL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_static) SET(NVECS_LIB sundials_nvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_shared) SET(NVECS_LIB sundials_nvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${IDA_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each IDA example FOREACH(example ${IDA_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDA_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${IDA_examples_BL}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${IDA_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDA") SET(SOLVER_LIB "sundials_ida") LIST2STRING(IDA_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(IDA_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/ida/serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/ida/serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/ida/serial/Makefile.in0000600000175000017500000001046711741421215022117 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.11 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for IDA serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/ida/libsundials_ida.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = idaFoodWeb_bnd \ idaHeat2D_bnd \ idaHeat2D_kry \ idaKrylovDemo_ls \ idaRoberts_dns \ idaSlCrank_dns EXAMPLES_BL = OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/ida/serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/ida/serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/ida/serial/README $(EXS_INSTDIR)/ida/serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/serial/$${i}.c $(EXS_INSTDIR)/ida/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/serial/$${i}.out $(EXS_INSTDIR)/ida/serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/serial/$${i}.c $(EXS_INSTDIR)/ida/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/serial/$${i}.out $(EXS_INSTDIR)/ida/serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/ida/serial/Makefile rm -f $(EXS_INSTDIR)/ida/serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/ida/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/ida/serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/ida/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/ida/serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/ida/serial $(rminstalldirs) $(EXS_INSTDIR)/ida clean: rm -rf .libs rm -f *.lo rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/ida/serial/idaHeat2D_kry.out0000600000175000017500000000512111741421215023204 0ustar sylvestresylvestre idaHeat2D_kry: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPGMR, preconditioner using diagonal elements. Case 1: gsytpe = MODIFIED_GS Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 0.00000e+00 1 39 51 77 51 77 1.05e-01 12 128 1.28 0.00000e+00 1 41 53 77 53 77 4.21e-01 14 130 2.56 0.00000e+00 1 43 55 77 55 77 1.69e+00 16 132 5.12 0.00000e+00 1 44 56 77 56 77 3.37e+00 17 133 10.24 0.00000e+00 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 Case 2: gstype = CLASSICAL_GS Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 2.15648e-20 1 39 51 77 51 77 1.05e-01 12 128 1.28 1.30250e-20 1 41 53 77 53 77 4.21e-01 14 130 2.56 3.00951e-20 1 43 55 77 55 77 1.69e+00 16 132 5.12 7.38674e-20 1 44 56 77 56 77 3.37e+00 17 133 10.24 1.79685e-19 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/ida/serial/idaKrylovDemo_ls.out0000600000175000017500000001124311741421215024043 0ustar sylvestresylvestre ------- | SPGMR | ------- idaKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPGMR, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24106e-01 2 12 14 7 14 7 2.56e-03 8 21 0.02 6.88134e-01 3 15 18 12 18 12 5.12e-03 8 30 0.04 4.70711e-01 3 18 24 21 24 21 6.58e-03 9 45 0.08 2.16509e-01 3 22 29 30 29 30 1.32e-02 9 59 0.16 4.57687e-02 4 28 36 44 36 44 1.32e-02 9 80 0.32 2.09938e-03 4 35 44 67 44 67 2.63e-02 10 111 0.64 0.00000e+00 1 39 51 77 51 77 1.05e-01 12 128 1.28 0.00000e+00 1 41 53 77 53 77 4.21e-01 14 130 2.56 0.00000e+00 1 43 55 77 55 77 1.69e+00 16 132 5.12 0.00000e+00 1 44 56 77 56 77 3.37e+00 17 133 10.24 0.00000e+00 1 45 57 77 57 77 6.74e+00 18 134 Error test failures = 1 Nonlinear convergence failures = 0 Linear convergence failures = 0 ====================================================================== ------- | SPBCG | ------- idaKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPBCG, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24105e-01 2 12 14 8 14 8 2.56e-03 8 22 0.02 6.88129e-01 3 15 18 14 18 14 5.12e-03 8 32 0.04 4.70820e-01 3 19 23 22 23 22 1.02e-02 9 45 0.08 2.16332e-01 3 23 27 32 27 32 1.02e-02 9 59 0.16 4.48774e-02 4 27 33 44 33 44 2.05e-02 10 77 0.32 1.75557e-03 3 33 41 70 41 70 4.10e-02 11 111 0.64 2.47770e-05 1 38 48 82 48 82 1.64e-01 13 130 1.28 2.57209e-22 1 40 50 82 50 82 6.55e-01 15 132 2.56 3.19445e-22 1 41 51 82 51 82 1.31e+00 16 133 5.12 7.19965e-22 1 42 52 82 52 82 2.62e+00 17 134 10.24 1.87591e-21 1 43 53 82 53 82 5.24e+00 18 135 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 ====================================================================== --------- | SPTFQMR | --------- idaKrylovDemo_ls: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDASPTFQMR, preconditioner using diagonal elements. Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h npe nps ---------------------------------------------------------------------- 0.01 8.24104e-01 2 12 14 11 14 11 2.56e-03 8 28 0.02 6.88133e-01 3 15 18 19 18 19 5.12e-03 8 42 0.04 4.70857e-01 3 19 23 33 23 33 1.02e-02 9 64 0.08 2.16481e-01 3 23 27 57 27 57 1.02e-02 9 96 0.16 4.51083e-02 4 27 33 84 33 84 2.05e-02 10 133 0.32 1.78483e-03 4 34 42 139 42 139 4.10e-02 11 204 0.64 4.07887e-04 1 39 51 183 51 183 1.47e-01 13 262 1.28 4.59662e-04 1 41 54 199 54 199 5.90e-01 15 282 2.56 2.03940e-05 1 43 56 202 56 202 1.18e+00 16 288 5.12 9.56073e-21 1 45 58 202 58 202 2.36e+00 17 290 10.24 5.70363e-20 1 46 59 202 59 202 4.72e+00 18 291 Error test failures = 0 Nonlinear convergence failures = 0 Linear convergence failures = 0 sundials-2.5.0/examples/ida/serial/idaHeat2D_kry.c0000600000175000017500000004226011741421215022624 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:25:59 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, serial, GMRES. * * This example solves a discretized 2D heat equation problem. * This version uses the Krylov solver IDASpgmr. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). The * PDE is treated with central differences on a uniform M x M grid. * The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the Krylov linear solver * IDASPGMR. The preconditioner uses the diagonal elements of the * Jacobian only. Routines for preconditioning, required by * IDASPGMR, are supplied here. The constraints u >= 0 are posed * for all components. Output is taken at t = 0, .01, .02, .04, * ..., 10.24. Two cases are run -- with the Gram-Schmidt type * being Modified in the first case, and Classical in the second. * The second run uses IDAReInit and IDAReInitSpgmr. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FOUR RCONST(4.0) /* User data type */ typedef struct { long int mm; /* number of grid points */ realtype dx; realtype coeff; N_Vector pp; /* vector of prec. diag. elements */ } *UserData; /* Prototypes for functions called by IDA */ int resHeat(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *prec_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *prec_data, N_Vector tmp); /* Prototypes for private functions */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res); static void PrintHeader(realtype rtol, realtype atol); static void PrintOutput(void *mem, realtype t, N_Vector uu); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { void *mem; UserData data; N_Vector uu, up, constraints, res; int ier, iout; realtype rtol, atol, t0, t1, tout, tret; long int netf, ncfn, ncfl; mem = NULL; data = NULL; uu = up = constraints = res = NULL; /* Allocate N-vectors and the user data structure. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); data->pp = NULL; if(check_flag((void *)data, "malloc", 2)) return(1); /* Assign parameters in the user data structure. */ data->mm = MGRID; data->dx = ONE/(MGRID-ONE); data->coeff = ONE/(data->dx * data->dx); data->pp = N_VNew_Serial(NEQ); if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1); /* Initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Assign various parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, resHeat, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* Call IDASpgmr to specify the linear solver. */ ier = IDASpgmr(mem, 0); if(check_flag(&ier, "IDASpgmr", 1)) return(1); ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat); if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol); /* * ------------------------------------------------------------------------- * CASE I * ------------------------------------------------------------------------- */ /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 1: gsytpe = MODIFIED_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* * ------------------------------------------------------------------------- * CASE II * ------------------------------------------------------------------------- */ /* Re-initialize uu, up. */ SetInitialProfile(data, uu, up, res); /* Re-initialize IDA and IDASPGMR */ ier = IDAReInit(mem, t0, uu, up); if(check_flag(&ier, "IDAReInit", 1)) return(1); ier = IDASpilsSetGSType(mem, CLASSICAL_GS); if(check_flag(&ier, "IDASpilsSetGSType",1)) return(1); /* Print case number, output table heading, and initial line of table. */ printf("\n\nCase 2: gstype = CLASSICAL_GS\n"); printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h npe nps\n" ); printf("----------------------------------------------------------------------\n"); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); ier = IDASpilsGetNumConvFails(mem, &ncfl); check_flag(&ier, "IDASpilsGetNumConvFails", 1); printf("\nError test failures = %ld\n", netf); printf("Nonlinear convergence failures = %ld\n", ncfn); printf("Linear convergence failures = %ld\n", ncfl); /* Free Memory */ IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(res); N_VDestroy_Serial(data->pp); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resHeat: heat equation system residual function (user-supplied) * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int resHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, void *user_data) { long int i, j, offset, loc, mm; realtype *uu_data, *up_data, *rr_data, coeff, dif1, dif2; UserData data; uu_data = NV_DATA_S(uu); up_data = NV_DATA_S(up); rr_data = NV_DATA_S(rr); data = (UserData) user_data; coeff = data->coeff; mm = data->mm; /* Initialize rr to uu, to take care of boundary equations. */ N_VScale(ONE, uu, rr); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < MGRID-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; dif1 = uu_data[loc-1] + uu_data[loc+1] - TWO * uu_data[loc]; dif2 = uu_data[loc-mm] + uu_data[loc+mm] - TWO * uu_data[loc]; rr_data[loc]= up_data[loc] - coeff * ( dif1 + dif2 ); } } return(0); } /* * PsetupHeat: setup for diagonal preconditioner for idaHeat2D_kry. * * The optional user-supplied functions PsetupHeat and * PsolveHeat together must define the left preconditoner * matrix P approximating the system Jacobian matrix * J = dF/du + cj*dF/du' * (where the DAE system is F(t,u,u') = 0), and solve the linear * systems P z = r. This is done in this case by keeping only * the diagonal elements of the J matrix above, storing them as * inverses in a vector pp, when computed in PsetupHeat, for * subsequent use in PsolveHeat. * * In this instance, only cj and data (user data structure, with * pp etc.) are used from the PsetupdHeat argument list. */ int PsetupHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, realtype c_j, void *prec_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, offset, loc, mm; realtype *ppv, pelinv; UserData data; data = (UserData) prec_data; ppv = NV_DATA_S(data->pp); mm = data->mm; /* Initialize the entire vector to 1., then set the interior points to the correct value for preconditioning. */ N_VConst(ONE,data->pp); /* Compute the inverse of the preconditioner diagonal elements. */ pelinv = ONE/(c_j + FOUR*data->coeff); for (j = 1; j < mm-1; j++) { offset = mm * j; for (i = 1; i < mm-1; i++) { loc = offset + i; ppv[loc] = pelinv; } } return(0); } /* * PsolveHeat: solve preconditioner linear system. * This routine multiplies the input vector rvec by the vector pp * containing the inverse diagonal Jacobian elements (previously * computed in PrecondHeateq), returning the result in zvec. */ int PsolveHeat(realtype tt, N_Vector uu, N_Vector up, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *prec_data, N_Vector tmp) { UserData data; data = (UserData) prec_data; N_VProd(data->pp, rvec, zvec); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u and up vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector res) { long int mm, mm1, i, j, offset, loc; realtype xfact, yfact, *udata, *updata; mm = data->mm; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); /* Initialize uu on all grid points. */ mm1 = mm - 1; for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* resHeat sets res to negative of ODE RHS values at interior points. */ resHeat(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Set up at boundary points to zero. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0; i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) updata[loc] = ZERO; } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol) { printf("\nidaHeat2D_kry: Heat equation, serial example problem for IDA \n"); printf(" Discretized heat equation on 2D unit square. \n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("Linear solver: IDASPGMR, preconditioner using diagonal elements. \n"); } /* * PrintOutput: print max norm of solution and current solver statistics */ static void PrintOutput(void *mem, realtype t, N_Vector uu) { realtype hused, umax; long int nst, nni, nje, nre, nreLS, nli, npe, nps; int kused, ier; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDASpilsGetNumJtimesEvals(mem, &nje); check_flag(&ier, "IDASpilsGetNumJtimesEvals", 1); ier = IDASpilsGetNumLinIters(mem, &nli); check_flag(&ier, "IDASpilsGetNumLinIters", 1); ier = IDASpilsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDASpilsGetNumResEvals", 1); ier = IDASpilsGetNumPrecEvals(mem, &npe); check_flag(&ier, "IDASpilsGetPrecEvals", 1); ier = IDASpilsGetNumPrecSolves(mem, &nps); check_flag(&ier, "IDASpilsGetNumPrecSolves", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e %3ld %3ld\n", t, umax, kused, nst, nni, nje, nre, nreLS, hused, npe, nps); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/serial/idaHeat2D_bnd.c0000600000175000017500000003073511741421215022566 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:25:59 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for IDA: 2D heat equation, serial, banded. * * This example solves a discretized 2D heat equation problem. * This version uses the band solver IDABand, and IDACalcIC. * * The DAE system solved is a spatial discretization of the PDE * du/dt = d^2u/dx^2 + d^2u/dy^2 * on the unit square. The boundary condition is u = 0 on all edges. * Initial conditions are given by u = 16 x (1 - x) y (1 - y). * The PDE is treated with central differences on a uniform M x M * grid. The values of u at the interior points satisfy ODEs, and * equations u = 0 at the boundaries are appended, to form a DAE * system of size N = M^2. Here M = 10. * * The system is solved with IDA using the banded linear system * solver, half-bandwidths equal to M, and default * difference-quotient Jacobian. For purposes of illustration, * IDACalcIC is called to compute correct values at the boundary, * given incorrect values as input initial guesses. The constraints * u >= 0 are posed for all components. Output is taken at * t = 0, .01, .02, .04, ..., 10.24. (Output at t = 0 is for * IDACalcIC cost statistics only.) * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NOUT 11 #define MGRID 10 #define NEQ MGRID*MGRID #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define BVAL RCONST(0.1) /* Type: UserData */ typedef struct { long int mm; realtype dx; realtype coeff; } *UserData; /* Prototypes of functions called by IDA */ int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data); /* Prototypes of private functions */ static void PrintHeader(realtype rtol, realtype atol); static void PrintOutput(void *mem, realtype t, N_Vector u); static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector id, N_Vector res); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { void *mem; UserData data; N_Vector uu, up, constraints, id, res; int ier, iout; long int mu, ml, netf, ncfn; realtype rtol, atol, t0, t1, tout, tret; mem = NULL; data = NULL; uu = up = constraints = id = res = NULL; /* Create vectors uu, up, res, constraints, id. */ uu = N_VNew_Serial(NEQ); if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1); up = N_VNew_Serial(NEQ); if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1); res = N_VNew_Serial(NEQ); if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); id = N_VNew_Serial(NEQ); if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1); /* Create and load problem data block. */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2)) return(1); data->mm = MGRID; data->dx = ONE/(MGRID - ONE); data->coeff = ONE/( (data->dx) * (data->dx) ); /* Initialize uu, up, id. */ SetInitialProfile(data, uu, up, id, res); /* Set constraints to all 1's for nonnegative solution values. */ N_VConst(ONE, constraints); /* Set remaining input parameters. */ t0 = ZERO; t1 = RCONST(0.01); rtol = ZERO; atol = RCONST(1.0e-3); /* Call IDACreate and IDAMalloc to initialize solution */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); ier = IDASetUserData(mem, data); if(check_flag(&ier, "IDASetUserData", 1)) return(1); ier = IDASetId(mem, id); if(check_flag(&ier, "IDASetId", 1)) return(1); ier = IDASetConstraints(mem, constraints); if(check_flag(&ier, "IDASetConstraints", 1)) return(1); N_VDestroy_Serial(constraints); ier = IDAInit(mem, heatres, t0, uu, up); if(check_flag(&ier, "IDAInit", 1)) return(1); ier = IDASStolerances(mem, rtol, atol); if(check_flag(&ier, "IDASStolerances", 1)) return(1); /* Call IDABand to specify the linear solver. */ mu = MGRID; ml = MGRID; ier = IDABand(mem, NEQ, mu, ml); if(check_flag(&ier, "IDABand", 1)) return(1); /* Call IDACalcIC to correct the initial values. */ ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1); if(check_flag(&ier, "IDACalcIC", 1)) return(1); /* Print output heading. */ PrintHeader(rtol, atol); PrintOutput(mem, t0, uu); /* Loop over output times, call IDASolve, and print results. */ for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL); if(check_flag(&ier, "IDASolve", 1)) return(1); PrintOutput(mem, tret, uu); } /* Print remaining counters and free memory. */ ier = IDAGetNumErrTestFails(mem, &netf); check_flag(&ier, "IDAGetNumErrTestFails", 1); ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1); printf("\n netf = %ld, ncfn = %ld \n", netf, ncfn); IDAFree(&mem); N_VDestroy_Serial(uu); N_VDestroy_Serial(up); N_VDestroy_Serial(id); N_VDestroy_Serial(res); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * heatres: heat equation system residual function * This uses 5-point central differencing on the interior points, and * includes algebraic equations for the boundary values. * So for each interior point, the residual component has the form * res_i = u'_i - (central difference)_i * while for each boundary point, it is res_i = u_i. */ int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval, void *user_data) { long int mm, i, j, offset, loc; realtype *uv, *upv, *resv, coeff; UserData data; uv = NV_DATA_S(uu); upv = NV_DATA_S(up); resv = NV_DATA_S(resval); data = (UserData)user_data; mm = data->mm; coeff = data->coeff; /* Initialize resval to uu, to take care of boundary equations. */ N_VScale(ONE, uu, resval); /* Loop over interior points; set res = up - (central difference). */ for (j = 1; j < mm-1; j++) { offset = mm*j; for (i = 1; i < mm-1; i++) { loc = offset + i; resv[loc] = upv[loc] - coeff * (uv[loc-1] + uv[loc+1] + uv[loc-mm] + uv[loc+mm] - RCONST(4.0)*uv[loc]); } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * SetInitialProfile: routine to initialize u, up, and id vectors. */ static int SetInitialProfile(UserData data, N_Vector uu, N_Vector up, N_Vector id, N_Vector res) { realtype xfact, yfact, *udata, *updata, *iddata; long int mm, mm1, i, j, offset, loc; mm = data->mm; mm1 = mm - 1; udata = NV_DATA_S(uu); updata = NV_DATA_S(up); iddata = NV_DATA_S(id); /* Initialize id to 1's. */ N_VConst(ONE, id); /* Initialize uu on all grid points. */ for (j = 0; j < mm; j++) { yfact = data->dx * j; offset = mm*j; for (i = 0;i < mm; i++) { xfact = data->dx * i; loc = offset + i; udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact); } } /* Initialize up vector to 0. */ N_VConst(ZERO, up); /* heatres sets res to negative of ODE RHS values at interior points. */ heatres(ZERO, uu, up, res, data); /* Copy -res into up to get correct interior initial up values. */ N_VScale(-ONE, res, up); /* Finally, set values of u, up, and id at boundary points. */ for (j = 0; j < mm; j++) { offset = mm*j; for (i = 0;i < mm; i++) { loc = offset + i; if (j == 0 || j == mm1 || i == 0 || i == mm1 ) { udata[loc] = BVAL; updata[loc] = ZERO; iddata[loc] = ZERO; } } } return(0); } /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, realtype atol) { printf("\nidaHeat2D_bnd: Heat equation, serial example problem for IDA\n"); printf(" Discretized heat equation on 2D unit square.\n"); printf(" Zero boundary conditions,"); printf(" polynomial initial conditions.\n"); printf(" Mesh dimensions: %d x %d", MGRID, MGRID); printf(" Total system size: %d\n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Constraints set to force all solution components >= 0. \n"); printf("Linear solver: IDABAND, banded direct solver \n"); printf(" difference quotient Jacobian, half-bandwidths = %d \n",MGRID); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("IDACalcIC called with input boundary values = %Lg \n",BVAL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("IDACalcIC called with input boundary values = %lg \n",BVAL); #else printf("IDACalcIC called with input boundary values = %g \n",BVAL); #endif /* Print output table heading and initial line of table. */ printf("\n Output Summary (umax = max-norm of solution) \n\n"); printf(" time umax k nst nni nje nre nreLS h \n" ); printf(" . . . . . . . . . . . . . . . . . . . . . \n"); } /* * Print Output */ static void PrintOutput(void *mem, realtype t, N_Vector uu) { int ier; realtype umax, hused; long int nst, nni, nje, nre, nreLS; int kused; umax = N_VMaxNorm(uu); ier = IDAGetLastOrder(mem, &kused); check_flag(&ier, "IDAGetLastOrder", 1); ier = IDAGetNumSteps(mem, &nst); check_flag(&ier, "IDAGetNumSteps", 1); ier = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&ier, "IDAGetNumNonlinSolvIters", 1); ier = IDAGetNumResEvals(mem, &nre); check_flag(&ier, "IDAGetNumResEvals", 1); ier = IDAGetLastStep(mem, &hused); check_flag(&ier, "IDAGetLastStep", 1); ier = IDADlsGetNumJacEvals(mem, &nje); check_flag(&ier, "IDADlsGetNumJacEvals", 1); ier = IDADlsGetNumResEvals(mem, &nreLS); check_flag(&ier, "IDADlsGetNumResEvals", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %5.2Lf %13.5Le %d %3ld %3ld %3ld %4ld %4ld %9.2Le \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %5.2f %13.5le %d %3ld %3ld %3ld %4ld %4ld %9.2le \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #else printf(" %5.2f %13.5e %d %3ld %3ld %3ld %4ld %4ld %9.2e \n", t, umax, kused, nst, nni, nje, nre, nreLS, hused); #endif } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/serial/idaRoberts_dns.c0000600000175000017500000002731011741421215023153 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 23:02:23 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * This simple example problem for IDA, due to Robertson, * is from chemical kinetics, and consists of the following three * equations: * * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2 * 0 = y1 + y2 + y3 - 1 * * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1, y2 = y3 = 0. * * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. * * The problem is solved with IDA using IDADENSE for the linear * solver, with a user-supplied Jacobian. Output is printed at * t = .4, 4, 40, ..., 4e10. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NEQ 3 #define NOUT 12 #define ZERO RCONST(0.0); #define ONE RCONST(1.0); /* Macro to define dense matrix elements, indexed from 1. */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* Prototypes of functions called by IDA */ int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout, void *user_data); int jacrob(long int Neq, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat JJ, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); /* Prototypes of private functions */ static void PrintHeader(realtype rtol, N_Vector avtol, N_Vector y); static void PrintOutput(void *mem, realtype t, N_Vector y); static void PrintRootInfo(int root_f1, int root_f2); static void PrintFinalStats(void *mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * Main Program *-------------------------------------------------------------------- */ int main(void) { void *mem; N_Vector yy, yp, avtol; realtype rtol, *yval, *ypval, *atval; realtype t0, tout1, tout, tret; int iout, retval, retvalr; int rootsfound[2]; mem = NULL; yy = yp = avtol = NULL; yval = ypval = atval = NULL; /* Allocate N-vectors. */ yy = N_VNew_Serial(NEQ); if(check_flag((void *)yy, "N_VNew_Serial", 0)) return(1); yp = N_VNew_Serial(NEQ); if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1); avtol = N_VNew_Serial(NEQ); if(check_flag((void *)avtol, "N_VNew_Serial", 0)) return(1); /* Create and initialize y, y', and absolute tolerance vectors. */ yval = NV_DATA_S(yy); yval[0] = ONE; yval[1] = ZERO; yval[2] = ZERO; ypval = NV_DATA_S(yp); ypval[0] = RCONST(-0.04); ypval[1] = RCONST(0.04); ypval[2] = ZERO; rtol = RCONST(1.0e-4); atval = NV_DATA_S(avtol); atval[0] = RCONST(1.0e-8); atval[1] = RCONST(1.0e-14); atval[2] = RCONST(1.0e-6); /* Integration limits */ t0 = ZERO; tout1 = RCONST(0.4); PrintHeader(rtol, avtol, yy); /* Call IDACreate and IDAInit to initialize IDA memory */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); retval = IDAInit(mem, resrob, t0, yy, yp); if(check_flag(&retval, "IDAInit", 1)) return(1); /* Call IDASVtolerances to set tolerances */ retval = IDASVtolerances(mem, rtol, avtol); if(check_flag(&retval, "IDASVtolerances", 1)) return(1); /* Free avtol */ N_VDestroy_Serial(avtol); /* Call IDARootInit to specify the root function grob with 2 components */ retval = IDARootInit(mem, 2, grob); if (check_flag(&retval, "IDARootInit", 1)) return(1); /* Call IDADense and set up the linear solver. */ retval = IDADense(mem, NEQ); if(check_flag(&retval, "IDADense", 1)) return(1); retval = IDADlsSetDenseJacFn(mem, jacrob); if(check_flag(&retval, "IDADlsSetDenseJacFn", 1)) return(1); /* In loop, call IDASolve, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ iout = 0; tout = tout1; while(1) { retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL); PrintOutput(mem,tret,yy); if(check_flag(&retval, "IDASolve", 1)) return(1); if (retval == IDA_ROOT_RETURN) { retvalr = IDAGetRootInfo(mem, rootsfound); check_flag(&retvalr, "IDAGetRootInfo", 1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (retval == IDA_SUCCESS) { iout++; tout *= RCONST(10.0); } if (iout == NOUT) break; } PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Serial(yy); N_VDestroy_Serial(yp); return(0); } /* *-------------------------------------------------------------------- * Functions called by IDA *-------------------------------------------------------------------- */ /* * Define the system residual function. */ int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { realtype *yval, *ypval, *rval; yval = NV_DATA_S(yy); ypval = NV_DATA_S(yp); rval = NV_DATA_S(rr); rval[0] = RCONST(-0.04)*yval[0] + RCONST(1.0e4)*yval[1]*yval[2]; rval[1] = -rval[0] - RCONST(3.0e7)*yval[1]*yval[1] - ypval[1]; rval[0] -= ypval[0]; rval[2] = yval[0] + yval[1] + yval[2] - ONE; return(0); } /* * Root function routine. Compute functions g_i(t,y) for i = 0,1. */ static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout, void *user_data) { realtype *yval, y1, y3; yval = NV_DATA_S(yy); y1 = yval[0]; y3 = yval[2]; gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Define the Jacobian function. */ int jacrob(long int Neq, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector resvec, DlsMat JJ, void *user_data, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3) { realtype *yval; yval = NV_DATA_S(yy); IJth(JJ,1,1) = RCONST(-0.04) - cj; IJth(JJ,2,1) = RCONST(0.04); IJth(JJ,3,1) = ONE; IJth(JJ,1,2) = RCONST(1.0e4)*yval[2]; IJth(JJ,2,2) = RCONST(-1.0e4)*yval[2] - RCONST(6.0e7)*yval[1] - cj; IJth(JJ,3,2) = ONE; IJth(JJ,1,3) = RCONST(1.0e4)*yval[1]; IJth(JJ,2,3) = RCONST(-1.0e4)*yval[1]; IJth(JJ,3,3) = ONE; return(0); } /* *-------------------------------------------------------------------- * Private functions *-------------------------------------------------------------------- */ /* * Print first lines of output (problem description) */ static void PrintHeader(realtype rtol, N_Vector avtol, N_Vector y) { realtype *atval, *yval; atval = NV_DATA_S(avtol); yval = NV_DATA_S(y); printf("\nidaRoberts_dns: Robertson kinetics DAE serial example problem for IDA\n"); printf(" Three equation chemical kinetics problem.\n\n"); printf("Linear solver: IDADENSE, with user-supplied Jacobian.\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg %Lg %Lg \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%Lg %Lg %Lg)\n", yval[0], yval[1], yval[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg %lg %lg \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%lg %lg %lg)\n", yval[0], yval[1], yval[2]); #else printf("Tolerance parameters: rtol = %g atol = %g %g %g \n", rtol, atval[0],atval[1],atval[2]); printf("Initial conditions y0 = (%g %g %g)\n", yval[0], yval[1], yval[2]); #endif printf("Constraints and id not used.\n\n"); printf("-----------------------------------------------------------------------\n"); printf(" t y1 y2 y3"); printf(" | nst k h\n"); printf("-----------------------------------------------------------------------\n"); } /* * Print Output */ static void PrintOutput(void *mem, realtype t, N_Vector y) { realtype *yval; int retval, kused; long int nst; realtype hused; yval = NV_DATA_S(y); retval = IDAGetLastOrder(mem, &kused); check_flag(&retval, "IDAGetLastOrder", 1); retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetLastStep(mem, &hused); check_flag(&retval, "IDAGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.4Le %12.4Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.4le %12.4le %12.4le %12.4le | %3ld %1d %12.4le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #else printf("%10.4e %12.4e %12.4e %12.4e | %3ld %1d %12.4e\n", t, yval[0], yval[1], yval[2], nst, kused, hused); #endif } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Print final integrator statistics */ static void PrintFinalStats(void *mem) { int retval; long int nst, nni, nje, nre, nreLS, netf, ncfn, nge; retval = IDAGetNumSteps(mem, &nst); check_flag(&retval, "IDAGetNumSteps", 1); retval = IDAGetNumResEvals(mem, &nre); check_flag(&retval, "IDAGetNumResEvals", 1); retval = IDADlsGetNumJacEvals(mem, &nje); check_flag(&retval, "IDADlsGetNumJacEvals", 1); retval = IDAGetNumNonlinSolvIters(mem, &nni); check_flag(&retval, "IDAGetNumNonlinSolvIters", 1); retval = IDAGetNumErrTestFails(mem, &netf); check_flag(&retval, "IDAGetNumErrTestFails", 1); retval = IDAGetNumNonlinSolvConvFails(mem, &ncfn); check_flag(&retval, "IDAGetNumNonlinSolvConvFails", 1); retval = IDADlsGetNumResEvals(mem, &nreLS); check_flag(&retval, "IDADlsGetNumResEvals", 1); retval = IDAGetNumGEvals(mem, &nge); check_flag(&retval, "IDAGetNumGEvals", 1); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); printf("Number of root fn. evaluations = %ld\n", nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/serial/idaSlCrank_dns.c0000600000175000017500000002000411741421215023061 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:25:59 $ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * Simulation of a slider-crank mechanism modelled with 3 generalized * coordinates: crank angle, connecting bar angle, and slider location. * The mechanism moves under the action of a constant horizontal force * applied to the connecting rod and a spring-damper connecting the crank * and connecting rod. * * The equations of motion are formulated as a system of stabilized * index-2 DAEs (Gear-Gupta-Leimkuhler formulation). * * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Problem Constants */ #define NEQ 10 #define TEND RCONST(10.0) #define NOUT 41 #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FOUR RCONST(4.0) typedef struct { realtype a; realtype J1, J2, m2; realtype k, c, l0; realtype F; } *UserData; int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector resval, void *user_data); void setIC(N_Vector yy, N_Vector yp, UserData data); void force(N_Vector yy, realtype *Q, UserData data); static void PrintHeader(realtype rtol, realtype atol, N_Vector y); static void PrintOutput(void *mem, realtype t, N_Vector y); static void PrintFinalStats(void *mem); /* *-------------------------------------------------------------------- * Main Program *-------------------------------------------------------------------- */ int main(void) { UserData data; void *mem; N_Vector yy, yp, id; realtype rtol, atol; realtype t0, tf, tout, dt, tret; int flag, iout; /* User data */ data = (UserData) malloc(sizeof *data); data->a = 0.5; /* half-length of crank */ data->J1 = 1.0; /* crank moment of inertia */ data->m2 = 1.0; /* mass of connecting rod */ data->J2 = 2.0; /* moment of inertia of connecting rod */ data->k = 1.0; /* spring constant */ data->c = 1.0; /* damper constant */ data->l0 = 1.0; /* spring free length */ data->F = 1.0; /* external constant force */ /* Create N_Vectors */ yy = N_VNew_Serial(NEQ); yp = N_VNew_Serial(NEQ); id = N_VNew_Serial(NEQ); /* Consistent IC */ setIC(yy, yp, data); /* ID array */ N_VConst(ONE, id); NV_Ith_S(id,6) = ZERO; NV_Ith_S(id,7) = ZERO; NV_Ith_S(id,8) = ZERO; NV_Ith_S(id,9) = ZERO; /* Tolerances */ rtol = RCONST(1.0e-6); atol = RCONST(1.0e-6); /* Integration limits */ t0 = ZERO; tf = TEND; dt = (tf-t0)/(NOUT-1); /* IDA initialization */ mem = IDACreate(); flag = IDAInit(mem, ressc, t0, yy, yp); flag = IDASStolerances(mem, rtol, atol); flag = IDASetUserData(mem, data); flag = IDASetId(mem, id); flag = IDASetSuppressAlg(mem, TRUE); /* Call IDADense and set up the linear solver. */ flag = IDADense(mem, NEQ); PrintHeader(rtol, atol, yy); /* In loop, call IDASolve, print results, and test for error. */ PrintOutput(mem,t0,yy); tout = dt; for (iout=1; iouta; J1 = data->J1; m2 = data->m2; J2 = data->J2; q = pi/TWO; p = asin(-a); x = cos(p); NV_Ith_S(yy,0) = q; NV_Ith_S(yy,1) = x; NV_Ith_S(yy,2) = p; force(yy, Q, data); NV_Ith_S(yp,3) = Q[0]/J1; NV_Ith_S(yp,4) = Q[1]/m2; NV_Ith_S(yp,5) = Q[2]/J2; } void force(N_Vector yy, realtype *Q, UserData data) { realtype a, k, c, l0, F; realtype q, x, p; realtype qd, xd, pd; realtype s1, c1, s2, c2, s21, c21; realtype l2, l, ld; realtype f, fl; a = data->a; k = data->k; c = data->c; l0 = data->l0; F = data->F; q = NV_Ith_S(yy,0); x = NV_Ith_S(yy,1); p = NV_Ith_S(yy,2); qd = NV_Ith_S(yy,3); xd = NV_Ith_S(yy,4); pd = NV_Ith_S(yy,5); s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); s21 = s2*c1 - c2*s1; c21 = c2*c1 + s2*s1; l2 = x*x - x*(c2+a*c1) + (ONE + a*a)/FOUR + a*c21/TWO; l = RSqrt(l2); ld = TWO*x*xd - xd*(c2+a*c1) + x*(s2*pd+a*s1*qd) - a*s21*(pd-qd)/TWO; ld /= TWO*l; f = k*(l-l0) + c*ld; fl = f/l; Q[0] = - fl * a * (s21/TWO + x*s1) / TWO; Q[1] = fl * (c2/TWO - x + a*c1/TWO) + F; Q[2] = - fl * (x*s2 - a*s21/TWO) / TWO - F*s2; } int ressc(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data) { UserData data; realtype Q[3]; realtype a, J1, m2, J2; realtype *yval, *ypval, *rval; realtype q, x, p; realtype qd, xd, pd; realtype lam1, lam2, mu1, mu2; realtype s1, c1, s2, c2; data = (UserData) user_data; a = data->a; J1 = data->J1; m2 = data->m2; J2 = data->J2; yval = NV_DATA_S(yy); ypval = NV_DATA_S(yp); rval = NV_DATA_S(rr); q = yval[0]; x = yval[1]; p = yval[2]; qd = yval[3]; xd = yval[4]; pd = yval[5]; lam1 = yval[6]; lam2 = yval[7]; mu1 = yval[8]; mu2 = yval[9]; s1 = sin(q); c1 = cos(q); s2 = sin(p); c2 = cos(p); force(yy, Q, data); rval[0] = ypval[0] - qd + a*s1*mu1 - a*c1*mu2; rval[1] = ypval[1] - xd + mu1; rval[2] = ypval[2] - pd + s2*mu1 - c2*mu2; rval[3] = J1*ypval[3] - Q[0] + a*s1*lam1 - a*c1*lam2; rval[4] = m2*ypval[4] - Q[1] + lam1; rval[5] = J2*ypval[5] - Q[2] + s2*lam1 - c2*lam2; rval[6] = x - c2 - a*c1; rval[7] = -s2 - a*s1; rval[8] = a*s1*qd + xd + s2*pd; rval[9] = -a*c1*qd - c2*pd; return(0); } static void PrintHeader(realtype rtol, realtype atol, N_Vector y) { printf("\nidaSlCrank_dns: Slider-Crank DAE serial example problem for IDAS\n"); printf("Linear solver: IDADENSE, Jacobian is computed by IDAS.\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("-----------------------------------------------------------------------\n"); printf(" t y1 y2 y3"); printf(" | nst k h\n"); printf("-----------------------------------------------------------------------\n"); } static void PrintOutput(void *mem, realtype t, N_Vector y) { realtype *yval; int flag, kused; long int nst; realtype hused; yval = NV_DATA_S(y); flag = IDAGetLastOrder(mem, &kused); flag = IDAGetNumSteps(mem, &nst); flag = IDAGetLastStep(mem, &hused); printf("%10.4le %12.4le %12.4le %12.4le %3ld %1d %12.4le\n", t, yval[0], yval[1], yval[2], nst, kused, hused); } static void PrintFinalStats(void *mem) { int flag; long int nst, nni, nje, nre, nreLS, netf, ncfn; flag = IDAGetNumSteps(mem, &nst); flag = IDAGetNumResEvals(mem, &nre); flag = IDADlsGetNumJacEvals(mem, &nje); flag = IDAGetNumNonlinSolvIters(mem, &nni); flag = IDAGetNumErrTestFails(mem, &netf); flag = IDAGetNumNonlinSolvConvFails(mem, &ncfn); flag = IDADlsGetNumResEvals(mem, &nreLS); printf("\nFinal Run Statistics: \n\n"); printf("Number of steps = %ld\n", nst); printf("Number of residual evaluations = %ld\n", nre+nreLS); printf("Number of Jacobian evaluations = %ld\n", nje); printf("Number of nonlinear iterations = %ld\n", nni); printf("Number of error test failures = %ld\n", netf); printf("Number of nonlinear conv. failures = %ld\n", ncfn); } sundials-2.5.0/examples/ida/serial/idaFoodWeb_bnd.c0000600000175000017500000005251211741421215023041 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2009/09/30 23:25:59 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example program for IDA: Food web problem. * * This example program (serial version) uses the IDABAND linear * solver, and IDACalcIC for initial condition calculation. * * The mathematical problem solved in this example is a DAE system * that arises from a system of partial differential equations after * spatial discretization. The PDE system is a food web population * model, with predator-prey interaction and diffusion on the unit * square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) , ns = 2 * np * * and the PDE's are as follows: * * i i i * dc /dt = d(i)*(c + c ) + R (x,y,c) (i = 1,...,np) * xx yy i * * i i * 0 = d(i)*(c + c ) + R (x,y,c) (i = np+1,...,ns) * xx yy i * * where the reaction terms R are: * * i ns j * R (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * all other a(i,j) = 0 * b(i) = BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i <= np) * b(i) =-BB*(1+ alpha * x*y + beta*sin(4 pi x)*sin(4 pi y)) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED (i > np) * * The various scalar parameters required are set using '#define' * statements or directly in routine InitUserData. In this program, * np = 1, ns = 2. The boundary conditions are homogeneous Neumann: * normal derivative = 0. * * A polynomial in x and y is used to set the initial values of the * first np variables (the prey variables) at each x,y location, * while initial values for the remaining (predator) variables are * set to a flat value, which is corrected by IDACalcIC. * * The PDEs are discretized by central differencing on a MX by MY * mesh. * * The DAE system is solved by IDA using the IDABAND linear solver. * Output is printed at t = 0, .001, .01, .1, .4, .7, 1. * ----------------------------------------------------------------- * References: * [1] Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, Journal * of Applied Mathematics and Computation, Vol. 31 (May 1989), * pp. 40-91. * * [2] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Using Krylov Methods in the Solution of Large-Scale * Differential-Algebraic Systems, SIAM J. Sci. Comput., 15 * (1994), pp. 1467-1488. * * [3] Peter N. Brown, Alan C. Hindmarsh, and Linda R. Petzold, * Consistent Initial Condition Calculation for Differential- * Algebraic Systems, SIAM J. Sci. Comput., 19 (1998), * pp. 1495-1512. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants. */ #define NPREY 1 /* No. of prey (= no. of predators). */ #define NUM_SPECIES 2*NPREY #define PI RCONST(3.1415926535898) #define FOURPI (RCONST(4.0)*PI) #define MX 20 /* MX = number of x mesh points */ #define MY 20 /* MY = number of y mesh points */ #define NSMX (NUM_SPECIES * MX) #define NEQ (NUM_SPECIES*MX*MY) #define AA RCONST(1.0) /* Coefficient in above eqns. for a */ #define EE RCONST(10000.) /* Coefficient in above eqns. for a */ #define GG RCONST(0.5e-6) /* Coefficient in above eqns. for a */ #define BB RCONST(1.0) /* Coefficient in above eqns. for b */ #define DPREY RCONST(1.0) /* Coefficient in above eqns. for d */ #define DPRED RCONST(0.05) /* Coefficient in above eqns. for d */ #define ALPHA RCONST(50.) /* Coefficient alpha in above eqns. */ #define BETA RCONST(1000.) /* Coefficient beta in above eqns. */ #define AX RCONST(1.0) /* Total range of x variable */ #define AY RCONST(1.0) /* Total range of y variable */ #define RTOL RCONST(1.e-5) /* Relative tolerance */ #define ATOL RCONST(1.e-5) /* Absolute tolerance */ #define NOUT 6 /* Number of output times */ #define TMULT RCONST(10.0) /* Multiplier for tout values */ #define TADD RCONST(0.3) /* Increment for tout values */ #define ZERO RCONST(0.) #define ONE RCONST(1.0) /* * User-defined vector and accessor macro: IJ_Vptr. * IJ_Vptr is defined in order to express the underlying 3-D structure of * the dependent variable vector from its underlying 1-D storage (an N_Vector). * IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to * species index is = 0, x-index ix = i, and y-index jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_S(vv, (i)*NUM_SPECIES + (j)*NSMX)) /* Type: UserData. Contains problem constants, etc. */ typedef struct { long int Neq, ns, np, mx, my; realtype dx, dy, **acoef; realtype cox[NUM_SPECIES], coy[NUM_SPECIES], bcoef[NUM_SPECIES]; N_Vector rates; } *UserData; /* Prototypes for functions called by the IDA Solver. */ static int resweb(realtype time, N_Vector cc, N_Vector cp, N_Vector resval, void *user_data); /* Prototypes for private Helper Functions. */ static void InitUserData(UserData webdata); static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, UserData webdata); static void PrintHeader(long int mu, long int ml, realtype rtol, realtype atol); static void PrintOutput(void *mem, N_Vector c, realtype t); static void PrintFinalStats(void *mem); static void Fweb(realtype tcalc, N_Vector cc, N_Vector crate, UserData webdata); static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata); static realtype dotprod(long int size, realtype *x1, realtype *x2); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { void *mem; UserData webdata; N_Vector cc, cp, id; int iout, retval; long int mu, ml; realtype rtol, atol, t0, tout, tret; mem = NULL; webdata = NULL; cc = cp = id = NULL; /* Allocate and initialize user data block webdata. */ webdata = (UserData) malloc(sizeof *webdata); webdata->rates = N_VNew_Serial(NEQ); webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); InitUserData(webdata); /* Allocate N-vectors and initialize cc, cp, and id. */ cc = N_VNew_Serial(NEQ); if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1); cp = N_VNew_Serial(NEQ); if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1); id = N_VNew_Serial(NEQ); if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1); SetInitialProfiles(cc, cp, id, webdata); /* Set remaining inputs to IDAMalloc. */ t0 = ZERO; rtol = RTOL; atol = ATOL; /* Call IDACreate and IDAMalloc to initialize IDA. */ mem = IDACreate(); if(check_flag((void *)mem, "IDACreate", 0)) return(1); retval = IDASetUserData(mem, webdata); if(check_flag(&retval, "IDASetUserData", 1)) return(1); retval = IDASetId(mem, id); if(check_flag(&retval, "IDASetId", 1)) return(1); retval = IDAInit(mem, resweb, t0, cc, cp); if(check_flag(&retval, "IDAInit", 1)) return(1); retval = IDASStolerances(mem, rtol, atol); if(check_flag(&retval, "IDASStolerances", 1)) return(1); /* Call IDABand to specify the IDA linear solver. */ mu = ml = NSMX; retval = IDABand(mem, NEQ, mu, ml); if(check_flag(&retval, "IDABand", 1)) return(1); /* Call IDACalcIC (with default options) to correct the initial values. */ tout = RCONST(0.001); retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout); if(check_flag(&retval, "IDACalcIC", 1)) return(1); /* Print heading, basic parameters, and initial values. */ PrintHeader(mu, ml, rtol, atol); PrintOutput(mem, cc, ZERO); /* Loop over iout, call IDASolve (normal mode), print selected output. */ for (iout = 1; iout <= NOUT; iout++) { retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL); if(check_flag(&retval, "IDASolve", 1)) return(retval); PrintOutput(mem, cc, tret); if (iout < 3) tout *= TMULT; else tout += TADD; } /* Print final statistics and free memory. */ PrintFinalStats(mem); /* Free memory */ IDAFree(&mem); N_VDestroy_Serial(cc); N_VDestroy_Serial(cp); N_VDestroy_Serial(id); destroyMat(webdata->acoef); N_VDestroy_Serial(webdata->rates); free(webdata); return(0); } /* Define lines for readability in later routines */ #define acoef (webdata->acoef) #define bcoef (webdata->bcoef) #define cox (webdata->cox) #define coy (webdata->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY IDA *-------------------------------------------------------------------- */ /* * resweb: System residual function for predator-prey system. * This routine calls Fweb to get all the right-hand sides of the * equations, then loads the residual vector accordingly, * using cp in the case of prey species. */ static int resweb(realtype tt, N_Vector cc, N_Vector cp, N_Vector res, void *user_data) { long int jx, jy, is, yloc, loc, np; realtype *resv, *cpv; UserData webdata; webdata = (UserData)user_data; cpv = NV_DATA_S(cp); resv = NV_DATA_S(res); np = webdata->np; /* Call Fweb to set res to vector of right-hand sides. */ Fweb(tt, cc, res, webdata); /* Loop over all grid points, setting residual values appropriately for differential or algebraic components. */ for (jy = 0; jy < MY; jy++) { yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { loc = yloc + NUM_SPECIES * jx; for (is = 0; is < NUM_SPECIES; is++) { if (is < np) resv[loc+is] = cpv[loc+is] - resv[loc+is]; else resv[loc+is] = -resv[loc+is]; } } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * InitUserData: Load problem constants in webdata (of type UserData). */ static void InitUserData(UserData webdata) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2; webdata->mx = MX; webdata->my = MY; webdata->ns = NUM_SPECIES; webdata->np = NPREY; webdata->dx = AX/(MX-1); webdata->dy = AY/(MY-1); webdata->Neq= NEQ; /* Set up the coefficients a and b, and others found in the equations. */ np = webdata->np; dx2 = (webdata->dx)*(webdata->dx); dy2 = (webdata->dy)*(webdata->dy); for (i = 0; i < np; i++) { a1 = &(acoef[i][np]); a2 = &(acoef[i+np][0]); a3 = &(acoef[i][0]); a4 = &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row. */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* Reset the diagonal elements of acoef to -AA. */ acoef[i][i] = -AA; acoef[i+np][i+np] = -AA; /* Set coefficients for b and diffusion terms. */ bcoef[i] = BB; bcoef[i+np] = -BB; cox[i] = DPREY/dx2; cox[i+np] = DPRED/dx2; coy[i] = DPREY/dy2; coy[i+np] = DPRED/dy2; } } /* * SetInitialProfiles: Set initial conditions in cc, cp, and id. * A polynomial profile is used for the prey cc values, and a constant * (1.0e5) is loaded as the initial guess for the predator cc values. * The id values are set to 1 for the prey and 0 for the predators. * The prey cp values are set according to the given system, and * the predator cp values are set to zero. */ static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id, UserData webdata) { long int loc, yloc, is, jx, jy, np; realtype xx, yy, xyfactor, fac; realtype *ccv, *cpv, *idv; ccv = NV_DATA_S(cc); cpv = NV_DATA_S(cp); idv = NV_DATA_S(id); np = webdata->np; /* Loop over grid, load cc values and id values. */ for (jy = 0; jy < MY; jy++) { yy = jy * webdata->dy; yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { xx = jx * webdata->dx; xyfactor = RCONST(16.0)*xx*(ONE-xx)*yy*(ONE-yy); xyfactor *= xyfactor; loc = yloc + NUM_SPECIES*jx; fac = ONE + ALPHA * xx * yy + BETA * sin(FOURPI*xx) * sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) { if (is < np) { ccv[loc+is] = RCONST(10.0) + (realtype)(is+1) * xyfactor; idv[loc+is] = ONE; } else { ccv[loc+is] = RCONST(1.0e5); idv[loc+is] = ZERO; } } } } /* Set c' for the prey by calling the function Fweb. */ Fweb(ZERO, cc, cp, webdata); /* Set c' for predators to 0. */ for (jy = 0; jy < MY; jy++) { yloc = NSMX * jy; for (jx = 0; jx < MX; jx++) { loc = yloc + NUM_SPECIES * jx; for (is = np; is < NUM_SPECIES; is++) { cpv[loc+is] = ZERO; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(long int mu, long int ml, realtype rtol, realtype atol) { printf("\nidaFoodWeb_bnd: Predator-prey DAE serial example problem for IDA \n\n"); printf("Number of species ns: %d", NUM_SPECIES); printf(" Mesh dimensions: %d x %d", MX, MY); printf(" System size: %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: rtol = %Lg atol = %Lg\n", rtol, atol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: rtol = %lg atol = %lg\n", rtol, atol); #else printf("Tolerance parameters: rtol = %g atol = %g\n", rtol, atol); #endif printf("Linear solver: IDABAND, Band parameters mu = %ld, ml = %ld\n",mu,ml); printf("CalcIC called to correct initial predator concentrations.\n\n"); printf("-----------------------------------------------------------\n"); printf(" t bottom-left top-right"); printf(" | nst k h\n"); printf("-----------------------------------------------------------\n\n"); } /* * PrintOutput: Print output values at output time t = tt. * Selected run statistics are printed. Then values of the concentrations * are printed for the bottom left and top right grid points only. */ static void PrintOutput(void *mem, N_Vector c, realtype t) { int i, kused, flag; long int nst; realtype *c_bl, *c_tr, hused; flag = IDAGetLastOrder(mem, &kused); check_flag(&flag, "IDAGetLastOrder", 1); flag = IDAGetNumSteps(mem, &nst); check_flag(&flag, "IDAGetNumSteps", 1); flag = IDAGetLastStep(mem, &hused); check_flag(&flag, "IDAGetLastStep", 1); c_bl = IJ_Vptr(c,0,0); c_tr = IJ_Vptr(c,MX-1,MY-1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.2Le %12.4Le %12.4Le | %3ld %1d %12.4Le\n", t, c_bl[0], c_tr[1], nst, kused, hused); for (i=1;idy) * jy ; idyu = (jy!=MY-1) ? NSMX : -NSMX; idyl = (jy!= 0 ) ? NSMX : -NSMX; for (jx = 0; jx < MX; jx++) { xx = (webdata->dx) * jx; idxu = (jx!= MX-1) ? NUM_SPECIES : -NUM_SPECIES; idxl = (jx!= 0 ) ? NUM_SPECIES : -NUM_SPECIES; cxy = IJ_Vptr(cc,jx,jy); ratesxy = IJ_Vptr(webdata->rates,jx,jy); cratexy = IJ_Vptr(crate,jx,jy); /* Get interaction vector at this grid point. */ WebRates(xx, yy, cxy, ratesxy, webdata); /* Loop over species, do differencing, load crate segment. */ for (is = 0; is < NUM_SPECIES; is++) { /* Differencing in y. */ dcyli = *(cxy+is) - *(cxy - idyl + is) ; dcyui = *(cxy + idyu + is) - *(cxy+is); /* Differencing in x. */ dcxli = *(cxy+is) - *(cxy - idxl + is); dcxui = *(cxy + idxu +is) - *(cxy+is); /* Compute the crate values at (xx,yy). */ cratexy[is] = coy[is] * (dcyui - dcyli) + cox[is] * (dcxui - dcxli) + ratesxy[is]; } /* End is loop */ } /* End of jx loop */ } /* End of jy loop */ } /* * WebRates: Evaluate reaction rates at a given spatial point. * At a given (x,y), evaluate the array of ns reaction terms R. */ static void WebRates(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, UserData webdata) { int is; realtype fac; for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = dotprod(NUM_SPECIES, cxy, acoef[is]); fac = ONE + ALPHA*xx*yy + BETA*sin(FOURPI*xx)*sin(FOURPI*yy); for (is = 0; is < NUM_SPECIES; is++) ratesxy[is] = cxy[is]*( bcoef[is]*fac + ratesxy[is] ); } /* * dotprod: dot product routine for realtype arrays, for use by WebRates. */ static realtype dotprod(long int size, realtype *x1, realtype *x2) { long int i; realtype *xx1, *xx2, temp = ZERO; xx1 = x1; xx2 = x2; for (i = 0; i < size; i++) temp += (*xx1++) * (*xx2++); return(temp); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; if (opt == 0 && flagvalue == NULL) { /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } else if (opt == 1) { /* Check if flag < 0 */ errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } else if (opt == 2 && flagvalue == NULL) { /* Check if function returned NULL pointer - no memory allocated */ fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/ida/serial/idaRoberts_dns.out0000600000175000017500000000353411741421215023542 0ustar sylvestresylvestre idaRoberts_dns: Robertson kinetics DAE serial example problem for IDA Three equation chemical kinetics problem. Linear solver: IDADENSE, with user-supplied Jacobian. Tolerance parameters: rtol = 0.0001 atol = 1e-08 1e-14 1e-06 Initial conditions y0 = (1 0 0) Constraints and id not used. ----------------------------------------------------------------------- t y1 y2 y3 | nst k h ----------------------------------------------------------------------- 2.6403e-01 9.8997e-01 3.4706e-05 1.0000e-02 | 85 2 6.4537e-02 rootsfound[] = 0 1 4.0000e-01 9.8517e-01 3.3864e-05 1.4796e-02 | 88 2 6.4537e-02 4.0000e+00 9.0550e-01 2.2403e-05 9.4473e-02 | 102 4 4.1426e-01 4.0000e+01 7.1582e-01 9.1851e-06 2.8417e-01 | 136 2 1.3422e+00 4.0000e+02 4.5049e-01 3.2226e-06 5.4950e-01 | 190 4 3.3557e+01 4.0000e+03 1.8321e-01 8.9429e-07 8.1679e-01 | 239 4 3.4533e+02 4.0000e+04 3.8984e-02 1.6218e-07 9.6102e-01 | 287 5 2.0140e+03 4.0000e+05 4.9389e-03 1.9852e-08 9.9506e-01 | 339 3 1.6788e+04 4.0000e+06 5.1683e-04 2.0684e-09 9.9948e-01 | 444 4 2.1755e+05 2.0793e+07 1.0000e-04 4.0004e-10 9.9990e-01 | 495 4 1.0146e+06 rootsfound[] = -1 0 4.0000e+07 5.2036e-05 2.0816e-10 9.9995e-01 | 506 5 2.5503e+06 4.0000e+08 5.2103e-06 2.0841e-11 9.9999e-01 | 541 4 2.3847e+07 4.0000e+09 5.2125e-07 2.0850e-12 1.0000e-00 | 569 4 3.9351e+08 4.0000e+10 5.1091e-08 2.0437e-13 1.0000e-00 | 589 2 6.0246e+09 Final Run Statistics: Number of steps = 589 Number of residual evaluations = 832 Number of Jacobian evaluations = 79 Number of nonlinear iterations = 832 Number of error test failures = 14 Number of nonlinear conv. failures = 0 Number of root fn. evaluations = 624 sundials-2.5.0/examples/ida/serial/idaHeat2D_bnd.out0000600000175000017500000000267411741421215023154 0ustar sylvestresylvestre idaHeat2D_bnd: Heat equation, serial example problem for IDA Discretized heat equation on 2D unit square. Zero boundary conditions, polynomial initial conditions. Mesh dimensions: 10 x 10 Total system size: 100 Tolerance parameters: rtol = 0 atol = 0.001 Constraints set to force all solution components >= 0. Linear solver: IDABAND, banded direct solver difference quotient Jacobian, half-bandwidths = 10 IDACalcIC called with input boundary values = 0.1 Output Summary (umax = max-norm of solution) time umax k nst nni nje nre nreLS h . . . . . . . . . . . . . . . . . . . . . 0.00 9.75461e-01 0 0 1 2 3 42 1.00e-05 0.01 8.24113e-01 2 12 15 10 17 210 2.56e-03 0.02 6.88124e-01 3 15 19 10 21 210 5.12e-03 0.04 4.71054e-01 3 19 23 10 25 210 5.12e-03 0.08 2.16451e-01 3 23 28 11 30 231 1.02e-02 0.16 4.50382e-02 4 28 35 12 37 252 2.05e-02 0.32 2.14520e-03 5 34 43 13 45 273 4.10e-02 0.64 2.89374e-18 1 39 52 15 54 315 1.64e-01 1.28 1.17136e-32 1 41 54 17 56 357 6.55e-01 2.56 1.31711e-35 1 42 55 18 57 378 1.31e+00 5.12 1.18294e-37 1 43 56 19 58 399 2.62e+00 10.24 1.26706e-39 1 44 57 20 59 420 5.24e+00 netf = 0, ncfn = 0 sundials-2.5.0/examples/ida/serial/README0000600000175000017500000000134411741421215020724 0ustar sylvestresylvestreList of serial IDA examples idaFoodWeb_bnd : 2-D food web system, banded Jacobian idaHeat2D_bnd : 2-D heat equation, banded Jacobian idaHeat2D_kry : 2-D heat equation, diagonal preconditioner idaKrylovDemo_ls : demonstration program with 3 Krylov solvers idaRoberts_dns : 3-species Robertson kinetics system idaSlCrank_dns : slider-crank example (stabilized index-2 DAE) Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 sundials-2.5.0/examples/ida/fcmix_serial/0000755000175000017500000000000011767174700021254 5ustar sylvestresylvestresundials-2.5.0/examples/ida/fcmix_serial/fidaRoberts_dns.f0000600000175000017500000001517711741421215024522 0ustar sylvestresylvestrec ---------------------------------------------------------------- c $Revision: 1.3 $ c $Date: 2010/12/01 23:04:14 $ c ---------------------------------------------------------------- c This simple example problem for FIDA, due to Robertson, is from c chemical kinetics, and consists of the following three equations: c c dy1/dt = -.04*y1 + 1.e4*y2*y3 c dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2 c 0 = y1 + y2 + y3 - 1 c c on the interval from t = 0.0 to t = 4.e10, with initial c conditions: y1 = 1, y2 = y3 = 0. c c While integrating the system, we also employ the rootfinding feature c to find the points at which y1 = 1.e-4 or at which y3 = 0.01. c c The problem is solved using a dense linear solver, with a c user-supplied Jacobian. Output is printed at c t = .4, 4, 40, ..., 4e10. c ---------------------------------------------------------------- c program fidaRoberts_dns c implicit none c integer ier, ierroot, info(2) integer*4 iout(25), ipar double precision rout(10), rpar c integer iatol, nout, jout, itask integer nst, kused, hused integer*4 neq, i double precision t0, t1, rtol, tout, tret double precision y(3), yp(3), atol(3) c data nst/3/, kused/9/, hused/2/ c c Initialize variables c neq = 3 nout = 12 rtol = 1.0d-4 t0 = 0.0d0 t1 = 0.4d0 iatol = 2 itask = 1 c y(1) = 1.0d0 y(2) = 0.0d0 y(3) = 0.0d0 c yp(1) = -0.04d0 yp(2) = 0.04d0 yp(3) = 0.0d0 c atol(1) = 1.0d-6 atol(2) = 1.0d-10 atol(3) = 1.0d-6 c c Initialize IDA vector environment c call fnvinits(2, neq, ier) if (ier .ne. 0) then write(6,10) ier 10 format(///' SUNDIALS_ERROR: FNVINITS returned IER = ', i5) stop endif c call fidamalloc(t0, y, yp, iatol, rtol, atol, & iout, rout, ipar, rpar, ier) if (ier .ne. 0) then write(6,20) ier 20 format(///' SUNDIALS_ERROR: FIDAMALLOC returned IER = ', i5) stop endif c c Initialize rootfinding problem call fidarootinit(2, ier) if (ier .ne. 0) then write(6,25) ier 25 format(///' SUNDIALS_ERROR: FIDAROOTINIT returned IER = ', i5) call fidafree stop endif c c Attach dense linear solver c call fidadense(neq, ier) call fidadensesetjac(1, ier) c c Print header c call prntintro(rtol, atol, y) c tout = t1 c c jout = 1 do while(jout .le. nout) c call fidasolve(tout, tret, y, yp, itask, ier) c write(6,40) tret, (y(i), i = 1,3), iout(nst), iout(kused), & rout(hused) 40 format(e10.4, 3(1x,e12.4), i5, i3, e12.4) c if (ier .lt. 0) then write(6,50) ier, iout(15) 50 format(///' SUNDIALS_ERROR: FIDASOLVE returned IER = ',i5,/, 1 ' Linear Solver returned IER = ',i5) call fidarootfree call fidafree stop endif c if (ier .eq. 2) then call fidarootinfo(2, info, ierroot) if (ierroot .lt. 0) then write(6,55) ier 55 format(///' SUNDIALS_ERROR: FIDAROOTINFO returned IER = ', 1 i5) call fidarootfree call fidafree stop endif write(6,60) (info(i), i = 1,2) 60 format(5x, 'Above is a root, INFO() = ', 2i3) endif c if (ier .eq. 0) then tout = tout * 10.0d0 jout = jout + 1 endif c ENDDO c c Print final statistics c call prntstats(iout) c c Free IDA memory c call fidarootfree call fidafree c stop end c c ========== c subroutine fidaresfun(tres, y, yp, res, ipar, rpar, reserr) c implicit none c integer reserr integer*4 ipar(*) double precision tres, rpar(*) double precision y(*), yp(*), res(*) c res(1) = -0.04d0*y(1)+1.0d4*y(2)*y(3) res(2) = -res(1)-3.0d7*y(2)*y(2)-yp(2) res(1) = res(1)-yp(1) res(3) = y(1)+y(2)+y(3)-1.0d0 c reserr = 0 c return end c c ========== c subroutine fidadjac(neq, t, y, yp, r, jac, cj, ewt, h, 1 ipar, rpar, wk1, wk2, wk3, djacerr) c implicit none c integer*4 neq integer*4 ipar(*) integer djacerr double precision t, h, cj, rpar(*) double precision y(*), yp(*), r(*), ewt(*), jac(neq,neq) double precision wk1(*), wk2(*), wk3(*) c jac(1,1) = -0.04d0-cj jac(2,1) = 0.04d0 jac(3,1) = 1.0d0 jac(1,2) = 1.0d4*y(3) jac(2,2) = -1.0d4*y(3)-6.0d7*y(2)-cj jac(3,2) = 1.0d0 jac(1,3) = 1.0d4*y(2) jac(2,3) = -1.0d4*y(2) jac(3,3) = 1.0d0 c djacerr = 0 return end c c ========== c subroutine fidarootfn(t, y, yp, g, ipar, rpar, ier) c Fortran routine for rootfinding implicit none c INTEGER*4 ipar(*), ier double precision t, y(*), yp(*), g(*), rpar(*) c g(1) = y(1) - 1.0d-4 g(2) = y(3) - 1.0d-2 ier = 0 return end c c ========== c subroutine prntintro(rtol, atol, y) c implicit none c integer*4 i double precision rtol, atol(*), y(*) c write(6,60) rtol, (atol(i), i = 1,3), (y(i), i = 1,3) 60 format(/'fidaRoberts_dns: Robertson kinetics DAE serial example', & 'problem for IDA', /,' Three equation chemical', & 'kinetics problem.', //, & 'Tolerance parameters: rtol = ', e8.2, & ' atol = ', 3(1x,e8.2), /, & 'Initial conditions y0 = (', 3(1x,e8.2), ')', //, & ' t y1 y2 y3 nst', & ' k h') c return end c c ========== c subroutine prntstats(iout) c implicit none c integer*4 iout(25) integer nst, reseval, jaceval, nni, ncf, netf, nge c data nst/3/, reseval/4/, jaceval/17/, nni/7/, netf/5/, & ncf/6/, nge/12/ c write(6,70) iout(nst), iout(reseval), iout(jaceval), & iout(nni), iout(netf), iout(ncf), iout(nge) 70 format(/'Final Run Statistics:', //, & 'Number of steps = ', i3, /, & 'Number of residual evaluations = ', i3, /, & 'Number of Jacobian evaluations = ', i3, /, & 'Number of nonlinear iterations = ', i3, /, & 'Number of error test failures = ', i3, /, & 'Number of nonlinear conv. failures = ', i3, /, & 'Number of root function evals. = ', i3) c return end sundials-2.5.0/examples/ida/fcmix_serial/CMakeLists.txt0000600000175000017500000001037211741421215023773 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FIDA serial examples # Add variable ida_examples with the names of the serial FIDA examples SET(FIDA_examples fidaRoberts_dns ) # Add variable FIDA_examples_BL with the names of the serial FIDA examples # that use Lapack SET(FIDA_examples_BL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_static) SET(NVECS_LIB sundials_nvecserial_static) SET(FNVECS_LIB sundials_fnvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(IDA_LIB sundials_ida_shared) SET(NVECS_LIB sundials_nvecserial_shared) SET(FNVECS_LIB sundials_fnvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FIDA_LIB sundials_fida_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FIDA_LIB} ${IDA_LIB} ${FNVECS_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each FIDA example FOREACH(example ${FIDA_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FIDA_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${FIDA_examples_BL}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FIDA_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "IDA") SET(SOLVER_LIB "sundials_ida") SET(SOLVER_FLIB "sundials_fida") LIST2STRING(FIDA_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(FIDA_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/ida/fcmix_serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/fcmix_serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/ida/fcmix_serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/ida/fcmix_serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/ida/fcmix_serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/ida/fcmix_serial/Makefile.in0000600000175000017500000001105411741421215023276 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.10 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2005, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FIDA serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ F77 = @F77@ FFLAGS = @FFLAGS@ F77_LNKR = @F77_LNKR@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/ida/fcmix/libsundials_fida.la \ $(top_builddir)/src/ida/libsundials_ida.la \ $(top_builddir)/src/nvec_ser/libsundials_fnvecserial.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fidaRoberts_dns EXAMPLES_BL = OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/ida/fcmix_serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/ida/fcmix_serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_serial/README $(EXS_INSTDIR)/ida/fcmix_serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_serial/$${i}.f $(EXS_INSTDIR)/ida/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_serial/$${i}.out $(EXS_INSTDIR)/ida/fcmix_serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_serial/$${i}.f $(EXS_INSTDIR)/ida/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/ida/fcmix_serial/$${i}.out $(EXS_INSTDIR)/ida/fcmix_serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/ida/fcmix_serial/Makefile rm -f $(EXS_INSTDIR)/ida/fcmix_serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/ida/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/ida/fcmix_serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/ida/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/ida/fcmix_serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/ida/fcmix_serial $(rminstalldirs) $(EXS_INSTDIR)/ida clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/ida/fcmix_serial/fidaRoberts_dns.out0000600000175000017500000000322411741421215025072 0ustar sylvestresylvestre fidaRoberts_dns: Robertson kinetics DAE serial exampleproblem for IDA Three equation chemicalkinetics problem. Tolerance parameters: rtol = 0.10E-03 atol = 0.10E-05 0.10E-09 0.10E-05 Initial conditions y0 = ( 0.10E+01 0.00E+00 0.00E+00) t y1 y2 y3 nst k h 0.2640E+00 0.9900E+00 0.3471E-04 0.1000E-01 75 2 0.5716E-01 Above is a root, INFO() = 0 1 0.4000E+00 0.9852E+00 0.3386E-04 0.1480E-01 77 3 0.1143E+00 0.4000E+01 0.9055E+00 0.2240E-04 0.9447E-01 91 4 0.3704E+00 0.4000E+02 0.7158E+00 0.9185E-05 0.2842E+00 127 4 0.2963E+01 0.4000E+03 0.4505E+00 0.3223E-05 0.5495E+00 177 3 0.1241E+02 0.4000E+04 0.1832E+00 0.8940E-06 0.8168E+00 228 3 0.2765E+03 0.4000E+05 0.3899E-01 0.1622E-06 0.9610E+00 278 5 0.2614E+04 0.4000E+06 0.4939E-02 0.1985E-07 0.9951E+00 324 5 0.2770E+05 0.4000E+07 0.5176E-03 0.2072E-08 0.9995E+00 355 4 0.3979E+06 0.2075E+08 0.1000E-03 0.4000E-09 0.9999E+00 374 4 0.1592E+07 Above is a root, INFO() = -1 0 0.4000E+08 0.5191E-04 0.2076E-09 0.9999E+00 380 3 0.6366E+07 0.4000E+09 0.5882E-05 0.2353E-10 0.1000E+01 394 1 0.9167E+08 0.4000E+10 0.7054E-06 0.2822E-11 0.1000E+01 402 1 0.1467E+10 0.4000E+11 -0.7300E-06 -0.2920E-11 0.1000E+01 407 1 0.2347E+11 Final Run Statistics: Number of steps = 407 Number of residual evaluations = 557 Number of Jacobian evaluations = 65 Number of nonlinear iterations = 557 Number of error test failures = 6 Number of nonlinear conv. failures = 0 Number of root function evals. = 437 sundials-2.5.0/examples/ida/fcmix_serial/README0000600000175000017500000000066111741421215022113 0ustar sylvestresylvestreList of serial IDA FCMIX examples fidaRoberts_dns : chemical kinetics example (DENSE) Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 sundials-2.5.0/examples/cvodes/0000755000175000017500000000000011767174700017335 5ustar sylvestresylvestresundials-2.5.0/examples/cvodes/parallel/0000755000175000017500000000000011767174700021131 5ustar sylvestresylvestresundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_FSA_non_p.c0000600000175000017500000004462211741421151025161 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:30 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, George D. Byrne, * and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the program for * its solution by CVODES. The problem is the semi-discrete form of * the advection-diffusion equation in 1-D: * du/dt = q1 * d^2 u / dx^2 + q2 * du/dx * on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. * Homogeneous Dirichlet boundary conditions are posed, and the * initial condition is: * u(x,y,t=0) = x(2-x)exp(2x). * The PDE is discretized on a uniform grid of size MX+2 with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX. * This program solves the problem with the option for nonstiff * systems: ADAMS method and functional iteration. * It uses scalar relative and absolute tolerances. * Output is printed at t = .5, 1.0, ..., 5. * Run statistics (optional outputs) are printed at the end. * * Optionally, CVODES can compute sensitivities with respect to the * problem parameters q1 and q2. * Any of three sensitivity methods (SIMULTANEOUS, STAGGERED, and * STAGGERED1) can be used and sensitivities may be included in the * error test or not (error control set on FULL or PARTIAL, * respectively). * * Execution: * * Note: This version uses MPI for user routines, and the CVODES * solver. In what follows, N is the number of processors, * N = NPEX*NPEY (see constants below) and it is assumed that * the MPI script mpirun is used to run a parallel * application. * If no sensitivities are desired: * % mpirun -np N cvsAdvDiff_FSA_non_p -nosensi * If sensitivities are to be computed: * % mpirun -np N cvsAdvDiff_FSA_non_p -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg, stg1} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundary */ #define MX 10 /* mesh dimension */ #define NEQ MX /* number of equations */ #define ATOL RCONST(1.e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.5) /* first output time */ #define DTOUT RCONST(0.5) /* output time increment */ #define NOUT 10 /* number of output times */ #define NP 2 #define NS 2 #define ZERO RCONST(0.0) /* Type : UserData contains problem parameters, grid constants, work array. */ typedef struct { realtype *p; realtype dx; int npes, my_pe; MPI_Comm comm; realtype z[100]; } *UserData; /* Prototypes of user-supplied functins */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Prototypes of private functions */ static void ProcessArgs(int argc, char *argv[], int my_pe, booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(int my_pe, char *name); static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base); static void PrintOutput(void *cvode_mem, int my_pe, realtype t, N_Vector u); static void PrintOutputS(int my_pe, N_Vector *uS); static void PrintFinalStats(void *cvode_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { realtype dx, reltol, abstol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int local_N, nperpe, nrem, my_base; realtype *pbar; int is, *plist; N_Vector *uS; booleantype sensi, err_con; int sensi_meth; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; pbar = NULL; plist = NULL; uS = NULL; /* Get processor number, total number of pe's, and my_pe. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); /* Process arguments */ ProcessArgs(argc, argv, my_pe, &sensi, &sensi_meth, &err_con); /* Set local vector length. */ nperpe = NEQ/npes; nrem = NEQ - npes*nperpe; local_N = (my_pe < nrem) ? nperpe+1 : nperpe; my_base = (my_pe < nrem) ? my_pe*local_N : my_pe*nperpe + nrem; /* USER DATA STRUCTURE */ data = (UserData) malloc(sizeof *data); /* Allocate data memory */ data->p = NULL; if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->comm = comm; data->npes = npes; data->my_pe = my_pe; data->p = (realtype *) malloc(NP * sizeof(realtype)); if(check_flag((void *)data->p, "malloc", 2, my_pe)) MPI_Abort(comm, 1); dx = data->dx = XMAX/((realtype)(MX+1)); data->p[0] = RCONST(1.0); data->p[1] = RCONST(0.5); /* INITIAL STATES */ u = N_VNew_Parallel(comm, local_N, NEQ); /* Allocate u vector */ if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetIC(u, dx, local_N, my_base); /* Initialize u vector */ /* TOLERANCES */ reltol = ZERO; /* Set the tolerances */ abstol = ATOL; /* CVODE_CREATE & CVODE_MALLOC */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) { printf("\n1-D advection-diffusion equation, mesh size =%3d \n", MX); printf("\nNumber of PEs = %3d \n",npes); } if(sensi) { plist = (int *) malloc(NS * sizeof(int)); if(check_flag((void *)plist, "malloc", 2, my_pe)) MPI_Abort(comm, 1); for(is=0; isp[plist[is]]; uS = N_VCloneVectorArray_Parallel(NS, u); if(check_flag((void *)uS, "N_VCloneVectorArray_Parallel", 0, my_pe)) MPI_Abort(comm, 1); for(is=0;isp, pbar, plist); if(check_flag(&flag, "CVodeSetSensParams", 1, my_pe)) MPI_Abort(comm, 1); if(my_pe == 0) { printf("Sensitivity: YES "); if(sensi_meth == CV_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +"); else printf("( STAGGERED1 +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } } else { if(my_pe == 0) printf("Sensitivity: NO "); } /* In loop over output points, call CVode, print results, test for error */ if(my_pe == 0) { printf("\n\n"); printf("============================================================\n"); printf(" T Q H NST Max norm \n"); printf("============================================================\n"); } for (iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, t, u); if (sensi) { flag = CVodeGetSens(cvode_mem, &t, uS); if(check_flag(&flag, "CVodeGetSens", 1, my_pe)) break; PrintOutputS(my_pe, uS); } if (my_pe == 0) printf("------------------------------------------------------------\n"); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem, sensi); /* Free memory */ N_VDestroy(u); /* Free the u vector */ if (sensi) N_VDestroyVectorArray(uS, NS); /* Free the uS vectors */ free(data->p); /* Free the p vector */ free(data); /* Free block of UserData */ CVodeFree(&cvode_mem); /* Free the CVODES problem memory */ free(pbar); if(sensi) free(plist); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype ui, ult, urt, hordc, horac, hdiff, hadv; realtype *udata, *dudata, *z; realtype dx; int i; int npes, my_pe, my_length, my_pe_m1, my_pe_p1, last_pe, my_last; UserData data; MPI_Status status; MPI_Comm comm; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); /* Extract needed problem constants from data */ data = (UserData) user_data; dx = data->dx; hordc = data->p[0]/(dx*dx); horac = data->p[1]/(RCONST(2.0)*dx); /* Extract parameters for parallel computation. */ comm = data->comm; npes = data->npes; /* Number of processes. */ my_pe = data->my_pe; /* Current process number. */ my_length = NV_LOCLENGTH_P(u); /* Number of local elements of u. */ z = data->z; /* Compute related parameters. */ my_pe_m1 = my_pe - 1; my_pe_p1 = my_pe + 1; last_pe = npes - 1; my_last = my_length - 1; /* Store local segment of u in the working array z. */ for (i = 1; i <= my_length; i++) z[i] = udata[i - 1]; /* Pass needed data to processes before and after current process. */ if (my_pe != 0) MPI_Send(&z[1], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm); if (my_pe != last_pe) MPI_Send(&z[my_length], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm); /* Receive needed data from processes before and after current process. */ if (my_pe != 0) MPI_Recv(&z[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status); else z[0] = ZERO; if (my_pe != last_pe) MPI_Recv(&z[my_length+1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status); else z[my_length + 1] = ZERO; /* Loop over all grid points in current process. */ for (i=1; i<=my_length; i++) { /* Extract u at x_i and two neighboring points */ ui = z[i]; ult = z[i-1]; urt = z[i+1]; /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - RCONST(2.0)*ui + urt); hadv = horac*(urt - ult); dudata[i-1] = hdiff + hadv; } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Process and verify arguments to cvsfwdnonx_p. */ static void ProcessArgs(int argc, char *argv[], int my_pe, booleantype *sensi, int *sensi_meth, booleantype *err_con) { *sensi = FALSE; *sensi_meth = -1; *err_con = FALSE; if (argc < 2) WrongArgs(my_pe, argv[0]); if (strcmp(argv[1],"-nosensi") == 0) *sensi = FALSE; else if (strcmp(argv[1],"-sensi") == 0) *sensi = TRUE; else WrongArgs(my_pe, argv[0]); if (*sensi) { if (argc != 4) WrongArgs(my_pe, argv[0]); if (strcmp(argv[2],"sim") == 0) *sensi_meth = CV_SIMULTANEOUS; else if (strcmp(argv[2],"stg") == 0) *sensi_meth = CV_STAGGERED; else if (strcmp(argv[2],"stg1") == 0) *sensi_meth = CV_STAGGERED1; else WrongArgs(my_pe, argv[0]); if (strcmp(argv[3],"t") == 0) *err_con = TRUE; else if (strcmp(argv[3],"f") == 0) *err_con = FALSE; else WrongArgs(my_pe, argv[0]); } } static void WrongArgs(int my_pe, char *name) { if (my_pe == 0) { printf("\nUsage: %s [-nosensi] [-sensi sensi_meth err_con]\n",name); printf(" sensi_meth = sim, stg, or stg1\n"); printf(" err_con = t or f\n"); } MPI_Finalize(); exit(0); } /* * Set initial conditions in u vector */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base) { int i; long int iglobal; realtype x; realtype *udata; /* Set pointer to data array and get local length of u. */ udata = NV_DATA_P(u); my_length = NV_LOCLENGTH_P(u); /* Load initial profile into u vector */ for (i=1; i<=my_length; i++) { iglobal = my_base + i; x = iglobal*dx; udata[i-1] = x*(XMAX - x)*EXP(2.0*x); } } /* * Print current t, step count, order, stepsize, and max norm of solution */ static void PrintOutput(void *cvode_mem, int my_pe, realtype t, N_Vector u) { long int nst; int qu, flag; realtype hu, umax; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); umax = N_VMaxNorm(u); if (my_pe == 0) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.3Le %2d %8.3Le %5ld\n", t,qu,hu,nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.3le %2d %8.3le %5ld\n", t,qu,hu,nst); #else printf("%8.3e %2d %8.3e %5ld\n", t,qu,hu,nst); #endif printf(" Solution "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le \n", umax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le \n", umax); #else printf("%12.4e \n", umax); #endif } } /* * Print max norm of sensitivities */ static void PrintOutputS(int my_pe, N_Vector *uS) { realtype smax; smax = N_VMaxNorm(uS[0]); if (my_pe == 0) { printf(" Sensitivity 1 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le \n", smax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le \n", smax); #else printf("%12.4e \n", smax); #endif } smax = N_VMaxNorm(uS[1]); if (my_pe == 0) { printf(" Sensitivity 2 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le \n", smax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le \n", smax); #else printf("%12.4e \n", smax); #endif } } /* * Print some final statistics located in the iopt array */ static void PrintFinalStats(void *cvode_mem, booleantype sensi) { long int nst; long int nfe, nsetups, nni, ncfn, netf; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); if (sensi) { flag = CVodeGetSensNumRhsEvals(cvode_mem, &nfSe); check_flag(&flag, "CVodeGetSensNumRhsEvals", 1, 0); flag = CVodeGetNumRhsEvalsSens(cvode_mem, &nfeS); check_flag(&flag, "CVodeGetNumRhsEvalsSens", 1, 0); flag = CVodeGetSensNumLinSolvSetups(cvode_mem, &nsetupsS); check_flag(&flag, "CVodeGetSensNumLinSolvSetups", 1, 0); flag = CVodeGetSensNumErrTestFails(cvode_mem, &netfS); check_flag(&flag, "CVodeGetSensNumErrTestFails", 1, 0); flag = CVodeGetSensNumNonlinSolvIters(cvode_mem, &nniS); check_flag(&flag, "CVodeGetSensNumNonlinSolvIters", 1, 0); flag = CVodeGetSensNumNonlinSolvConvFails(cvode_mem, &ncfnS); check_flag(&flag, "CVodeGetSensNumNonlinSolvConvFails", 1, 0); } printf("\nFinal Statistics\n\n"); printf("nst = %5ld\n\n", nst); printf("nfe = %5ld\n", nfe); printf("netf = %5ld nsetups = %5ld\n", netf, nsetups); printf("nni = %5ld ncfn = %5ld\n", nni, ncfn); if(sensi) { printf("\n"); printf("nfSe = %5ld nfeS = %5ld\n", nfSe, nfeS); printf("netfs = %5ld nsetupsS = %5ld\n", netfS, nsetupsS); printf("nniS = %5ld ncfnS = %5ld\n", nniS, ncfnS); } } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/CMakeLists.txt0000600000175000017500000001000411741421151023637 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the CVODES parallel examples # Add variable CVODES_examples with the names of the parallel CVODES examples SET(CVODES_examples cvsAdvDiff_ASAp_non_p cvsAdvDiff_FSA_non_p cvsAdvDiff_non_p cvsAtmDisp_ASAi_kry_bbd_p cvsDiurnal_FSA_kry_p cvsDiurnal_kry_bbd_p cvsDiurnal_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the C compiler to the MPICC script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODES_LIB sundials_cvodes_static) SET(NVECP_LIB sundials_nvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODES_LIB sundials_cvodes_shared) SET(NVECP_LIB sundials_nvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${CVODES_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each CVODES example FOREACH(example ${CVODES_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPICC) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPICC) FILE(GLOB example_out ${example}.out*) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example_out} DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODES_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODES") SET(SOLVER_LIB "sundials_cvodes") LIST2STRING(CVODES_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvodes/parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvodes/parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvodes/parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvodes/parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvodes/parallel/Makefile.in0000600000175000017500000000725311741421151023160 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for CVODES parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/cvodes/libsundials_cvodes.la $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = cvsAdvDiff_ASAp_non_p \ cvsAdvDiff_FSA_non_p \ cvsAdvDiff_non_p \ cvsAtmDisp_ASAi_kry_bbd_p \ cvsDiurnal_FSA_kry_p \ cvsDiurnal_kry_bbd_p \ cvsDiurnal_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(SUNDIALS_INCS) -I$(MPI_INC_DIR) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(MPICC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}$(OBJ_EXT) $(MPI_FLAGS) $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/cvodes/parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvodes/parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/parallel/README $(EXS_INSTDIR)/cvodes/parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/parallel/$${i}.c $(EXS_INSTDIR)/cvodes/parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/parallel/$${i}.out $(EXS_INSTDIR)/cvodes/parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/cvodes/parallel/Makefile rm -f $(EXS_INSTDIR)/cvodes/parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvodes/parallel/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvodes/parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/cvodes/parallel $(rminstalldirs) $(EXS_INSTDIR)/cvodes clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_kry_p.c0000600000175000017500000010077711741421151024602 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 23:00:48 $ * ----------------------------------------------------------------- * Programmer(s): S. D. Cohen, A. C. Hindmarsh, M. R. Wittman, and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * mesh, with simple polynomial initial profiles. * * The problem is solved by CVODES on NPE processors, treated * as a rectangular process grid of size NPEX by NPEY, with * NPE = NPEX*NPEY. Each processor contains a subgrid of size MXSUB * by MYSUB of the (x,y) mesh. Thus the actual mesh sizes are * MX = MXSUB*NPEX and MY = MYSUB*NPEY, and the ODE system size is * neq = 2*MX*MY. * * The solution is done with the BDF/GMRES method (i.e. using the * CVSPGMR linear solver) and the block-diagonal part of the * Newton matrix as a left preconditioner. A copy of the * block-diagonal part of the Jacobian is saved and conditionally * reused within the preconditioner routine. * * Performance data and sampled solution values are printed at * selected output times, and all performance counters are printed * on completion. * * This version uses MPI for user routines. * * Execution: mpirun -np N cvsDiurnal_kry_p with N = NPEX*NPEY * (see constants below). * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* prototypes and constants for CVSPGMR solver */ #include /* definition N_Vector and macro NV_DATA_P */ #include /* prototypes for small dense matrix fcts. */ #include /* definitions of realtype, booleantype */ #include /* definition of macros SQR and EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define NVARS 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 RCONST(0.0) /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN RCONST(0.0) /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define NPEX 2 /* no. PEs in x direction of PE array */ #define NPEY 2 /* no. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* no. x points per subgrid */ #define MYSUB 5 /* no. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ /* CVodeMalloc Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ /* User-defined matrix accessor macro: IJth */ /* IJth is defined in order to write code which indexes into dense matrices with a (row,column) pair, where 1 <= row,column <= NVARS. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NVARS. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains problem constants, preconditioner blocks, pivot arrays, grid constants, and processor indices, as well as data needed for the preconditiner */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; realtype uext[NVARS*(MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby; long int nvmxsub, nvmxsub2; MPI_Comm comm; /* For preconditioner */ realtype **P[MXSUB][MYSUB], **Jbd[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; } *UserData; /* Private Helper Functions */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, UserData data); static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype udata[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]); static void ucomm(realtype t, N_Vector u, UserData data); static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int neq, local_N; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; /* Set problem size neq */ neq = NVARS*MX*MY; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate and load user data block; allocate preconditioner block */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, comm, data); /* Allocate u, and set initial values and tolerances */ u = N_VNew_Parallel(comm, local_N, neq); if (check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1); SetInitialProfiles(u, data); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if (check_flag(&flag, "CVSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Set preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if (check_flag(&flag, "CVSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) printf("\n2-species diurnal advection-diffusion problem\n\n"); /* In loop over output points, call CVode, print results, test for error */ for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if (check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, comm, u, t); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem); /* Free memory */ N_VDestroy_Parallel(u); FreeUserData(data); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /*********************** Private Helper Functions ************************/ /* Load constants in data */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data) { int isubx, isuby; int lx, ly; /* Set problem constants */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/((realtype)(MX-1)); data->dy = (YMAX-YMIN)/((realtype)(MY-1)); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0; /* Set machine-related constants */ data->comm = comm; data->my_pe = my_pe; /* isubx and isuby are the PE grid indices corresponding to my_pe */ isuby = my_pe/NPEX; isubx = my_pe - isuby*NPEX; data->isubx = isubx; data->isuby = isuby; /* Set the sizes of a boundary x-line in u and uext */ data->nvmxsub = NVARS*MXSUB; data->nvmxsub2 = NVARS*(MXSUB+2); /* Preconditioner-related fields */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { (data->P)[lx][ly] = newDenseMat(NVARS, NVARS); (data->Jbd)[lx][ly] = newDenseMat(NVARS, NVARS); (data->pivot)[lx][ly] = newLintArray(NVARS); } } } /* Free user data memory */ static void FreeUserData(UserData data) { int lx, ly; for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { destroyMat((data->P)[lx][ly]); destroyMat((data->Jbd)[lx][ly]); destroyArray((data->pivot)[lx][ly]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, UserData data) { int isubx, isuby, lx, ly, jx, jy; long int offset; realtype dx, dy, x, y, cx, cy, xmid, ymid; realtype *udata; /* Set pointer to data array in vector u */ udata = NV_DATA_P(u); /* Get mesh spacings, and subgrid indices for this PE */ dx = data->dx; dy = data->dy; isubx = data->isubx; isuby = data->isuby; /* Load initial profiles of c1 and c2 into local u vector. Here lx and ly are local mesh point indices on the local subgrid, and jx and jy are the global mesh point indices. */ offset = 0; xmid = RCONST(0.5)*(XMIN + XMAX); ymid = RCONST(0.5)*(YMIN + YMAX); for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - ymid)); cy = RCONST(1.0) - cy + RCONST(0.5)*SQR(cy); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - xmid)); cx = RCONST(1.0) - cx + RCONST(0.5)*SQR(cx); udata[offset ] = C1_SCALE*cx*cy; udata[offset+1] = C2_SCALE*cx*cy; offset = offset + 2; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t) { int qu, flag; realtype hu, *udata, tempu[2]; int npelast; long int i0, i1, nst; MPI_Status status; npelast = NPEX*NPEY - 1; udata = NV_DATA_P(u); /* Send c1,c2 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&udata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { tempu[0] = udata[i0]; tempu[1] = udata[i1]; } } /* On PE 0, receive c1,c2 at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3le %12.3le \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3le %12.3le \n\n", tempu[0], tempu[1]); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]); printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]); #endif } } /* Print final statistics contained in iopt */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1, 0); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1, 0); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1, 0); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1, 0); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1, 0); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1, 0); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1, 0); printf("\nFinal Statistics: \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfels = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype udata[]) { int i, ly; long int offsetu, offsetbuf; realtype bufleft[NVARS*MYSUB], bufright[NVARS*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&udata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&udata[offsetu], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = ly*dsizex; for (i = 0; i < NVARS; i++) bufleft[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = offsetbuf*MXSUB + (MXSUB-1)*NVARS; for (i = 0; i < NVARS; i++) bufright[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Routine to start receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Irecv(&uext[NVARS], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) { offsetue = NVARS*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* Routine to finish receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]) { int i, ly; long int dsizex2, offsetue, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NVARS; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+1)*dsizex2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+2)*dsizex2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufright[offsetbuf+i]; } } } /* ucomm routine. This routine performs all communication between processors of data needed to calculate f. */ static void ucomm(realtype t, N_Vector u, UserData data) { realtype *udata, *uext, buffer[2*NVARS*MYSUB]; MPI_Comm comm; int my_pe, isubx, isuby; long int nvmxsub, nvmysub; MPI_Request request[4]; udata = NV_DATA_P(u); /* Get comm, my_pe, subgrid indices, data sizes, extended array uext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmysub = NVARS*MYSUB; uext = data->uext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, udata); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer); } /* fcalc routine. Compute f(t,y). This routine assumes that communication between processors of data needed to calculate f has already been done, and this data is in the work array uext. */ static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data) { realtype *uext; realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int i, lx, ly, jx, jy; int isubx, isuby; long int nvmxsub, nvmxsub2, offsetu, offsetue; /* Get subgrid indices, data sizes, extended work array uext */ isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2; uext = data->uext; /* Copy local segment of u vector into the working extended array uext */ offsetu = 0; offsetue = nvmxsub2 + NVARS; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; offsetu = offsetu + nvmxsub; offsetue = offsetue + nvmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of u to uext */ /* If isuby = 0, copy x-line 2 of u to uext */ if (isuby == 0) { for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = udata[nvmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */ if (isuby == NPEY-1) { offsetu = (MYSUB-2)*nvmxsub; offsetue = (MYSUB+1)*nvmxsub2 + NVARS; for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; } /* If isubx = 0, copy y-line 2 of u to uext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*nvmxsub + NVARS; offsetue = (ly+1)*nvmxsub2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = (ly+1)*nvmxsub - 2*NVARS; offsetue = (ly+2)*nvmxsub2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* Make local copies of problem variables, for efficiency */ dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Set diurnal rate coefficients as functions of t, and save q4 in data block for use by preconditioner evaluation routine */ s = sin((data->om)*t); if (s > RCONST(0.0)) { q3 = EXP(-A3/s); q4coef = EXP(-A4/s); } else { q3 = RCONST(0.0); q4coef = RCONST(0.0); } data->q4 = q4coef; /* Loop over all grid points in local subgrid */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; /* Extract c1 and c2, and set kinetic rate terms */ offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2; c1 = uext[offsetue]; c2 = uext[offsetue+1]; qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + RCONST(2.0)*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms */ c1dn = uext[offsetue-nvmxsub2]; c2dn = uext[offsetue-nvmxsub2+1]; c1up = uext[offsetue+nvmxsub2]; c2up = uext[offsetue+nvmxsub2+1]; vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms */ c1lt = uext[offsetue-2]; c2lt = uext[offsetue-1]; c1rt = uext[offsetue+2]; c2rt = uext[offsetue+3]; hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt); hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into dudata */ offsetu = lx*NVARS + ly*nvmxsub; dudata[offsetu] = vertd1 + hord1 + horad1 + rkin1; dudata[offsetu+1] = vertd2 + hord2 + horad2 + rkin2; } } } /***************** Functions Called by the Solver *************************/ /* f routine. Evaluate f(t,y). First call ucomm to do communication of subgrid boundary data into uext. Then calculate f by a call to fcalc. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype *udata, *dudata; UserData data; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); data = (UserData) user_data; /* Call ucomm to do inter-processor communication */ ucomm(t, u, data); /* Call fcalc to calculate all right-hand sides */ fcalc(t, udata, dudata, data); return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MYSUB], **(*Jbd)[MYSUB]; long int nvmxsub, offset; long int *(*pivot)[MYSUB], ier; int lx, ly, jx, jy, isubx, isuby; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, pointer to u's data, and PE index pair */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_P(u); isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseCopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + RCONST(2.0)*hordco); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; offset = lx*NVARS + ly*nvmxsub; c1 = udata[offset]; c2 = udata[offset+1]; j = Jbd[lx][ly]; a = P[lx][ly]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NVARS, NVARS); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseScale(-gamma, P[lx][ly], NVARS, NVARS); /* Add identity matrix and do LU decompositions on blocks in place */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { denseAddIdentity(P[lx][ly], NVARS); ier = denseGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MYSUB]; long int nvmxsub; long int *(*pivot)[MYSUB]; int lx, ly; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data */ data = (UserData) user_data; P = data->P; pivot = data->pivot; /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. First copy vector r to z. */ N_VScale(RCONST(1.0), r, z); nvmxsub = data->nvmxsub; zdata = NV_DATA_P(z); for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { v = &(zdata[lx*NVARS + ly*nvmxsub]); denseGETRS(P[lx][ly], NVARS, pivot[lx][ly], v); } } return(0); } /*********************** Private Helper Function ************************/ /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_kry_p.out0000600000175000017500000000454211741421151025160 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 307 order = 4 stepsize = 1.98e+02 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 335 order = 5 stepsize = 1.17e+02 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 388 order = 4 stepsize = 4.48e+02 At bottom left: c1, c2 = -5.732e-07 3.382e+11 At top right: c1, c2 = -6.367e-07 3.804e+11 t = 5.04e+04 no. steps = 406 order = 5 stepsize = 3.97e+02 At bottom left: c1, c2 = -4.317e-09 3.358e+11 At top right: c1, c2 = -8.233e-09 3.864e+11 t = 5.76e+04 no. steps = 418 order = 5 stepsize = 4.74e+02 At bottom left: c1, c2 = -2.576e-09 3.320e+11 At top right: c1, c2 = -1.259e-09 3.909e+11 t = 6.48e+04 no. steps = 428 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 3.451e-09 3.313e+11 At top right: c1, c2 = 2.081e-09 3.963e+11 t = 7.20e+04 no. steps = 437 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 1.630e-11 3.330e+11 At top right: c1, c2 = 1.843e-11 4.039e+11 t = 7.92e+04 no. steps = 447 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = -1.704e-11 3.334e+11 At top right: c1, c2 = -1.131e-11 4.120e+11 t = 8.64e+04 no. steps = 456 order = 5 stepsize = 7.70e+02 At bottom left: c1, c2 = 1.496e-12 3.352e+11 At top right: c1, c2 = 8.085e-13 4.163e+11 Final Statistics: lenrw = 2096 leniw = 132 lenrwls = 2046 leniwls = 80 nst = 456 nfe = 586 nfels = 619 nni = 582 nli = 619 nsetups = 73 netf = 25 npe = 8 nps = 1149 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvodes/parallel/cvsAtmDisp_ASAi_kry_bbd_p.out0000600000175000017500000000204011741421151026556 0ustar sylvestresylvestre Parallel Krylov adjoint sensitivity analysis example 3D Advection diffusion PDE with homogeneous Neumann B.C. Computes gradient of G = int_t_Omega ( c_i^2 ) dt dOmega with respect to the source values at each grid point. Domain: 0.000000 < x < 20.000000 mx = 20 npe_x = 2 0.000000 < y < 20.000000 my = 40 npe_y = 2 0.000000 < z < 20.000000 mz = 20 npe_z = 1 Begin forward integration... done. G = 8.232843e+03 Final Statistics.. lenrw = 180946 leniw = 212 llrw = 180856 lliw = 80 nst = 118 nfe = 125 nfel = 141 nni = 121 nli = 141 nsetups = 17 netf = 0 npe = 2 nps = 234 ncfn = 0 ncfl = 0 Begin backward integration... done. Final Statistics.. lenrw = 361716 leniw = 212 llrw = 180856 lliw = 80 nst = 70 nfe = 80 nfel = 133 nni = 76 nli = 133 nsetups = 15 netf = 0 npe = 2 nps = 204 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_ASAp_non_p.out0000600000175000017500000000077111741421151025716 0ustar sylvestresylvestreg(tf) = 2.446335e-02 dgdp(tf) [ 1]: -1.502544e-01 [ 2]: -1.098456e-02 mu(t0) [ 1]: 2.775571e-04 [ 2]: 5.625276e-04 [ 3]: 8.474242e-04 [ 4]: 1.127515e-03 [ 5]: 1.393257e-03 [ 6]: 1.641212e-03 [ 7]: 1.860490e-03 [ 8]: 2.049401e-03 [ 9]: 2.196614e-03 [10]: 2.302527e-03 [11]: 2.356404e-03 [12]: 2.360902e-03 [13]: 2.306966e-03 [14]: 2.199483e-03 [15]: 2.032115e-03 [16]: 1.811731e-03 [17]: 1.535589e-03 [18]: 1.212084e-03 [19]: 8.426858e-04 [20]: 4.366699e-04 sundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_non_p.out0000600000175000017500000000135511741421151025051 0ustar sylvestresylvestre 1-D advection-diffusion equation, mesh size = 10 Number of PEs = 4 At t = 0.00 max.norm(u) = 1.569909e+01 nst = 0 At t = 0.50 max.norm(u) = 3.052881e+00 nst = 113 At t = 1.00 max.norm(u) = 8.753188e-01 nst = 191 At t = 1.50 max.norm(u) = 2.494926e-01 nst = 265 At t = 2.00 max.norm(u) = 7.109707e-02 nst = 339 At t = 2.50 max.norm(u) = 2.026223e-02 nst = 418 At t = 3.00 max.norm(u) = 5.777332e-03 nst = 486 At t = 3.50 max.norm(u) = 1.650483e-03 nst = 563 At t = 4.00 max.norm(u) = 4.754357e-04 nst = 646 At t = 4.50 max.norm(u) = 1.374222e-04 nst = 715 At t = 5.00 max.norm(u) = 3.937469e-05 nst = 795 Final Statistics: nst = 795 nfe = 1465 nni = 1461 ncfn = 146 netf = 5 sundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_non_p.c0000600000175000017500000002645211741421151024471 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:30 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, George Byrne, * and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the program for * its solution by CVODES. The problem is the semi-discrete * form of the advection-diffusion equation in 1-D: * du/dt = d^2 u / dx^2 + .5 du/dx * on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. * Homogeneous Dirichlet boundary conditions are posed, and the * initial condition is the following: * u(x,t=0) = x(2-x)exp(2x) . * The PDE is discretized on a uniform grid of size MX+2 with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX. * This program solves the problem with the option for nonstiff * systems: ADAMS method and functional iteration. * It uses scalar relative and absolute tolerances. * Output is printed at t = .5, 1.0, ..., 5. * Run statistics (optional outputs) are printed at the end. * * This version uses MPI for user routines. * Execute with Number of Processors = N, with 1 <= N <= MX. * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* definition of N_Vector and macros */ #include /* definition of realtype */ #include /* definition of EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define ZERO RCONST(0.0) #define XMAX RCONST(2.0) /* domain boundary */ #define MX 10 /* mesh dimension */ #define NEQ MX /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 ZERO /* initial time */ #define T1 RCONST(0.5) /* first output time */ #define DTOUT RCONST(0.5) /* output time increment */ #define NOUT 10 /* number of output times */ /* Type : UserData contains grid constants, parallel machine parameters, work array. */ typedef struct { realtype dx, hdcoef, hacoef; int npes, my_pe; MPI_Comm comm; realtype z[100]; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base); static void PrintIntro(int npes); static void PrintData(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { realtype dx, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int local_N, nperpe, nrem, my_base, nst; MPI_Comm comm; u = NULL; data = NULL; cvode_mem = NULL; /* Get processor number, total number of pe's, and my_pe. */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); /* Set local vector length. */ nperpe = NEQ/npes; nrem = NEQ - npes*nperpe; local_N = (my_pe < nrem) ? nperpe+1 : nperpe; my_base = (my_pe < nrem) ? my_pe*local_N : my_pe*nperpe + nrem; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->comm = comm; data->npes = npes; data->my_pe = my_pe; u = N_VNew_Parallel(comm, local_N, NEQ); /* Allocate u vector */ if(check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; dx = data->dx = XMAX/((realtype)(MX+1)); /* Set grid coefficients in data */ data->hdcoef = RCONST(1.0)/(dx*dx); data->hacoef = RCONST(0.5)/(RCONST(2.0)*dx); SetIC(u, dx, local_N, my_base); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Adams-Moulton LMM and the use of a functional iteration */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); if (my_pe == 0) PrintIntro(npes); umax = N_VMaxNorm(u); if (my_pe == 0) { t = T0; PrintData(t, umax, 0); } /* In loop over output points, call CVode, print results, test for error */ for (iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); if (my_pe == 0) PrintData(t, umax, nst); } if (my_pe == 0) PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Parallel(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free user data */ MPI_Finalize(); return(0); } /************************ Private Helper Functions ***********************/ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base) { int i; long int iglobal; realtype x; realtype *udata; /* Set pointer to data array and get local length of u. */ udata = NV_DATA_P(u); my_length = NV_LOCLENGTH_P(u); /* Load initial profile into u vector */ for (i=1; i<=my_length; i++) { iglobal = my_base + i; x = iglobal*dx; udata[i-1] = x*(XMAX - x)*EXP(RCONST(2.0)*x); } } /* Print problem introduction */ static void PrintIntro(int npes) { printf("\n 1-D advection-diffusion equation, mesh size =%3d \n", MX); printf("\n Number of PEs = %3d \n\n", npes); return; } /* Print data */ static void PrintData(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst =%4ld \n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst =%4ld \n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst =%4ld \n", t, umax, nst); #endif return; } /* Print some final statistics located in the iopt array */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nni, ncfn, netf; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); printf("\nFinal Statistics: \n\n"); printf("nst = %-6ld nfe = %-6ld ", nst, nfe); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); } /***************** Function Called by the Solver ***********************/ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype ui, ult, urt, hordc, horac, hdiff, hadv; realtype *udata, *dudata, *z; int i; int npes, my_pe, my_length, my_pe_m1, my_pe_p1, last_pe, my_last; UserData data; MPI_Status status; MPI_Comm comm; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); /* Extract needed problem constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; /* Extract parameters for parallel computation. */ comm = data->comm; npes = data->npes; /* Number of processes. */ my_pe = data->my_pe; /* Current process number. */ my_length = NV_LOCLENGTH_P(u); /* Number of local elements of u. */ z = data->z; /* Compute related parameters. */ my_pe_m1 = my_pe - 1; my_pe_p1 = my_pe + 1; last_pe = npes - 1; my_last = my_length - 1; /* Store local segment of u in the working array z. */ for (i = 1; i <= my_length; i++) z[i] = udata[i - 1]; /* Pass needed data to processes before and after current process. */ if (my_pe != 0) MPI_Send(&z[1], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm); if (my_pe != last_pe) MPI_Send(&z[my_length], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm); /* Receive needed data from processes before and after current process. */ if (my_pe != 0) MPI_Recv(&z[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status); else z[0] = ZERO; if (my_pe != last_pe) MPI_Recv(&z[my_length+1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status); else z[my_length + 1] = ZERO; /* Loop over all grid points in current process. */ for (i=1; i<=my_length; i++) { /* Extract u at x_i and two neighboring points */ ui = z[i]; ult = z[i-1]; urt = z[i+1]; /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - RCONST(2.0)*ui + urt); hadv = horac*(urt - ult); dudata[i-1] = hdiff + hadv; } return(0); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/cvsAtmDisp_ASAi_kry_bbd_p.c0000600000175000017500000010356711741421151026211 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/14 22:15:31 $ * ----------------------------------------------------------------- * Programmer(s): Lukas Jager and Radu Serban @ LLNL * ----------------------------------------------------------------- * Parallel Krylov adjoint sensitivity example problem. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #include /* *------------------------------------------------------------------ * Constants *------------------------------------------------------------------ */ #ifdef USE3D #define DIM 3 #else #define DIM 2 #endif /* Domain definition */ #define XMIN RCONST(0.0) #define XMAX RCONST(20.0) #define MX 20 /* no. of divisions in x dir. */ #define NPX 2 /* no. of procs. in x dir. */ #define YMIN RCONST(0.0) #define YMAX RCONST(20.0) #define MY 40 /* no. of divisions in y dir. */ #define NPY 2 /* no. of procs. in y dir. */ #ifdef USE3D #define ZMIN RCONST(0.0) #define ZMAX RCONST(20.0) #define MZ 20 /* no. of divisions in z dir. */ #define NPZ 1 /* no. of procs. in z dir. */ #endif /* Parameters for source Gaussians */ #define G1_AMPL RCONST(1.0) #define G1_SIGMA RCONST(1.7) #define G1_X RCONST(4.0) #define G1_Y RCONST(8.0) #ifdef USE3D #define G1_Z RCONST(8.0) #endif #define G2_AMPL RCONST(0.8) #define G2_SIGMA RCONST(3.0) #define G2_X RCONST(16.0) #define G2_Y RCONST(12.0) #ifdef USE3D #define G2_Z RCONST(12.0) #endif #define G_MIN RCONST(1.0e-5) /* Diffusion coeff., max. velocity, domain width in y dir. */ #define DIFF_COEF RCONST(1.0) #define V_MAX RCONST(1.0) #define L (YMAX-YMIN)/RCONST(2.0) #define V_COEFF V_MAX/L/L /* Initial and final times */ #define ti RCONST(0.0) #define tf RCONST(10.0) /* Integration tolerances */ #define RTOL RCONST(1.0e-8) /* states */ #define ATOL RCONST(1.0e-6) #define RTOL_Q RCONST(1.0e-8) /* forward quadrature */ #define ATOL_Q RCONST(1.0e-6) #define RTOL_B RCONST(1.0e-8) /* adjoint variables */ #define ATOL_B RCONST(1.0e-6) #define RTOL_QB RCONST(1.0e-8) /* backward quadratures */ #define ATOL_QB RCONST(1.0e-6) /* Steps between check points */ #define STEPS 200 #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* *------------------------------------------------------------------ * Macros *------------------------------------------------------------------ */ #define FOR_DIM for(dim=0; dim 1) output = TRUE; else output = FALSE; /* Allocate and set problem data structure */ d = (ProblemData) malloc(sizeof *d); SetData(d, comm, npes, myId, &neq, &l_neq); if (myId == 0) PrintHeader(); /*-------------------------- Forward integration phase --------------------------*/ /* Allocate space for y and set it with the I.C. */ y = N_VNew_Parallel(comm, l_neq, neq); N_VConst(ZERO, y); /* Allocate and initialize qB (local contribution to cost) */ q = N_VNew_Parallel(comm, 1, npes); N_VConst(ZERO, q); /* Create CVODES object, attach user data, and allocate space */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); flag = CVodeSetUserData(cvode_mem, d); flag = CVodeInit(cvode_mem, f, ti, y); abstol = ATOL; reltol = RTOL; flag = CVodeSStolerances(cvode_mem, reltol, abstol); /* attach linear solver */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); /* Attach preconditioner and linear solver modules */ mudq = mldq = d->l_m[0]+1; mukeep = mlkeep = 2; flag = CVBBDPrecInit(cvode_mem, l_neq, mudq, mldq, mukeep, mlkeep, ZERO, f_local, NULL); /* Initialize quadrature calculations */ abstolQ = ATOL_Q; reltolQ = RTOL_Q; flag = CVodeQuadInit(cvode_mem, fQ, q); flag = CVodeQuadSStolerances(cvode_mem, reltolQ, abstolQ); flag = CVodeSetQuadErrCon(cvode_mem, TRUE); /* Allocate space for the adjoint calculation */ flag = CVodeAdjInit(cvode_mem, STEPS, CV_HERMITE); /* Integrate forward in time while storing check points */ if (myId == 0) printf("Begin forward integration... "); flag = CVodeF(cvode_mem, tf, y, &tret, CV_NORMAL, &ncheckpnt); if (myId == 0) printf("done. "); /* Extract quadratures */ flag = CVodeGetQuad(cvode_mem, &tret, q); qdata = NV_DATA_P(q); MPI_Allreduce(&qdata[0], &G, 1, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); #if defined(SUNDIALS_EXTENDED_PRECISION) if (myId == 0) printf(" G = %Le\n",G); #elif defined(SUNDIALS_DOUBLE_PRECISION) if (myId == 0) printf(" G = %le\n",G); #else if (myId == 0) printf(" G = %e\n",G); #endif /* Print statistics for forward run */ if (myId == 0) PrintFinalStats(cvode_mem); /*-------------------------- Backward integration phase --------------------------*/ /* Allocate and initialize yB */ yB = N_VNew_Parallel(comm, l_neq, neq); N_VConst(ZERO, yB); /* Allocate and initialize qB (gradient) */ qB = N_VNew_Parallel(comm, l_neq, neq); N_VConst(ZERO, qB); /* Create and allocate backward CVODE memory */ flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB); flag = CVodeSetUserDataB(cvode_mem, indexB, d); flag = CVodeInitB(cvode_mem, indexB, fB, tf, yB); abstolB = ATOL_B; reltolB = RTOL_B; flag = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB); /* Attach preconditioner and linear solver modules */ flag = CVSpgmrB(cvode_mem, indexB, PREC_LEFT, 0); mudqB = mldqB = d->l_m[0]+1; mukeepB = mlkeepB = 2; flag = CVBBDPrecInitB(cvode_mem, indexB, l_neq, mudqB, mldqB, mukeepB, mlkeepB, ZERO, fB_local, NULL); /* Initialize quadrature calculations */ abstolQB = ATOL_QB; reltolQB = RTOL_QB; flag = CVodeQuadInitB(cvode_mem, indexB, fQB, qB); flag = CVodeQuadSStolerancesB(cvode_mem, indexB, reltolQB, abstolQB); flag = CVodeSetQuadErrConB(cvode_mem, indexB, TRUE); /* Integrate backwards */ if (myId == 0) printf("Begin backward integration... "); flag = CVodeB(cvode_mem, ti, CV_NORMAL); if (myId == 0) printf("done.\n"); /* Extract solution */ flag = CVodeGetB(cvode_mem, indexB, &tret, yB); /* Extract quadratures */ flag = CVodeGetQuadB(cvode_mem, indexB, &tret, qB); /* Print statistics for backward run */ if (myId == 0) { PrintFinalStats(CVodeGetAdjCVodeBmem(cvode_mem, indexB)); } /* Process 0 collects the gradient components and prints them */ if (output) { OutputGradient(myId, qB, d); if (myId == 0) printf("Wrote matlab file 'grad.m'.\n"); } /* Free memory */ N_VDestroy_Parallel(y); N_VDestroy_Parallel(q); N_VDestroy_Parallel(qB); N_VDestroy_Parallel(yB); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /* *------------------------------------------------------------------ * SetData: * Allocate space for the ProblemData structure. * Set fields in the ProblemData structure. * Return local and global problem dimensions. * * SetSource: * Instantiates the source parameters for a combination of two * Gaussian sources. *------------------------------------------------------------------ */ static void SetData(ProblemData d, MPI_Comm comm, int npes, int myId, long int *neq, long int *l_neq) { int n[DIM], nd[DIM]; int dim, size; /* Set MPI communicator, id, and total number of processes */ d->comm = comm; d->myId = myId; d->npes = npes; /* Set domain boundaries */ d->xmin[0] = XMIN; d->xmax[0] = XMAX; d->m[0] = MX; d->xmin[1] = YMIN; d->xmax[1] = YMAX; d->m[1] = MY; #ifdef USE3D d->xmin[2] = ZMIN; d->xmax[2] = ZMAX; d->m[2] = MZ; #endif /* Calculate grid spacing and differential volume */ d->dOmega = ONE; FOR_DIM { d->dx[dim] = (d->xmax[dim] - d->xmin[dim]) / d->m[dim]; d->m[dim] +=1; d->dOmega *= d->dx[dim]; } /* Set partitioning */ d->num_procs[0] = NPX; n[0] = NPX; nd[0] = d->m[0] / NPX; d->num_procs[1] = NPY; n[1] = NPY; nd[1] = d->m[1] / NPY; #ifdef USE3D d->num_procs[2] = NPZ; n[2] = NPZ; nd[2] = d->m[2] / NPZ; #endif /* Compute the neighbors */ d->nbr_left[0] = (myId%n[0]) == 0 ? myId : myId-1; d->nbr_right[0] = (myId%n[0]) == n[0]-1 ? myId : myId+1; d->nbr_left[1] = (myId/n[0])%n[1] == 0 ? myId : myId-n[0]; d->nbr_right[1] = (myId/n[0])%n[1] == n[1]-1 ? myId : myId+n[0]; #ifdef USE3D d->nbr_left[2] = (myId/n[0]/n[1])%n[2] == 0 ? myId : myId-n[0]*n[1]; d->nbr_right[2] = (myId/n[0]/n[1])%n[2] == n[2]-1 ? myId : myId+n[0]*n[1]; #endif /* Compute the local subdomains m_start: left border in global index space l_m: length of the subdomain */ d->m_start[0] = (myId%n[0])*nd[0]; d->l_m[0] = d->nbr_right[0] == myId ? d->m[0] - d->m_start[0] : nd[0]; d->m_start[1] = ((myId/n[0])%n[1])*nd[1]; d->l_m[1] = d->nbr_right[1] == myId ? d->m[1] - d->m_start[1] : nd[1]; #ifdef USE3D d->m_start[2] = (myId/n[0]/n[1])*nd[2]; d->l_m[2] = d->nbr_right[2] == myId ? d->m[2] - d->m_start[2] : nd[2]; #endif /* Allocate memory for the y_ext array (local solution + data from neighbors) */ size = 1; FOR_DIM size *= d->l_m[dim]+2; d->y_ext = (realtype *) malloc( size*sizeof(realtype)); /* Initialize Buffer field. Size of buffer is checked when needed */ d->buf_send = NULL; d->buf_recv = NULL; d->buf_size = 0; /* Allocate space for the source parameters */ *neq = 1; *l_neq = 1; FOR_DIM {*neq *= d->m[dim]; *l_neq *= d->l_m[dim];} d->p = N_VNew_Parallel(comm, *l_neq, *neq); /* Initialize the parameters for a source with Gaussian profile */ SetSource(d); } static void SetSource(ProblemData d) { int *l_m, *m_start; realtype *xmin, *xmax, *dx; realtype x[DIM], g, *pdata; int i[DIM]; l_m = d->l_m; m_start = d->m_start; xmin = d->xmin; xmax = d->xmax; dx = d->dx; pdata = NV_DATA_P(d->p); for(i[0]=0; i[0]comm; id = d->myId; /* extract data from domain*/ FOR_DIM { n[dim] = d->num_procs[dim]; l_m[dim] = d->l_m[dim]; } yextdata = d->y_ext; ydata = NV_DATA_P(y); /* Calculate required buffer size */ FOR_DIM { size *= l_m[dim]; if( l_m[dim] < small) small = l_m[dim]; } size /= small; /* Adjust buffer size if necessary */ if( d->buf_size < size ) { d->buf_send = (realtype*) realloc( d->buf_send, size * sizeof(realtype)); d->buf_recv = (realtype*) realloc( d->buf_recv, size * sizeof(realtype)); d->buf_size = size; } buf_send = d->buf_send; buf_recv = d->buf_recv; /* Compute the communication pattern; who sends first? */ /* if proc_cond==1 , process sends first in this dimension */ proc_cond[0] = (id%n[0])%2; proc_cond[1] = ((id/n[0])%n[1])%2; #ifdef USE3D proc_cond[2] = (id/n[0]/n[1])%2; #endif /* Compute the actual communication pattern */ /* nbr[dim][0] is first proc to communicate with in dimension dim */ /* nbr[dim][1] the second one */ FOR_DIM { nbr[dim][proc_cond[dim]] = d->nbr_left[dim]; nbr[dim][!proc_cond[dim]] = d->nbr_right[dim]; } /* Communication: loop over dimension and direction (left/right) */ FOR_DIM { for (dir=0; dir<=1; dir++) { /* If subdomain at boundary, no communication in this direction */ if (id != nbr[dim][dir]) { c=0; /* Compute the index of the boundary (right or left) */ i[dim] = (dir ^ proc_cond[dim]) ? (l_m[dim]-1) : 0; /* Loop over all other dimensions and copy data into buf_send */ l[0]=(dim+1)%DIM; #ifdef USE3D l[1]=(dim+2)%DIM; for(i[l[1]]=0; i[l[1]]l_m[dim]; /* Do all inter-processor communication */ f_comm(l_neq, t, y, user_data); /* Compute right-hand side locally */ f_local(l_neq, t, y, ydot, user_data); return(0); } static int f_local(long int Nlocal, realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype *Ydata, *dydata, *pdata; realtype dx[DIM], c, v[DIM], cl[DIM], cr[DIM]; realtype adv[DIM], diff[DIM]; realtype xmin[DIM], xmax[DIM], x[DIM], x1; int i[DIM], l_m[DIM], m_start[DIM], nbr_left[DIM], nbr_right[DIM], id; ProblemData d; int dim; d = (ProblemData) user_data; /* Extract stuff from data structure */ id = d->myId; FOR_DIM { xmin[dim] = d->xmin[dim]; xmax[dim] = d->xmax[dim]; l_m[dim] = d->l_m[dim]; m_start[dim] = d->m_start[dim]; dx[dim] = d->dx[dim]; nbr_left[dim] = d->nbr_left[dim]; nbr_right[dim] = d->nbr_right[dim]; } /* Get pointers to vector data */ dydata = NV_DATA_P(ydot); pdata = NV_DATA_P(d->p); /* Copy local segment of y to y_ext */ Load_yext(NV_DATA_P(y), d); Ydata = d->y_ext; /* Velocity components in x1 and x2 directions (Poiseuille profile) */ v[1] = ZERO; #ifdef USE3D v[2] = ZERO; #endif /* Local domain is [xmin+(m_start+1)*dx, xmin+(m_start+1+l_m-1)*dx] */ #ifdef USE3D for(i[2]=0; i[2]dOmega); return(0); } /* *------------------------------------------------------------------ * fB and fB_local: * Backward phase ODE right-hand side (the discretized adjoint PDE) *------------------------------------------------------------------ */ static int fB(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB) { ProblemData d; long int l_neq=1; int dim; d = (ProblemData) user_dataB; FOR_DIM l_neq *= d->l_m[dim]; /* Do all inter-processor communication */ f_comm(l_neq, t, yB, user_dataB); /* Compute right-hand side locally */ fB_local(l_neq, t, y, yB, yBdot, user_dataB); return(0); } static int fB_local(long int NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector dyB, void *user_dataB) { realtype *YBdata, *dyBdata, *ydata; realtype dx[DIM], c, v[DIM], cl[DIM], cr[DIM]; realtype adv[DIM], diff[DIM]; realtype xmin[DIM], xmax[DIM], x[DIM], x1; int i[DIM], l_m[DIM], m_start[DIM], nbr_left[DIM], nbr_right[DIM], id; ProblemData d; int dim; d = (ProblemData) user_dataB; /* Extract stuff from data structure */ id = d->myId; FOR_DIM { xmin[dim] = d->xmin[dim]; xmax[dim] = d->xmax[dim]; l_m[dim] = d->l_m[dim]; m_start[dim] = d->m_start[dim]; dx[dim] = d->dx[dim]; nbr_left[dim] = d->nbr_left[dim]; nbr_right[dim] = d->nbr_right[dim]; } dyBdata = NV_DATA_P(dyB); ydata = NV_DATA_P(y); /* Copy local segment of yB to y_ext */ Load_yext(NV_DATA_P(yB), d); YBdata = d->y_ext; /* Velocity components in x1 and x2 directions (Poiseuille profile) */ v[1] = ZERO; #ifdef USE3D v[2] = ZERO; #endif /* local domain is [xmin+(m_start)*dx, xmin+(m_start+l_m-1)*dx] */ #ifdef USE3D for(i[2]=0; i[2]dOmega), yB, qBdot); return(0); } /* *------------------------------------------------------------------ * Load_yext: * copies data from src (y or yB) into y_ext, which already contains * data from neighboring processes. *------------------------------------------------------------------ */ static void Load_yext(realtype *src, ProblemData d) { int i[DIM], l_m[DIM], dim; FOR_DIM l_m[dim] = d->l_m[dim]; /* copy local segment */ #ifdef USE3D for (i[2]=0; i[2]y_ext, i) = IJth(src, i); } /* *------------------------------------------------------------------ * PrintHeader: * Print first lins of output (problem description) *------------------------------------------------------------------ */ static void PrintHeader() { printf("\nParallel Krylov adjoint sensitivity analysis example\n"); printf("%1dD Advection diffusion PDE with homogeneous Neumann B.C.\n",DIM); printf("Computes gradient of G = int_t_Omega ( c_i^2 ) dt dOmega\n"); printf("with respect to the source values at each grid point.\n\n"); printf("Domain:\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lf < x < %Lf mx = %d npe_x = %d \n",XMIN,XMAX,MX,NPX); printf(" %Lf < y < %Lf my = %d npe_y = %d \n",YMIN,YMAX,MY,NPY); #else printf(" %f < x < %f mx = %d npe_x = %d \n",XMIN,XMAX,MX,NPX); printf(" %f < y < %f my = %d npe_y = %d \n",YMIN,YMAX,MY,NPY); #endif #ifdef USE3D #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lf < z < %Lf mz = %d npe_z = %d \n",ZMIN,ZMAX,MZ,NPZ); #else printf(" %f < z < %f mz = %d npe_z = %d \n",ZMIN,ZMAX,MZ,NPZ); #endif #endif printf("\n"); } /* *------------------------------------------------------------------ * PrintFinalStats: * Print final statistics contained in cvode_mem *------------------------------------------------------------------ */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwSPGMR, leniwSPGMR; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeSPGMR; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); flag = CVodeGetNumSteps(cvode_mem, &nst); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwSPGMR, &leniwSPGMR); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeSPGMR); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %6ld leniw = %6ld\n", lenrw, leniw); printf("llrw = %6ld lliw = %6ld\n", lenrwSPGMR, leniwSPGMR); printf("nst = %6ld\n" , nst); printf("nfe = %6ld nfel = %6ld\n" , nfe, nfeSPGMR); printf("nni = %6ld nli = %6ld\n" , nni, nli); printf("nsetups = %6ld netf = %6ld\n" , nsetups, netf); printf("npe = %6ld nps = %6ld\n" , npe, nps); printf("ncfn = %6ld ncfl = %6ld\n\n", ncfn, ncfl); } /* *------------------------------------------------------------------ * OutputGradient: * Generate matlab m files for visualization * One file gradXXXX.m from each process + a driver grad.m *------------------------------------------------------------------ */ static void OutputGradient(int myId, N_Vector qB, ProblemData d) { FILE *fid; char filename[20]; int *l_m, *m_start, i[DIM],ip; realtype *xmin, *xmax, *dx; realtype x[DIM], *pdata, p, *qBdata, g; sprintf(filename,"grad%03d.m",myId); fid = fopen(filename,"w"); l_m = d->l_m; m_start = d->m_start; xmin = d->xmin; xmax = d->xmax; dx = d->dx; qBdata = NV_DATA_P(qB); pdata = NV_DATA_P(d->p); /* Write matlab files with solutions from each process */ for(i[0]=0; i[0]npes; ip++) { fprintf(fid,"\ngrad%03d;\n",ip); fprintf(fid,"[X,Y,Z]=meshgrid(x%d,y%d,z%d);\n",ip,ip,ip); fprintf(fid,"s%d=slice(X,Y,Z,g%d,xp,yp,zp);\n",ip,ip); fprintf(fid,"for i = 1:ns\n"); fprintf(fid," set(s%d(i),'FaceAlpha',trans);\n",ip); fprintf(fid," set(s%d(i),'EdgeColor',ecol);\n",ip); fprintf(fid,"end\n"); } fprintf(fid,"view(3)\n"); fprintf(fid,"\nshading interp\naxis equal\n"); #else fprintf(fid,"clear;\nfigure;\n"); fprintf(fid,"trans = 0.7;\n"); fprintf(fid,"ecol = 'none';\n"); for (ip=0; ipnpes; ip++) { fprintf(fid,"\ngrad%03d;\n",ip); fprintf(fid,"\nsubplot(1,2,1)\n"); fprintf(fid,"s=surf(x%d,y%d,g%d);\n",ip,ip,ip); fprintf(fid,"set(s,'FaceAlpha',trans);\n"); fprintf(fid,"set(s,'EdgeColor',ecol);\n"); fprintf(fid,"hold on\n"); fprintf(fid,"axis tight\n"); fprintf(fid,"box on\n"); fprintf(fid,"\nsubplot(1,2,2)\n"); fprintf(fid,"s=surf(x%d,y%d,p%d);\n",ip,ip,ip); fprintf(fid,"set(s,'CData',g%d);\n",ip); fprintf(fid,"set(s,'FaceAlpha',trans);\n"); fprintf(fid,"set(s,'EdgeColor',ecol);\n"); fprintf(fid,"hold on\n"); fprintf(fid,"axis tight\n"); fprintf(fid,"box on\n"); } #endif fclose(fid); } } sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_kry_bbd_p.out0000600000175000017500000001230011741421151025756 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem 10 by 10 mesh on 4 processors Using CVBBDPRE preconditioner module Difference-quotient half-bandwidths are mudq = 10, mldq = 10 Retained band block half-bandwidths are mukeep = 2, mlkeep = 2 Preconditioner type is: jpre = PREC_LEFT t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.61e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 221 order = 5 stepsize = 3.85e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 247 order = 5 stepsize = 3.00e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 272 order = 4 stepsize = 4.05e+02 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 309 order = 4 stepsize = 7.53e+01 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 377 order = 4 stepsize = 4.02e+02 At bottom left: c1, c2 = 1.908e-07 3.382e+11 At top right: c1, c2 = 2.345e-07 3.804e+11 t = 5.04e+04 no. steps = 392 order = 5 stepsize = 3.67e+02 At bottom left: c1, c2 = -6.408e-10 3.358e+11 At top right: c1, c2 = -6.654e-10 3.864e+11 t = 5.76e+04 no. steps = 403 order = 5 stepsize = 4.72e+02 At bottom left: c1, c2 = 2.017e-08 3.320e+11 At top right: c1, c2 = 3.353e-08 3.909e+11 t = 6.48e+04 no. steps = 415 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = -2.502e-10 3.313e+11 At top right: c1, c2 = 2.005e-10 3.963e+11 t = 7.20e+04 no. steps = 424 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 4.217e-12 3.330e+11 At top right: c1, c2 = -2.693e-12 4.039e+11 t = 7.92e+04 no. steps = 434 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 2.779e-12 3.334e+11 At top right: c1, c2 = -1.865e-12 4.120e+11 t = 8.64e+04 no. steps = 444 order = 5 stepsize = 7.47e+02 At bottom left: c1, c2 = 2.331e-13 3.352e+11 At top right: c1, c2 = -1.599e-13 4.163e+11 Final Statistics: lenrw = 2096 leniw = 132 lenrwls = 2046 leniwls = 80 nst = 444 nfe = 581 nfels = 526 nni = 577 nli = 526 nsetups = 75 netf = 28 npe = 8 nps = 1057 ncfn = 0 ncfl = 0 In CVBBDPRE: real/integer local work space sizes = 600, 50 no. flocal evals. = 176 ------------------------------------------------------------------- Preconditioner type is: jpre = PREC_RIGHT t = 7.20e+03 no. steps = 191 order = 5 stepsize = 1.22e+02 At bottom left: c1, c2 = 1.047e+04 2.527e+11 At top right: c1, c2 = 1.119e+04 2.700e+11 t = 1.44e+04 no. steps = 223 order = 5 stepsize = 2.79e+02 At bottom left: c1, c2 = 6.659e+06 2.582e+11 At top right: c1, c2 = 7.301e+06 2.833e+11 t = 2.16e+04 no. steps = 249 order = 5 stepsize = 4.31e+02 At bottom left: c1, c2 = 2.665e+07 2.993e+11 At top right: c1, c2 = 2.931e+07 3.313e+11 t = 2.88e+04 no. steps = 314 order = 3 stepsize = 9.38e+01 At bottom left: c1, c2 = 8.702e+06 3.380e+11 At top right: c1, c2 = 9.650e+06 3.751e+11 t = 3.60e+04 no. steps = 350 order = 5 stepsize = 9.78e+01 At bottom left: c1, c2 = 1.404e+04 3.387e+11 At top right: c1, c2 = 1.561e+04 3.765e+11 t = 4.32e+04 no. steps = 403 order = 4 stepsize = 3.87e+02 At bottom left: c1, c2 = 1.504e-09 3.382e+11 At top right: c1, c2 = 1.683e-09 3.804e+11 t = 5.04e+04 no. steps = 416 order = 5 stepsize = 5.91e+02 At bottom left: c1, c2 = -1.137e-11 3.358e+11 At top right: c1, c2 = -1.439e-11 3.864e+11 t = 5.76e+04 no. steps = 432 order = 5 stepsize = 1.73e+02 At bottom left: c1, c2 = 1.293e-09 3.320e+11 At top right: c1, c2 = 2.448e-10 3.909e+11 t = 6.48e+04 no. steps = 447 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = 7.963e-13 3.313e+11 At top right: c1, c2 = -2.943e-13 3.963e+11 t = 7.20e+04 no. steps = 459 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = -2.414e-12 3.330e+11 At top right: c1, c2 = 2.797e-13 4.039e+11 t = 7.92e+04 no. steps = 470 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = -1.059e-13 3.334e+11 At top right: c1, c2 = 3.557e-14 4.120e+11 t = 8.64e+04 no. steps = 481 order = 5 stepsize = 6.38e+02 At bottom left: c1, c2 = 6.045e-15 3.352e+11 At top right: c1, c2 = -2.016e-15 4.163e+11 Final Statistics: lenrw = 2096 leniw = 132 lenrwls = 2046 leniwls = 80 nst = 481 nfe = 622 nfels = 769 nni = 618 nli = 769 nsetups = 104 netf = 33 npe = 9 nps = 1281 ncfn = 0 ncfl = 0 In CVBBDPRE: real/integer local work space sizes = 600, 50 no. flocal evals. = 198 sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_FSA_kry_p.c0000600000175000017500000012142511741421151025264 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 23:00:48 $ * ----------------------------------------------------------------- * Programmer(s): S. D. Cohen, A. C. Hindmarsh, Radu Serban, * and M. R. Wittman @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * mesh, with simple polynomial initial profiles. * * The problem is solved by CVODES on NPE processors, treated * as a rectangular process grid of size NPEX by NPEY, with * NPE = NPEX*NPEY. Each processor contains a subgrid of size * MXSUB by MYSUB of the (x,y) mesh. Thus the actual mesh sizes * are MX = MXSUB*NPEX and MY = MYSUB*NPEY, and the ODE system size * is neq = 2*MX*MY. * * The solution with CVODES is done with the BDF/GMRES method (i.e. * using the CVSPGMR linear solver) and the block-diagonal part of * the Newton matrix as a left preconditioner. A copy of the * block-diagonal part of the Jacobian is saved and conditionally * reused within the Precond routine. * * Performance data and sampled solution values are printed at * selected output times, and all performance counters are printed * on completion. * * Optionally, CVODES can compute sensitivities with respect to the * problem parameters q1 and q2. * Any of three sensitivity methods (SIMULTANEOUS, STAGGERED, and * STAGGERED1) can be used and sensitivities may be included in the * error test or not (error control set on FULL or PARTIAL, * respectively). * * Execution: * * Note: This version uses MPI for user routines, and the CVODES * solver. In what follows, N is the number of processors, * N = NPEX*NPEY (see constants below) and it is assumed that * the MPI script mpirun is used to run a paralles * application. * If no sensitivities are desired: * % mpirun -np N cvsDiurnal_FSA_kry_p -nosensi * If sensitivities are to be computed: * % mpirun -np N cvsDiurnal_FSA_kry_p -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg, stg1} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include #include /* main CVODES header file */ #include /* defs. for CVSPGMR fcts. and constants */ #include /* defs of par. NVECTOR fcts. and macros */ #include /* generic DENSE solver used in prec. */ #include /* contains macros SQR and EXP */ #include /* def. of realtype */ #include /* Problem Constants */ #define NVARS 2 /* number of species */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 RCONST(0.0) /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN RCONST(0.0) /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define NPEX 2 /* no. PEs in x direction of PE array */ #define NPEY 2 /* no. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* no. x points per subgrid */ #define MYSUB 5 /* no. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tols. */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ /* Sensitivity constants */ #define NP 8 /* number of problem parameters */ #define NS 2 /* number of sensitivities */ #define ZERO RCONST(0.0) /* User-defined matrix accessor macro: IJth */ /* IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row,column <= NVARS. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NVARS. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJth(a,i,j) (a[j-1][i-1]) /* Types : UserData and PreconData contain problem parameters, problem constants, preconditioner blocks, pivot arrays, grid constants, and processor indices, as well as data needed for preconditioning */ typedef struct { realtype *p; realtype q4, om, dx, dy, hdco, haco, vdco; realtype uext[NVARS*(MXSUB+2)*(MYSUB+2)]; long int my_pe, isubx, isuby, nvmxsub, nvmxsub2; MPI_Comm comm; /* For preconditioner */ realtype **P[MXSUB][MYSUB], **Jbd[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; } *UserData; /* Functions Called by the CVODES Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Private Helper Functions */ static void ProcessArgs(int argc, char *argv[], int my_pe, booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(int my_pe, char *name); static void InitUserData(int my_pe, MPI_Comm comm, UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, UserData data); static void BSend(MPI_Comm comm, int my_pe, long int isubx, long int isuby, long int dsizex, long int dsizey, realtype udata[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, long int isubx, long int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], long int isubx, long int isuby, long int dsizex, realtype uext[], realtype buffer[]); static void ucomm(realtype t, N_Vector u, UserData data); static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data); static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, realtype t, N_Vector u); static void PrintOutputS(int my_pe, MPI_Comm comm, N_Vector *uS); static void PrintFinalStats(void *cvode_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag, my_pe, npes; long int neq, local_N; MPI_Comm comm; realtype *pbar; int is, *plist; N_Vector *uS; booleantype sensi, err_con; int sensi_meth; u = NULL; data = NULL; cvode_mem = NULL; pbar = NULL; plist = NULL; uS = NULL; /* Set problem size neq */ neq = NVARS*MX*MY; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Process arguments */ ProcessArgs(argc, argv, my_pe, &sensi, &sensi_meth, &err_con); /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate and load user data block; allocate preconditioner block */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->p = NULL; data->p = (realtype *) malloc(NP*sizeof(realtype)); if (check_flag((void *)data->p, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, comm, data); /* Allocate u, and set initial values and tolerances */ u = N_VNew_Parallel(comm, local_N, neq); if (check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetInitialProfiles(u, data); abstol = ATOL; reltol = RTOL; /* Create CVODES object, set optional input, allocate memory */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetMaxNumSteps(cvode_mem, 2000); if (check_flag(&flag, "CVodeSetMaxNumSteps", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeInit(cvode_mem, f, T0, u); if (check_flag(&flag, "CVodeInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) MPI_Abort(comm, 1); /* Attach linear solver CVSPGMR */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if (check_flag(&flag, "CVSpgmr", 1, my_pe)) MPI_Abort(comm, 1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if (check_flag(&flag, "CVSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1); if(my_pe == 0) printf("\n2-species diurnal advection-diffusion problem\n"); /* Sensitivity-related settings */ if( sensi) { plist = (int *) malloc(NS * sizeof(int)); if (check_flag((void *)plist, "malloc", 2, my_pe)) MPI_Abort(comm, 1); for (is=0; isp[plist[is]]; uS = N_VCloneVectorArray_Parallel(NS, u); if (check_flag((void *)uS, "N_VCloneVectorArray_Parallel", 0, my_pe)) MPI_Abort(comm, 1); for (is = 0; is < NS; is++) N_VConst(ZERO,uS[is]); flag = CVodeSensInit1(cvode_mem, NS, sensi_meth, NULL, uS); if (check_flag(&flag, "CVodeSensInit1", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSensEEtolerances(cvode_mem); if (check_flag(&flag, "CVodeSensEEtolerances", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensErrCon(cvode_mem, err_con); if (check_flag(&flag, "CVodeSetSensErrCon", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensDQMethod(cvode_mem, CV_CENTERED, ZERO); if (check_flag(&flag, "CVodeSetSensDQMethod", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetSensParams(cvode_mem, data->p, pbar, plist); if (check_flag(&flag, "CVodeSetSensParams", 1, my_pe)) MPI_Abort(comm, 1); if(my_pe == 0) { printf("Sensitivity: YES "); if(sensi_meth == CV_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +"); else printf("( STAGGERED1 +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } } else { if(my_pe == 0) printf("Sensitivity: NO "); } if (my_pe == 0) { printf("\n\n"); printf("========================================================================\n"); printf(" T Q H NST Bottom left Top right \n"); printf("========================================================================\n"); } /* In loop over output points, call CVode, print results, test for error */ for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if (check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, comm, t, u); if (sensi) { flag = CVodeGetSens(cvode_mem, &t, uS); if (check_flag(&flag, "CVodeGetSens", 1, my_pe)) break; PrintOutputS(my_pe, comm, uS); } if (my_pe == 0) printf("------------------------------------------------------------------------\n"); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem, sensi); /* Free memory */ N_VDestroy_Parallel(u); if (sensi) { N_VDestroyVectorArray_Parallel(uS, NS); free(plist); free(pbar); } FreeUserData(data); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Evaluate f(t,y). First call ucomm to do communication of * subgrid boundary data into uext. Then calculate f by a call to fcalc. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype *udata, *dudata; UserData data; udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); data = (UserData) user_data; /* Call ucomm to do inter-processor communicaiton */ ucomm (t, u, data); /* Call fcalc to calculate all right-hand sides */ fcalc (t, udata, dudata, data); return(0); } /* * Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MYSUB], **(*Jbd)[MYSUB]; long int *(*pivot)[MYSUB], ier, nvmxsub, offset; int lx, ly, jx, jy, isubx, isuby; realtype *udata, **a, **j; UserData data; realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; /* Make local copies of pointers in user_data, pointer to u's data, and PE index pair */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_P(u); isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; /* Load problem coefficients and parameters */ Q1 = data->p[0]; Q2 = data->p[1]; C3 = data->p[2]; A3 = data->p[3]; A4 = data->p[4]; KH = data->p[5]; VEL = data->p[6]; KV0 = data->p[7]; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseCopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + RCONST(2.0)*hordco); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; offset = lx*NVARS + ly*nvmxsub; c1 = udata[offset]; c2 = udata[offset+1]; j = Jbd[lx][ly]; a = P[lx][ly]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NVARS, NVARS); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denseScale(-gamma, P[lx][ly], NVARS, NVARS); /* Add identity matrix and do LU decompositions on blocks in place */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { denseAddIdentity(P[lx][ly], NVARS); ier = denseGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]); if (ier != 0) return(1); } } return(0); } /* * Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MYSUB]; long int *(*pivot)[MYSUB], nvmxsub; int lx, ly; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data */ data = (UserData) user_data; P = data->P; pivot = data->pivot; /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. First copy vector r to z. */ N_VScale(RCONST(1.0), r, z); nvmxsub = data->nvmxsub; zdata = NV_DATA_P(z); for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { v = &(zdata[lx*NVARS + ly*nvmxsub]); denseGETRS(P[lx][ly], NVARS, pivot[lx][ly], v); } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Process and verify arguments to cvsfwdkryx_p. */ static void ProcessArgs(int argc, char *argv[], int my_pe, booleantype *sensi, int *sensi_meth, booleantype *err_con) { *sensi = FALSE; *sensi_meth = -1; *err_con = FALSE; if (argc < 2) WrongArgs(my_pe, argv[0]); if (strcmp(argv[1],"-nosensi") == 0) *sensi = FALSE; else if (strcmp(argv[1],"-sensi") == 0) *sensi = TRUE; else WrongArgs(my_pe, argv[0]); if (*sensi) { if (argc != 4) WrongArgs(my_pe, argv[0]); if (strcmp(argv[2],"sim") == 0) *sensi_meth = CV_SIMULTANEOUS; else if (strcmp(argv[2],"stg") == 0) *sensi_meth = CV_STAGGERED; else if (strcmp(argv[2],"stg1") == 0) *sensi_meth = CV_STAGGERED1; else WrongArgs(my_pe, argv[0]); if (strcmp(argv[3],"t") == 0) *err_con = TRUE; else if (strcmp(argv[3],"f") == 0) *err_con = FALSE; else WrongArgs(my_pe, argv[0]); } } static void WrongArgs(int my_pe, char *name) { if (my_pe == 0) { printf("\nUsage: %s [-nosensi] [-sensi sensi_meth err_con]\n",name); printf(" sensi_meth = sim, stg, or stg1\n"); printf(" err_con = t or f\n"); } MPI_Finalize(); exit(0); } /* * Set user data. */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data) { long int isubx, isuby; int lx, ly; realtype KH, VEL, KV0; /* Set problem parameters */ data->p[0] = RCONST(1.63e-16); /* Q1 coeffs. q1, q2, c3 */ data->p[1] = RCONST(4.66e-16); /* Q2 */ data->p[2] = RCONST(3.7e16); /* C3 */ data->p[3] = RCONST(22.62); /* A3 coeff. in expression for q3(t) */ data->p[4] = RCONST(7.601); /* A4 coeff. in expression for q4(t) */ KH = data->p[5] = RCONST(4.0e-6); /* KH horizontal diffusivity Kh */ VEL = data->p[6] = RCONST(0.001); /* VEL advection velocity V */ KV0 = data->p[7] = RCONST(1.0e-8); /* KV0 coeff. in Kv(z) */ /* Set problem constants */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/((realtype)(MX-1)); data->dy = (YMAX-YMIN)/((realtype)(MY-1)); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0; /* Set machine-related constants */ data->comm = comm; data->my_pe = my_pe; /* isubx and isuby are the PE grid indices corresponding to my_pe */ isuby = my_pe/NPEX; isubx = my_pe - isuby*NPEX; data->isubx = isubx; data->isuby = isuby; /* Set the sizes of a boundary x-line in u and uext */ data->nvmxsub = NVARS*MXSUB; data->nvmxsub2 = NVARS*(MXSUB+2); /* Preconditioner-related fields */ for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { (data->P)[lx][ly] = newDenseMat(NVARS, NVARS); (data->Jbd)[lx][ly] = newDenseMat(NVARS, NVARS); (data->pivot)[lx][ly] = newLintArray(NVARS); } } } /* * Free user data memory. */ static void FreeUserData(UserData data) { int lx, ly; for (lx = 0; lx < MXSUB; lx++) { for (ly = 0; ly < MYSUB; ly++) { destroyMat((data->P)[lx][ly]); destroyMat((data->Jbd)[lx][ly]); destroyArray((data->pivot)[lx][ly]); } } free(data->p); free(data); } /* * Set initial conditions in u. */ static void SetInitialProfiles(N_Vector u, UserData data) { long int isubx, isuby, lx, ly, jx, jy, offset; realtype dx, dy, x, y, cx, cy, xmid, ymid; realtype *udata; /* Set pointer to data array in vector u */ udata = NV_DATA_P(u); /* Get mesh spacings, and subgrid indices for this PE */ dx = data->dx; dy = data->dy; isubx = data->isubx; isuby = data->isuby; /* Load initial profiles of c1 and c2 into local u vector. Here lx and ly are local mesh point indices on the local subgrid, and jx and jy are the global mesh point indices. */ offset = 0; xmid = RCONST(0.5)*(XMIN + XMAX); ymid = RCONST(0.5)*(YMIN + YMAX); for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - ymid)); cy = RCONST(1.0) - cy + RCONST(0.5)*SQR(cy); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - xmid)); cx = RCONST(1.0) - cx + RCONST(0.5)*SQR(cx); udata[offset ] = C1_SCALE*cx*cy; udata[offset+1] = C2_SCALE*cx*cy; offset = offset + 2; } } } /* * Routine to send boundary data to neighboring PEs. */ static void BSend(MPI_Comm comm, int my_pe, long int isubx, long int isuby, long int dsizex, long int dsizey, realtype udata[]) { int i, ly; long int offsetu, offsetbuf; realtype bufleft[NVARS*MYSUB], bufright[NVARS*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&udata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&udata[offsetu], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = ly*dsizex; for (i = 0; i < NVARS; i++) bufleft[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = offsetbuf*MXSUB + (MXSUB-1)*NVARS; for (i = 0; i < NVARS; i++) bufright[offsetbuf+i] = udata[offsetu+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, long int isubx, long int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Irecv(&uext[NVARS], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) { offsetue = NVARS*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be * passed to both the BRecvPost and BRecvWait functions, and should not * be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], long int isubx, long int isuby, long int dsizex, realtype uext[], realtype buffer[]) { int i, ly; long int dsizex2, offsetue, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NVARS; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+1)*dsizex2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+2)*dsizex2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufright[offsetbuf+i]; } } } /* * ucomm routine. This routine performs all communication * between processors of data needed to calculate f. */ static void ucomm(realtype t, N_Vector u, UserData data) { realtype *udata, *uext, buffer[2*NVARS*MYSUB]; MPI_Comm comm; int my_pe; long int isubx, isuby, nvmxsub, nvmysub; MPI_Request request[4]; udata = NV_DATA_P(u); /* Get comm, my_pe, subgrid indices, data sizes, extended array uext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmysub = NVARS*MYSUB; uext = data->uext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, udata); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer); } /* * fcalc routine. Compute f(t,y). This routine assumes that communication * between processors of data needed to calculate f has already been done, * and this data is in the work array uext. */ static void fcalc(realtype t, realtype udata[], realtype dudata[], UserData data) { realtype *uext; realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int i, lx, ly, jx, jy; long int isubx, isuby, nvmxsub, nvmxsub2, offsetu, offsetue; realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; /* Get subgrid indices, data sizes, extended work array uext */ isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2; uext = data->uext; /* Load problem coefficients and parameters */ Q1 = data->p[0]; Q2 = data->p[1]; C3 = data->p[2]; A3 = data->p[3]; A4 = data->p[4]; KH = data->p[5]; VEL = data->p[6]; KV0 = data->p[7]; /* Copy local segment of u vector into the working extended array uext */ offsetu = 0; offsetue = nvmxsub2 + NVARS; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; offsetu = offsetu + nvmxsub; offsetue = offsetue + nvmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of u to uext */ /* If isuby = 0, copy x-line 2 of u to uext */ if (isuby == 0) { for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = udata[nvmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */ if (isuby == NPEY-1) { offsetu = (MYSUB-2)*nvmxsub; offsetue = (MYSUB+1)*nvmxsub2 + NVARS; for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = udata[offsetu+i]; } /* If isubx = 0, copy y-line 2 of u to uext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*nvmxsub + NVARS; offsetue = (ly+1)*nvmxsub2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = (ly+1)*nvmxsub - 2*NVARS; offsetue = (ly+2)*nvmxsub2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = udata[offsetu+i]; } } /* Make local copies of problem variables, for efficiency */ dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Set diurnal rate coefficients as functions of t, and save q4 in data block for use by preconditioner evaluation routine */ s = sin((data->om)*t); if (s > ZERO) { q3 = EXP(-A3/s); q4coef = EXP(-A4/s); } else { q3 = ZERO; q4coef = ZERO; } data->q4 = q4coef; /* Loop over all grid points in local subgrid */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - .5)*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; /* Extract c1 and c2, and set kinetic rate terms */ offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2; c1 = uext[offsetue]; c2 = uext[offsetue+1]; qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + RCONST(2.0)*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms */ c1dn = uext[offsetue-nvmxsub2]; c2dn = uext[offsetue-nvmxsub2+1]; c1up = uext[offsetue+nvmxsub2]; c2up = uext[offsetue+nvmxsub2+1]; vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms */ c1lt = uext[offsetue-2]; c2lt = uext[offsetue-1]; c1rt = uext[offsetue+2]; c2rt = uext[offsetue+3]; hord1 = hordco*(c1rt - 2.0*c1 + c1lt); hord2 = hordco*(c2rt - 2.0*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into dudata */ offsetu = lx*NVARS + ly*nvmxsub; dudata[offsetu] = vertd1 + hord1 + horad1 + rkin1; dudata[offsetu+1] = vertd2 + hord2 + horad2 + rkin2; } } } /* * Print current t, step count, order, stepsize, and sampled c1,c2 values. */ static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, realtype t, N_Vector u) { long int nst; int qu, flag; realtype hu, *udata, tempu[2]; long int npelast, i0, i1; MPI_Status status; npelast = NPEX*NPEY - 1; udata = NV_DATA_P(u); /* Send c at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&udata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { tempu[0] = udata[i0]; tempu[1] = udata[i1]; } } /* On PE 0, receive c at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.3Le %2d %8.3Le %5ld\n", t,qu,hu,nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.3le %2d %8.3le %5ld\n", t,qu,hu,nst); #else printf("%8.3e %2d %8.3e %5ld\n", t,qu,hu,nst); #endif printf(" Solution "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", udata[0], tempu[0]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", udata[0], tempu[0]); #else printf("%12.4e %12.4e \n", udata[0], tempu[0]); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", udata[1], tempu[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", udata[1], tempu[1]); #else printf("%12.4e %12.4e \n", udata[1], tempu[1]); #endif } } /* * Print sampled sensitivity values. */ static void PrintOutputS(int my_pe, MPI_Comm comm, N_Vector *uS) { realtype *sdata, temps[2]; long int npelast, i0, i1; MPI_Status status; npelast = NPEX*NPEY - 1; sdata = NV_DATA_P(uS[0]); /* Send s1 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&sdata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { temps[0] = sdata[i0]; temps[1] = sdata[i1]; } } /* On PE 0, receive s1 at top right, then print sampled sensitivity values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&temps[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); printf(" ----------------------------------------\n"); printf(" Sensitivity 1 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", sdata[0], temps[0]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", sdata[0], temps[0]); #else printf("%12.4e %12.4e \n", sdata[0], temps[0]); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", sdata[1], temps[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", sdata[1], temps[1]); #else printf("%12.4e %12.4e \n", sdata[1], temps[1]); #endif } sdata = NV_DATA_P(uS[1]); /* Send s2 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&sdata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { temps[0] = sdata[i0]; temps[1] = sdata[i1]; } } /* On PE 0, receive s2 at top right, then print sampled sensitivity values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&temps[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); printf(" ----------------------------------------\n"); printf(" Sensitivity 2 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", sdata[0], temps[0]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", sdata[0], temps[0]); #else printf("%12.4e %12.4e \n", sdata[0], temps[0]); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", sdata[1], temps[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", sdata[1], temps[1]); #else printf("%12.4e %12.4e \n", sdata[1], temps[1]); #endif } } /* * Print final statistics from the CVODES memory. */ static void PrintFinalStats(void *cvode_mem, booleantype sensi) { long int nst; long int nfe, nsetups, nni, ncfn, netf; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); if (sensi) { flag = CVodeGetSensNumRhsEvals(cvode_mem, &nfSe); check_flag(&flag, "CVodeGetSensNumRhsEvals", 1, 0); flag = CVodeGetNumRhsEvalsSens(cvode_mem, &nfeS); check_flag(&flag, "CVodeGetNumRhsEvalsSens", 1, 0); flag = CVodeGetSensNumLinSolvSetups(cvode_mem, &nsetupsS); check_flag(&flag, "CVodeGetSensNumLinSolvSetups", 1, 0); flag = CVodeGetSensNumErrTestFails(cvode_mem, &netfS); check_flag(&flag, "CVodeGetSensNumErrTestFails", 1, 0); flag = CVodeGetSensNumNonlinSolvIters(cvode_mem, &nniS); check_flag(&flag, "CVodeGetSensNumNonlinSolvIters", 1, 0); flag = CVodeGetSensNumNonlinSolvConvFails(cvode_mem, &ncfnS); check_flag(&flag, "CVodeGetSensNumNonlinSolvConvFails", 1, 0); } printf("\nFinal Statistics\n\n"); printf("nst = %5ld\n\n", nst); printf("nfe = %5ld\n", nfe); printf("netf = %5ld nsetups = %5ld\n", netf, nsetups); printf("nni = %5ld ncfn = %5ld\n", nni, ncfn); if(sensi) { printf("\n"); printf("nfSe = %5ld nfeS = %5ld\n", nfSe, nfeS); printf("netfs = %5ld nsetupsS = %5ld\n", netfS, nsetupsS); printf("nniS = %5ld ncfnS = %5ld\n", nniS, ncfnS); } } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_FSA_non_p.out0000600000175000017500000000632511741421151025544 0ustar sylvestresylvestre 1-D advection-diffusion equation, mesh size = 10 Number of PEs = 4 Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) ============================================================ T Q H NST Max norm ============================================================ 5.000e-01 4 7.656e-03 115 Solution 3.0529e+00 Sensitivity 1 3.8668e+00 Sensitivity 2 6.2020e-01 ------------------------------------------------------------ 1.000e+00 4 9.504e-03 182 Solution 8.7533e-01 Sensitivity 1 2.1743e+00 Sensitivity 2 1.8909e-01 ------------------------------------------------------------ 1.500e+00 3 4.221e-03 290 Solution 2.4949e-01 Sensitivity 1 9.1826e-01 Sensitivity 2 7.3922e-02 ------------------------------------------------------------ 2.000e+00 2 8.301e-03 375 Solution 7.1098e-02 Sensitivity 1 3.4667e-01 Sensitivity 2 2.8228e-02 ------------------------------------------------------------ 2.500e+00 2 5.100e-03 450 Solution 2.0260e-02 Sensitivity 1 1.2301e-01 Sensitivity 2 1.0085e-02 ------------------------------------------------------------ 3.000e+00 2 7.134e-03 514 Solution 5.7728e-03 Sensitivity 1 4.1956e-02 Sensitivity 2 3.4555e-03 ------------------------------------------------------------ 3.500e+00 2 1.657e-02 586 Solution 1.6450e-03 Sensitivity 1 1.3921e-02 Sensitivity 2 1.1669e-03 ------------------------------------------------------------ 4.000e+00 2 1.959e-02 656 Solution 4.6877e-04 Sensitivity 1 4.5290e-03 Sensitivity 2 3.8631e-04 ------------------------------------------------------------ 4.500e+00 1 5.326e-03 732 Solution 1.3417e-04 Sensitivity 1 1.4551e-03 Sensitivity 2 1.2585e-04 ------------------------------------------------------------ 5.000e+00 2 9.973e-03 814 Solution 3.8672e-05 Sensitivity 1 4.6549e-04 Sensitivity 2 4.0632e-05 ------------------------------------------------------------ Final Statistics nst = 814 nfe = 1462 netf = 2 nsetups = 0 nni = 1458 ncfn = 134 nfSe = 2924 nfeS = 5848 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 sundials-2.5.0/examples/cvodes/parallel/cvsAdvDiff_ASAp_non_p.c0000600000175000017500000004763611741421151025344 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:30 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the program for * its solution by CVODE. The problem is the semi-discrete form of * the advection-diffusion equation in 1-D: * du/dt = p1 * d^2u / dx^2 + p2 * du / dx * on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. * Homogeneous Dirichlet boundary conditions are posed, and the * initial condition is: * u(x,t=0) = x(2-x)exp(2x). * The nominal values of the two parameters are: p1=1.0, p2=0.5 * The PDE is discretized on a uniform grid of size MX+2 with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX. * This program solves the problem with the option for nonstiff * systems: ADAMS method and functional iteration. * It uses scalar relative and absolute tolerances. * * In addition to the solution, sensitivities with respect to p1 * and p2 as well as with respect to initial conditions are * computed for the quantity: * g(t, u, p) = int_x u(x,t) at t = 5 * These sensitivities are obtained by solving the adjoint system: * dv/dt = -p1 * d^2 v / dx^2 + p2 * dv / dx * with homogeneous Ditrichlet boundary conditions and the final * condition: * v(x,t=5) = 1.0 * Then, v(x, t=0) represents the sensitivity of g(5) with respect * to u(x, t=0) and the gradient of g(5) with respect to p1, p2 is * (dg/dp)^T = [ int_t int_x (v * d^2u / dx^2) dx dt ] * [ int_t int_x (v * du / dx) dx dt ] * * This version uses MPI for user routines. * Execute with Number of Processors = N, with 1 <= N <= MX. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundary */ #define MX 20 /* mesh dimension */ #define NEQ MX /* number of equations */ #define ATOL RCONST(1.e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define TOUT RCONST(2.5) /* output time increment */ /* Adjoint Problem Constants */ #define NP 2 /* number of parameters */ #define STEPS 200 /* steps between check points */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Type : UserData */ typedef struct { realtype p[2]; /* model parameters */ realtype dx; /* spatial discretization grid */ realtype hdcoef, hacoef; /* diffusion and advection coefficients */ long int local_N; long int npes, my_pe; /* total number of processes and current ID */ long int nperpe, nrem; MPI_Comm comm; /* MPI communicator */ realtype *z1, *z2; /* work space */ } *UserData; /* Prototypes of user-supplied funcitons */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int fB(realtype t, N_Vector u, N_Vector uB, N_Vector uBdot, void *user_dataB); /* Prototypes of private functions */ static void SetIC(N_Vector u, realtype dx, long int my_length, long int my_base); static void SetICback(N_Vector uB, long int my_base); static realtype Xintgr(realtype *z, long int l, realtype dx); static realtype Compute_g(N_Vector u, UserData data); static void PrintOutput(realtype g_val, N_Vector uB, UserData data); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; N_Vector u; realtype reltol, abstol; int indexB; N_Vector uB; realtype dx, t, g_val; int flag, my_pe, nprocs, npes, ncheck; long int local_N=0, nperpe, nrem, my_base=-1; MPI_Comm comm; data = NULL; cvode_mem = NULL; u = uB = NULL; /*------------------------------------------------------ Initialize MPI and get total number of pe's, and my_pe ------------------------------------------------------*/ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &nprocs); MPI_Comm_rank(comm, &my_pe); npes = nprocs - 1; /* pe's dedicated to PDE integration */ if ( npes <= 0 ) { if (my_pe == npes) fprintf(stderr, "\nMPI_ERROR(%d): number of processes must be >= 2\n\n", my_pe); MPI_Finalize(); return(1); } /*----------------------- Set local vector length -----------------------*/ nperpe = NEQ/npes; nrem = NEQ - npes*nperpe; if (my_pe < npes) { /* PDE vars. distributed to this proccess */ local_N = (my_pe < nrem) ? nperpe+1 : nperpe; my_base = (my_pe < nrem) ? my_pe*local_N : my_pe*nperpe + nrem; } else { /* Make last process inactive for forward phase */ local_N = 0; } /*------------------------------------- Allocate and load user data structure -------------------------------------*/ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data , "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->p[0] = ONE; data->p[1] = RCONST(0.5); dx = data->dx = XMAX/((realtype)(MX+1)); data->hdcoef = data->p[0]/(dx*dx); data->hacoef = data->p[1]/(TWO*dx); data->comm = comm; data->npes = npes; data->my_pe = my_pe; data->nperpe = nperpe; data->nrem = nrem; data->local_N = local_N; /*------------------------- Forward integration phase -------------------------*/ /* Set relative and absolute tolerances for forward phase */ reltol = ZERO; abstol = ATOL; /* Allocate and initialize forward variables */ u = N_VNew_Parallel(comm, local_N, NEQ); if (check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetIC(u, dx, local_N, my_base); /* Allocate CVODES memory for forward integration */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if (check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeInit(cvode_mem, f, T0, u); if (check_flag(&flag, "CVodeInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) MPI_Abort(comm, 1); /* Allocate combined forward/backward memory */ flag = CVodeAdjInit(cvode_mem, STEPS, CV_HERMITE); if (check_flag(&flag, "CVadjInit", 1, my_pe)) MPI_Abort(comm, 1); /* Integrate to TOUT and collect check point information */ flag = CVodeF(cvode_mem, TOUT, u, &t, CV_NORMAL, &ncheck); if (check_flag(&flag, "CVodeF", 1, my_pe)) MPI_Abort(comm, 1); /*--------------------------- Compute and value of g(t_f) ---------------------------*/ g_val = Compute_g(u, data); /*-------------------------- Backward integration phase --------------------------*/ if (my_pe == npes) { /* Activate last process for integration of the quadrature equations */ local_N = NP; } else { /* Allocate work space */ data->z1 = (realtype *)malloc(local_N*sizeof(realtype)); if (check_flag((void *)data->z1, "malloc", 2, my_pe)) MPI_Abort(comm, 1); data->z2 = (realtype *)malloc(local_N*sizeof(realtype)); if (check_flag((void *)data->z2, "malloc", 2, my_pe)) MPI_Abort(comm, 1); } /* Allocate and initialize backward variables */ uB = N_VNew_Parallel(comm, local_N, NEQ+NP); if (check_flag((void *)uB, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetICback(uB, my_base); /* Allocate CVODES memory for the backward integration */ flag = CVodeCreateB(cvode_mem, CV_ADAMS, CV_FUNCTIONAL, &indexB); if (check_flag(&flag, "CVodeCreateB", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSetUserDataB(cvode_mem, indexB, data); if (check_flag(&flag, "CVodeSetUserDataB", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeInitB(cvode_mem, indexB, fB, TOUT, uB); if (check_flag(&flag, "CVodeInitB", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeSStolerancesB(cvode_mem, indexB, reltol, abstol); if (check_flag(&flag, "CVodeSStolerancesB", 1, my_pe)) MPI_Abort(comm, 1); /* Integrate to T0 */ flag = CVodeB(cvode_mem, T0, CV_NORMAL); if (check_flag(&flag, "CVodeB", 1, my_pe)) MPI_Abort(comm, 1); flag = CVodeGetB(cvode_mem, indexB, &t, uB); if (check_flag(&flag, "CVodeGetB", 1, my_pe)) MPI_Abort(comm, 1); /* Print results (adjoint states and quadrature variables) */ PrintOutput(g_val, uB, data); /* Free memory */ N_VDestroy_Parallel(u); N_VDestroy_Parallel(uB); CVodeFree(&cvode_mem); if (my_pe != npes) { free(data->z1); free(data->z2); } free(data); MPI_Finalize(); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,u) for forward phase. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype uLeft, uRight, ui, ult, urt; realtype hordc, horac, hdiff, hadv; realtype *udata, *dudata; long int i, my_length; int npes, my_pe, my_pe_m1, my_pe_p1, last_pe, my_last; UserData data; MPI_Status status; MPI_Comm comm; /* Extract MPI info. from data */ data = (UserData) user_data; comm = data->comm; npes = data->npes; my_pe = data->my_pe; /* If this process is inactive, return now */ if (my_pe == npes) return(0); /* Extract problem constants from data */ hordc = data->hdcoef; horac = data->hacoef; /* Find related processes */ my_pe_m1 = my_pe - 1; my_pe_p1 = my_pe + 1; last_pe = npes - 1; /* Obtain local arrays */ udata = NV_DATA_P(u); dudata = NV_DATA_P(udot); my_length = NV_LOCLENGTH_P(u); my_last = my_length - 1; /* Pass needed data to processes before and after current process. */ if (my_pe != 0) MPI_Send(&udata[0], 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm); if (my_pe != last_pe) MPI_Send(&udata[my_length-1], 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm); /* Receive needed data from processes before and after current process. */ if (my_pe != 0) MPI_Recv(&uLeft, 1, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status); else uLeft = ZERO; if (my_pe != last_pe) MPI_Recv(&uRight, 1, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status); else uRight = ZERO; /* Loop over all grid points in current process. */ for (i=0; icomm; npes = data->npes; my_pe = data->my_pe; if (my_pe == npes) { /* This process performs the quadratures */ /* Obtain local arrays */ duBdata = NV_DATA_P(uBdot); my_length = NV_LOCLENGTH_P(uB); /* Loop over all other processes and load right hand side of quadrature eqs. */ duBdata[0] = ZERO; duBdata[1] = ZERO; for (i=0; idx; hordc = data->hdcoef; horac = data->hacoef; z1 = data->z1; z2 = data->z2; /* Obtain local arrays */ uBdata = NV_DATA_P(uB); duBdata = NV_DATA_P(uBdot); udata = NV_DATA_P(u); my_length = NV_LOCLENGTH_P(uB); /* Compute related parameters. */ my_pe_m1 = my_pe - 1; my_pe_p1 = my_pe + 1; last_pe = npes - 1; my_last = my_length - 1; /* Pass needed data to processes before and after current process. */ if (my_pe != 0) { data_out[0] = udata[0]; data_out[1] = uBdata[0]; MPI_Send(data_out, 2, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm); } if (my_pe != last_pe) { data_out[0] = udata[my_length-1]; data_out[1] = uBdata[my_length-1]; MPI_Send(data_out, 2, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm); } /* Receive needed data from processes before and after current process. */ if (my_pe != 0) { MPI_Recv(data_in, 2, PVEC_REAL_MPI_TYPE, my_pe_m1, 0, comm, &status); uLeft = data_in[0]; uBLeft = data_in[1]; } else { uLeft = ZERO; uBLeft = ZERO; } if (my_pe != last_pe) { MPI_Recv(data_in, 2, PVEC_REAL_MPI_TYPE, my_pe_p1, 0, comm, &status); uRight = data_in[0]; uBRight = data_in[1]; } else { uRight = ZERO; uBRight = ZERO; } /* Loop over all grid points in current process. */ for (i=0; icomm; npes = data->npes; my_pe = data->my_pe; dx = data->dx; if (my_pe == npes) { /* Loop over all other processes and sum */ intgr = ZERO; for (i=0; icomm; npes = data->npes; my_pe = data->my_pe; local_N = data->local_N; nperpe = data->nperpe; nrem = data->nrem; uBdata = NV_DATA_P(uB); if (my_pe == npes) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("\ng(tf) = %8Le\n\n", g_val); printf("dgdp(tf)\n [ 1]: %8Le\n [ 2]: %8Le\n\n", -uBdata[0], -uBdata[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("\ng(tf) = %8le\n\n", g_val); printf("dgdp(tf)\n [ 1]: %8le\n [ 2]: %8le\n\n", -uBdata[0], -uBdata[1]); #else printf("\ng(tf) = %8e\n\n", g_val); printf("dgdp(tf)\n [ 1]: %8e\n [ 2]: %8e\n\n", -uBdata[0], -uBdata[1]); #endif mu = (realtype *)malloc(NEQ*sizeof(realtype)); if (check_flag((void *)mu, "malloc", 2, my_pe)) MPI_Abort(comm, 1); indx = 0; for ( i = 0; i < npes; i++) { Ni = ( i < nrem ) ? nperpe+1 : nperpe; MPI_Recv(&mu[indx], Ni, PVEC_REAL_MPI_TYPE, i, 0, comm, &status); indx += Ni; } printf("mu(t0)\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) for (i=0; i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_kry_bbd_p.c0000600000175000017500000007406311741421151025407 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/14 22:15:31 $ * ----------------------------------------------------------------- * Programmer(s): S. D. Cohen, A. C. Hindmarsh, M. R. Wittman, and * Radu Serban @ LLNL * -------------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * mesh, with simple polynomial initial profiles. * * The problem is solved by CVODES on NPE processors, treated * as a rectangular process grid of size NPEX by NPEY, with * NPE = NPEX*NPEY. Each processor contains a subgrid of size MXSUB * by MYSUB of the (x,y) mesh. Thus the actual mesh sizes are * MX = MXSUB*NPEX and MY = MYSUB*NPEY, and the ODE system size is * neq = 2*MX*MY. * * The solution is done with the BDF/GMRES method (i.e. using the * CVSPGMR linear solver) and a block-diagonal matrix with banded * blocks as a preconditioner, using the CVBBDPRE module. * Each block is generated using difference quotients, with * half-bandwidths mudq = mldq = 2*MXSUB, but the retained banded * blocks have half-bandwidths mukeep = mlkeep = 2. * A copy of the approximate Jacobian is saved and conditionally * reused within the preconditioner routine. * * The problem is solved twice -- with left and right preconditioning. * * Performance data and sampled solution values are printed at * selected output times, and all performance counters are printed * on completion. * * This version uses MPI for user routines. * Execute with number of processors = NPEX*NPEY (see constants below). * -------------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODE fcts. */ #include /* prototypes and constants for CVSPGMR solver */ #include /* prototypes for CVBBDPRE module */ #include /* definition N_Vector and macro NV_DATA_P */ #include /* definitions of realtype, booleantype */ #include /* definition of macros SQR and EXP */ #include /* MPI constants and types */ /* Problem Constants */ #define ZERO RCONST(0.0) #define NVARS 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define NPEX 2 /* no. PEs in x direction of PE array */ #define NPEY 2 /* no. PEs in y direction of PE array */ /* Total no. PEs = NPEX*NPEY */ #define MXSUB 5 /* no. x points per subgrid */ #define MYSUB 5 /* no. y points per subgrid */ #define MX (NPEX*MXSUB) /* MX = number of x mesh points */ #define MY (NPEY*MYSUB) /* MY = number of y mesh points */ /* Spatial mesh is MX by MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ /* Type : UserData contains problem constants, extended dependent variable array, grid constants, processor indices, MPI communicator */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; realtype uext[NVARS*(MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby; long int nvmxsub, nvmxsub2, Nlocal; MPI_Comm comm; } *UserData; /* Prototypes of private helper functions */ static void InitUserData(int my_pe, long int local_N, MPI_Comm comm, UserData data); static void SetInitialProfiles(N_Vector u, UserData data); static void PrintIntro(int npes, long int mudq, long int mldq, long int mukeep, long int mlkeep); static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uarray[]); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]); static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]); static void fucomm(realtype t, N_Vector u, void *user_data); /* Prototype of function called by the solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Prototype of functions called by the CVBBDPRE module */ static int flocal(long int Nlocal, realtype t, N_Vector u, N_Vector udot, void *user_data); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt, int id); /***************************** Main Program ******************************/ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; realtype abstol, reltol, t, tout; N_Vector u; int iout, my_pe, npes, flag, jpre; long int neq, local_N, mudq, mldq, mukeep, mlkeep; MPI_Comm comm; data = NULL; cvode_mem = NULL; u = NULL; /* Set problem size neq */ neq = NVARS*MX*MY; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes, NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate and load user data block */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, local_N, comm, data); /* Allocate and initialize u, and set tolerances */ u = N_VNew_Parallel(comm, local_N, neq); if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); SetInitialProfiles(u, data); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1, my_pe)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1, my_pe)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the default maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVBBDSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Initialize BBD preconditioner */ mudq = mldq = NVARS*MXSUB; mukeep = mlkeep = NVARS; flag = CVBBDPrecInit(cvode_mem, local_N, mudq, mldq, mukeep, mlkeep, ZERO, flocal, NULL); if(check_flag(&flag, "CVBBDPrecAlloc", 1, my_pe)) MPI_Abort(comm, 1); /* Print heading */ if (my_pe == 0) PrintIntro(npes, mudq, mldq, mukeep, mlkeep); /* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { /* On second run, re-initialize u, the integrator, CVBBDPRE, and CVSPGMR */ if (jpre == PREC_RIGHT) { SetInitialProfiles(u, data); flag = CVodeReInit(cvode_mem, T0, u); if(check_flag(&flag, "CVodeReInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVBBDPrecReInit(cvode_mem, mudq, mldq, ZERO); if(check_flag(&flag, "CVBBDPrecReInit", 1, my_pe)) MPI_Abort(comm, 1); flag = CVSpilsSetPrecType(cvode_mem, PREC_RIGHT); check_flag(&flag, "CVSpilsSetPrecType", 1, my_pe); if (my_pe == 0) { printf("\n\n-------------------------------------------------------"); printf("------------\n"); } } if (my_pe == 0) { printf("\n\nPreconditioner type is: jpre = %s\n\n", (jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT"); } /* In loop over output points, call CVode, print results, test for error */ for (iout = 1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1, my_pe)) break; PrintOutput(cvode_mem, my_pe, comm, u, t); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(cvode_mem); } /* End of jpre loop */ /* Free memory */ N_VDestroy_Parallel(u); free(data); CVodeFree(&cvode_mem); MPI_Finalize(); return(0); } /*********************** Private Helper Functions ************************/ /* Load constants in data */ static void InitUserData(int my_pe, long int local_N, MPI_Comm comm, UserData data) { int isubx, isuby; /* Set problem constants */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/((realtype)(MX-1)); data->dy = (YMAX-YMIN)/((realtype)(MY-1)); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0; /* Set machine-related constants */ data->comm = comm; data->my_pe = my_pe; data->Nlocal = local_N; /* isubx and isuby are the PE grid indices corresponding to my_pe */ isuby = my_pe/NPEX; isubx = my_pe - isuby*NPEX; data->isubx = isubx; data->isuby = isuby; /* Set the sizes of a boundary x-line in u and uext */ data->nvmxsub = NVARS*MXSUB; data->nvmxsub2 = NVARS*(MXSUB+2); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, UserData data) { int isubx, isuby; int lx, ly, jx, jy; long int offset; realtype dx, dy, x, y, cx, cy, xmid, ymid; realtype *uarray; /* Set pointer to data array in vector u */ uarray = NV_DATA_P(u); /* Get mesh spacings, and subgrid indices for this PE */ dx = data->dx; dy = data->dy; isubx = data->isubx; isuby = data->isuby; /* Load initial profiles of c1 and c2 into local u vector. Here lx and ly are local mesh point indices on the local subgrid, and jx and jy are the global mesh point indices. */ offset = 0; xmid = RCONST(0.5)*(XMIN + XMAX); ymid = RCONST(0.5)*(YMIN + YMAX); for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - ymid)); cy = RCONST(1.0) - cy + RCONST(0.5)*SQR(cy); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - xmid)); cx = RCONST(1.0) - cx + RCONST(0.5)*SQR(cx); uarray[offset ] = C1_SCALE*cx*cy; uarray[offset+1] = C2_SCALE*cx*cy; offset = offset + 2; } } } /* Print problem introduction */ static void PrintIntro(int npes, long int mudq, long int mldq, long int mukeep, long int mlkeep) { printf("\n2-species diurnal advection-diffusion problem\n"); printf(" %d by %d mesh on %d processors\n", MX, MY, npes); printf(" Using CVBBDPRE preconditioner module\n"); printf(" Difference-quotient half-bandwidths are"); printf(" mudq = %ld, mldq = %ld\n", mudq, mldq); printf(" Retained band block half-bandwidths are"); printf(" mukeep = %ld, mlkeep = %ld", mukeep, mlkeep); return; } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, int my_pe, MPI_Comm comm, N_Vector u, realtype t) { int qu, flag, npelast; long int i0, i1, nst; realtype hu, *uarray, tempu[2]; MPI_Status status; npelast = NPEX*NPEY - 1; uarray = NV_DATA_P(u); /* Send c1,c2 at top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NVARS*MXSUB*MYSUB - 2; i1 = i0 + 1; if (npelast != 0) MPI_Send(&uarray[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm); else { tempu[0] = uarray[i0]; tempu[1] = uarray[i1]; } } /* On PE 0, receive c1,c2 at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, my_pe); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1, my_pe); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1, my_pe); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3le %12.3le \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3le %12.3le \n\n", tempu[0], tempu[1]); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("At bottom left: c1, c2 = %12.3e %12.3e \n", uarray[0], uarray[1]); printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]); #endif } } /* Print final statistics contained in iopt */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int lenrwBBDP, leniwBBDP, ngevalsBBDP; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1, 0); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1, 0); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1, 0); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1, 0); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1, 0); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1, 0); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1, 0); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1, 0); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1, 0); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1, 0); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1, 0); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1, 0); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1, 0); printf("\nFinal Statistics: \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfels = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); flag = CVBBDPrecGetWorkSpace(cvode_mem, &lenrwBBDP, &leniwBBDP); check_flag(&flag, "CVBBDPrecGetWorkSpace", 1, 0); flag = CVBBDPrecGetNumGfnEvals(cvode_mem, &ngevalsBBDP); check_flag(&flag, "CVBBDPrecGetNumGfnEvals", 1, 0); printf("In CVBBDPRE: real/integer local work space sizes = %ld, %ld\n", lenrwBBDP, leniwBBDP); printf(" no. flocal evals. = %ld\n",ngevalsBBDP); } /* Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uarray[]) { int i, ly; long int offsetu, offsetbuf; realtype bufleft[NVARS*MYSUB], bufright[NVARS*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&uarray[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetu = (MYSUB-1)*dsizex; MPI_Send(&uarray[offsetu], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = ly*dsizex; for (i = 0; i < NVARS; i++) bufleft[offsetbuf+i] = uarray[offsetu+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetu = offsetbuf*MXSUB + (MXSUB-1)*NVARS; for (i = 0; i < NVARS; i++) bufright[offsetbuf+i] = uarray[offsetu+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* Routine to start receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, long int dsizex, long int dsizey, realtype uext[], realtype buffer[]) { long int offsetue; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Irecv(&uext[NVARS], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) { offsetue = NVARS*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&uext[offsetue], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* Routine to finish receiving boundary data from neighboring PEs. Notes: 1) buffer should be able to hold 2*NVARS*MYSUB realtype entries, should be passed to both the BRecvPost and BRecvWait functions, and should not be manipulated between the two calls. 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, long int dsizex, realtype uext[], realtype buffer[]) { int i, ly; long int dsizex2, offsetue, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NVARS*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NVARS; /* If isuby > 0, receive data for bottom x-line of uext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of uext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of uext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+1)*dsizex2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of uext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to uext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NVARS; offsetue = (ly+2)*dsizex2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = bufright[offsetbuf+i]; } } } /* fucomm routine. This routine performs all inter-processor communication of data in u needed to calculate f. */ static void fucomm(realtype t, N_Vector u, void *user_data) { UserData data; realtype *uarray, *uext, buffer[2*NVARS*MYSUB]; MPI_Comm comm; int my_pe, isubx, isuby; long int nvmxsub, nvmysub; MPI_Request request[4]; data = (UserData) user_data; uarray = NV_DATA_P(u); /* Get comm, my_pe, subgrid indices, data sizes, extended array uext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmysub = NVARS*MYSUB; uext = data->uext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nvmxsub, nvmysub, uext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nvmxsub, nvmysub, uarray); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nvmxsub, uext, buffer); } /***************** Function called by the solver **************************/ /* f routine. Evaluate f(t,y). First call fucomm to do communication of subgrid boundary data into uext. Then calculate f by a call to flocal. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { UserData data; data = (UserData) user_data; /* Call fucomm to do inter-processor communication */ fucomm (t, u, user_data); /* Call flocal to calculate all right-hand sides */ flocal (data->Nlocal, t, u, udot, user_data); return(0); } /***************** Functions called by the CVBBDPRE module ****************/ /* flocal routine. Compute f(t,y). This routine assumes that all inter-processor communication of data needed to calculate f has already been done, and this data is in the work array uext. */ static int flocal(long int Nlocal, realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype *uext; realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int i, lx, ly, jx, jy; int isubx, isuby; long int nvmxsub, nvmxsub2, offsetu, offsetue; UserData data; realtype *uarray, *duarray; uarray = NV_DATA_P(u); duarray = NV_DATA_P(udot); /* Get subgrid indices, array sizes, extended work array uext */ data = (UserData) user_data; isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; nvmxsub2 = data->nvmxsub2; uext = data->uext; /* Copy local segment of u vector into the working extended array uext */ offsetu = 0; offsetue = nvmxsub2 + NVARS; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i]; offsetu = offsetu + nvmxsub; offsetue = offsetue + nvmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of u to uext */ /* If isuby = 0, copy x-line 2 of u to uext */ if (isuby == 0) { for (i = 0; i < nvmxsub; i++) uext[NVARS+i] = uarray[nvmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of u to uext */ if (isuby == NPEY-1) { offsetu = (MYSUB-2)*nvmxsub; offsetue = (MYSUB+1)*nvmxsub2 + NVARS; for (i = 0; i < nvmxsub; i++) uext[offsetue+i] = uarray[offsetu+i]; } /* If isubx = 0, copy y-line 2 of u to uext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetu = ly*nvmxsub + NVARS; offsetue = (ly+1)*nvmxsub2; for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of u to uext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetu = (ly+1)*nvmxsub - 2*NVARS; offsetue = (ly+2)*nvmxsub2 - NVARS; for (i = 0; i < NVARS; i++) uext[offsetue+i] = uarray[offsetu+i]; } } /* Make local copies of problem variables, for efficiency */ dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Set diurnal rate coefficients as functions of t, and save q4 in data block for use by preconditioner evaluation routine */ s = sin((data->om)*t); if (s > ZERO) { q3 = EXP(-A3/s); q4coef = EXP(-A4/s); } else { q3 = ZERO; q4coef = ZERO; } data->q4 = q4coef; /* Loop over all grid points in local subgrid */ for (ly = 0; ly < MYSUB; ly++) { jy = ly + isuby*MYSUB; /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; /* Extract c1 and c2, and set kinetic rate terms */ offsetue = (lx+1)*NVARS + (ly+1)*nvmxsub2; c1 = uext[offsetue]; c2 = uext[offsetue+1]; qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + 2.0*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms */ c1dn = uext[offsetue-nvmxsub2]; c2dn = uext[offsetue-nvmxsub2+1]; c1up = uext[offsetue+nvmxsub2]; c2up = uext[offsetue+nvmxsub2+1]; vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms */ c1lt = uext[offsetue-2]; c2lt = uext[offsetue-1]; c1rt = uext[offsetue+2]; c2rt = uext[offsetue+3]; hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt); hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into duarray */ offsetu = lx*NVARS + ly*nvmxsub; duarray[offsetu] = vertd1 + hord1 + horad1 + rkin1; duarray[offsetu+1] = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/parallel/cvsDiurnal_FSA_kry_p.out0000600000175000017500000002124711741421151025652 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) ======================================================================== T Q H NST Bottom left Top right ======================================================================== 7.200e+03 3 3.544e+01 415 Solution 1.0468e+04 1.1185e+04 2.5267e+11 2.6998e+11 ---------------------------------------- Sensitivity 1 -6.4201e+19 -6.8598e+19 7.1177e+19 7.6556e+19 ---------------------------------------- Sensitivity 2 -4.3853e+14 -5.0065e+14 -2.4407e+18 -2.7842e+18 ------------------------------------------------------------------------ 1.440e+04 3 4.903e+01 640 Solution 6.6590e+06 7.3008e+06 2.5819e+11 2.8329e+11 ---------------------------------------- Sensitivity 1 -4.0848e+22 -4.4785e+22 5.9550e+22 6.7173e+22 ---------------------------------------- Sensitivity 2 -4.5235e+17 -5.4318e+17 -6.5419e+21 -7.8316e+21 ------------------------------------------------------------------------ 2.160e+04 2 2.948e+01 1198 Solution 2.6650e+07 2.9308e+07 2.9928e+11 3.3134e+11 ---------------------------------------- Sensitivity 1 -1.6346e+23 -1.7976e+23 3.8203e+23 4.4991e+23 ---------------------------------------- Sensitivity 2 -7.6601e+18 -9.4433e+18 -7.6459e+22 -9.4502e+22 ------------------------------------------------------------------------ 2.880e+04 3 4.499e+01 1542 Solution 8.7021e+06 9.6501e+06 3.3804e+11 3.7510e+11 ---------------------------------------- Sensitivity 1 -5.3375e+22 -5.9188e+22 5.4487e+23 6.7430e+23 ---------------------------------------- Sensitivity 2 -4.8855e+18 -6.1040e+18 -1.7194e+23 -2.1518e+23 ------------------------------------------------------------------------ 3.600e+04 3 1.107e+01 1675 Solution 1.4040e+04 1.5609e+04 3.3868e+11 3.7652e+11 ---------------------------------------- Sensitivity 1 -8.6141e+19 -9.5761e+19 5.2718e+23 6.6030e+23 ---------------------------------------- Sensitivity 2 -8.4328e+15 -1.0549e+16 -1.8439e+23 -2.3096e+23 ------------------------------------------------------------------------ 4.320e+04 4 8.016e+01 3146 Solution -2.5802e-07 -2.3679e-07 3.3823e+11 3.8035e+11 ---------------------------------------- Sensitivity 1 -3.4238e+08 -3.8876e+08 5.2753e+23 6.7448e+23 ---------------------------------------- Sensitivity 2 5.4404e+03 6.6262e+03 -1.8454e+23 -2.3595e+23 ------------------------------------------------------------------------ 5.040e+04 4 2.431e+02 3194 Solution 8.0708e-08 7.0502e-08 3.3582e+11 3.8645e+11 ---------------------------------------- Sensitivity 1 -4.5550e+10 -3.9697e+10 5.2067e+23 6.9664e+23 ---------------------------------------- Sensitivity 2 -5.5727e+08 -5.5845e+08 -1.8214e+23 -2.4371e+23 ------------------------------------------------------------------------ 5.760e+04 4 2.523e+02 3216 Solution -1.8957e-11 -1.6762e-11 3.3203e+11 3.9090e+11 ---------------------------------------- Sensitivity 1 -1.5940e+06 -1.4035e+06 5.0825e+23 7.1205e+23 ---------------------------------------- Sensitivity 2 -2.2867e+02 -2.2722e+02 -1.7780e+23 -2.4910e+23 ------------------------------------------------------------------------ 6.480e+04 4 2.820e+02 3254 Solution -7.8717e-10 -6.7017e-10 3.3130e+11 3.9634e+11 ---------------------------------------- Sensitivity 1 -3.4373e+07 -2.1671e+07 5.0442e+23 7.3274e+23 ---------------------------------------- Sensitivity 2 1.3198e+08 1.3575e+08 -1.7646e+23 -2.5633e+23 ------------------------------------------------------------------------ 7.200e+04 4 3.810e+02 3276 Solution -4.4006e-09 -3.7463e-09 3.3297e+11 4.0389e+11 ---------------------------------------- Sensitivity 1 4.5106e+09 3.8200e+09 5.0783e+23 7.6382e+23 ---------------------------------------- Sensitivity 2 2.0264e+05 2.0791e+05 -1.7765e+23 -2.6721e+23 ------------------------------------------------------------------------ 7.920e+04 5 6.406e+02 3291 Solution -1.8328e-11 -1.5666e-11 3.3344e+11 4.1203e+11 ---------------------------------------- Sensitivity 1 1.3650e+07 1.1729e+07 5.0730e+23 7.9960e+23 ---------------------------------------- Sensitivity 2 6.1764e+01 6.8476e+01 -1.7747e+23 -2.7972e+23 ------------------------------------------------------------------------ 8.640e+04 5 6.406e+02 3302 Solution -2.0206e-13 -1.7557e-13 3.3518e+11 4.1625e+11 ---------------------------------------- Sensitivity 1 1.1323e+06 9.7319e+05 5.1171e+23 8.2142e+23 ---------------------------------------- Sensitivity 2 7.6632e+00 8.2818e+00 -1.7901e+23 -2.8736e+23 ------------------------------------------------------------------------ Final Statistics nst = 3302 nfe = 4387 netf = 165 nsetups = 508 nni = 4383 ncfn = 7 nfSe = 8774 nfeS = 17548 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 sundials-2.5.0/examples/cvodes/parallel/README0000600000175000017500000000224411741421151021766 0ustar sylvestresylvestreList of parallel CVODES examples (1) Simulation cvsAdvDiff_non_p : 1-D advection-diffusion (nonstiff) cvsDiurnal_kry_bbd_p : 2-D 2-species diurnal advection-diffusion BBD preconditioner cvsDiurnal_kry_p : 2-D 2-species diurnal advection-diffusion (2) Forward sensitivity cvsAdvDiff_FSA_non_p : 1-D advection difusion PDE - Adams with Functional iteration cvsDiurnal_FSA_kry_p : 2-D 2-species diurnal advection-diffusion PDE - BDF with Newton GMRES (3) Adjoint sensitivity cvsAdvDiff_ASAp_non_p : 1-D advection-diffusion (nonstiff) cvsAtmDisp_ASAi_kry_bbd_p : 2-D (or 3-D) advection-diffusion-reaction PDE BDF/SPGMR/BBD Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/cvodes/serial/0000755000175000017500000000000011767174700020614 5ustar sylvestresylvestresundials-2.5.0/examples/cvodes/serial/cvsRoberts_ASAi_dns.c0000600000175000017500000004460111741421151024575 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2011/11/23 23:53:02 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * Adjoint sensitivity example problem. * The following is a simple example problem, with the coding * needed for its solution by CVODES. The problem is from chemical * kinetics, and consists of the following three rate equations. * dy1/dt = -p1*y1 + p2*y2*y3 * dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2 * dy3/dt = p3*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The reaction rates are: * p1=0.04, p2=1e4, and p3=3e7. The problem is stiff. * This program solves the problem with the BDF method, Newton * iteration with the CVODE dense linear solver, and a user-supplied * Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. * Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * * Optionally, CVODES can compute sensitivities with respect to * the problem parameters p1, p2, and p3 of the following quantity: * G = int_t0^t1 g(t,p,y) dt * where * g(t,p,y) = y3 * * The gradient dG/dp is obtained as: * dG/dp = int_t0^t1 (g_p - lambda^T f_p ) dt - lambda^T(t0)*y0_p * = - xi^T(t0) - lambda^T(t0)*y0_p * where lambda and xi are solutions of: * d(lambda)/dt = - (f_y)^T * lambda - (g_y)^T * lambda(t1) = 0 * and * d(xi)/dt = - (f_p)^T * lambda + (g_p)^T * xi(t1) = 0 * * During the backward integration, CVODES also evaluates G as * G = - phi(t0) * where * d(phi)/dt = g(t,y,p) * phi(t1) = 0 * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component, i=1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* (i,j)-th matrix el., i,j=1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define RTOL RCONST(1e-6) /* scalar relative tolerance */ #define ATOL1 RCONST(1e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1e-14) #define ATOL3 RCONST(1e-6) #define ATOLl RCONST(1e-8) /* absolute tolerance for adjoint vars. */ #define ATOLq RCONST(1e-6) /* absolute tolerance for quadratures */ #define T0 RCONST(0.0) /* initial time */ #define TOUT RCONST(4e7) /* final time */ #define TB1 RCONST(4e7) /* starting point for adjoint problem */ #define TB2 RCONST(50.0) /* starting point for adjoint problem */ #define STEPS 150 /* number of steps between check points */ #define NP 3 /* number of problem parameters */ #define ZERO RCONST(0.0) /* Type : UserData */ typedef struct { realtype p[3]; } *UserData; /* Prototypes of user-supplied functions */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int fQ(realtype t, N_Vector y, N_Vector qdot, void *user_data); static int ewt(N_Vector y, N_Vector w, void *user_data); static int fB(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB); static int JacB(long int NB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int fQB(realtype t, N_Vector y, N_Vector yB, N_Vector qBdot, void *user_dataB); /* Prototypes of private functions */ static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector qB); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; realtype reltolQ, abstolQ; N_Vector y, q; int steps; int indexB; realtype reltolB, abstolB, abstolQB; N_Vector yB, qB; realtype time; int flag, ncheck; long int nst, nstB; CVadjCheckPointRec *ckpnt; data = NULL; cvode_mem = NULL; ckpnt = NULL; y = yB = qB = NULL; /* Print problem description */ printf("\nAdjoint Sensitivity Example for Chemical Kinetics\n"); printf("-------------------------------------------------\n\n"); printf("ODE: dy1/dt = -p1*y1 + p2*y2*y3\n"); printf(" dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2\n"); printf(" dy3/dt = p3*(y2)^2\n\n"); printf("Find dG/dp for\n"); printf(" G = int_t0^tB0 g(t,p,y) dt\n"); printf(" g(t,p,y) = y3\n\n\n"); /* User data structure */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2)) return(1); data->p[0] = RCONST(0.04); data->p[1] = RCONST(1.0e4); data->p[2] = RCONST(3.0e7); /* Initialize y */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); Ith(y,1) = RCONST(1.0); Ith(y,2) = ZERO; Ith(y,3) = ZERO; /* Initialize q */ q = N_VNew_Serial(1); if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1); Ith(q,1) = ZERO; /* Set the scalar realtive and absolute tolerances reltolQ and abstolQ */ reltolQ = RTOL; abstolQ = ATOLq; /* Create and allocate CVODES memory for forward run */ printf("Create and allocate CVODES memory for forward runs\n"); cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeWFtolerances(cvode_mem, ewt); if (check_flag(&flag, "CVodeWFtolerances", 1)) return(1); flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); flag = CVodeQuadInit(cvode_mem, fQ, q); if (check_flag(&flag, "CVodeQuadInit", 1)) return(1); flag = CVodeQuadSStolerances(cvode_mem, reltolQ, abstolQ); if (check_flag(&flag, "CVodeQuadSStolerances", 1)) return(1); flag = CVodeSetQuadErrCon(cvode_mem, TRUE); if (check_flag(&flag, "CVodeSetQuadErrCon", 1)) return(1); /* Allocate global memory */ steps = STEPS; flag = CVodeAdjInit(cvode_mem, steps, CV_HERMITE); /* flag = CVodeAdjInit(cvode_mem, steps, CV_POLYNOMIAL); */ if (check_flag(&flag, "CVodeAdjInit", 1)) return(1); /* Perform forward run */ printf("Forward integration ... "); flag = CVodeF(cvode_mem, TOUT, y, &time, CV_NORMAL, &ncheck); if (check_flag(&flag, "CVodeF", 1)) return(1); flag = CVodeGetNumSteps(cvode_mem, &nst); if (check_flag(&flag, "CVodeGetNumSteps", 1)) return(1); printf("done ( nst = %ld )\n",nst); printf("\nncheck = %d\n\n", ncheck); flag = CVodeGetQuad(cvode_mem, &time, q); if (check_flag(&flag, "CVodeGetQuad", 1)) return(1); printf("--------------------------------------------------------\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("G: %12.4Le \n",Ith(q,1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("G: %12.4le \n",Ith(q,1)); #else printf("G: %12.4e \n",Ith(q,1)); #endif printf("--------------------------------------------------------\n\n"); /* Test check point linked list (uncomment next block to print check point information) */ /* { int i; printf("\nList of Check Points (ncheck = %d)\n\n", ncheck); ckpnt = (CVadjCheckPointRec *) malloc ( (ncheck+1)*sizeof(CVadjCheckPointRec)); CVodeGetAdjCheckPointsInfo(cvode_mem, ckpnt); for (i=0;i<=ncheck;i++) { printf("Address: %p\n",ckpnt[i].my_addr); printf("Next: %p\n",ckpnt[i].next_addr); printf("Time interval: %le %le\n",ckpnt[i].t0, ckpnt[i].t1); printf("Step number: %ld\n",ckpnt[i].nstep); printf("Order: %d\n",ckpnt[i].order); printf("Step size: %le\n",ckpnt[i].step); printf("\n"); } } */ /* Initialize yB */ yB = N_VNew_Serial(NEQ); if (check_flag((void *)yB, "N_VNew_Serial", 0)) return(1); Ith(yB,1) = ZERO; Ith(yB,2) = ZERO; Ith(yB,3) = ZERO; /* Initialize qB */ qB = N_VNew_Serial(NP); if (check_flag((void *)qB, "N_VNew", 0)) return(1); Ith(qB,1) = ZERO; Ith(qB,2) = ZERO; Ith(qB,3) = ZERO; /* Set the scalar relative tolerance reltolB */ reltolB = RTOL; /* Set the scalar absolute tolerance abstolB */ abstolB = ATOLl; /* Set the scalar absolute tolerance abstolQB */ abstolQB = ATOLq; /* Create and allocate CVODES memory for backward run */ printf("Create and allocate CVODES memory for backward run\n"); flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB); if (check_flag(&flag, "CVodeCreateB", 1)) return(1); flag = CVodeInitB(cvode_mem, indexB, fB, TB1, yB); if (check_flag(&flag, "CVodeInitB", 1)) return(1); flag = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB); if (check_flag(&flag, "CVodeSStolerancesB", 1)) return(1); flag = CVodeSetUserDataB(cvode_mem, indexB, data); if (check_flag(&flag, "CVodeSetUserDataB", 1)) return(1); flag = CVDenseB(cvode_mem, indexB, NEQ); if (check_flag(&flag, "CVDenseB", 1)) return(1); flag = CVDlsSetDenseJacFnB(cvode_mem, indexB, JacB); if (check_flag(&flag, "CVDlsSetDenseJacFnB", 1)) return(1); flag = CVodeQuadInitB(cvode_mem, indexB, fQB, qB); if (check_flag(&flag, "CVodeQuadInitB", 1)) return(1); flag = CVodeQuadSStolerancesB(cvode_mem, indexB, reltolB, abstolQB); if (check_flag(&flag, "CVodeQuadSStolerancesB", 1)) return(1); flag = CVodeSetQuadErrConB(cvode_mem, indexB, TRUE); if (check_flag(&flag, "CVodeSetQuadErrConB", 1)) return(1); /* Backward Integration */ printf("Backward integration ... "); flag = CVodeB(cvode_mem, T0, CV_NORMAL); if (check_flag(&flag, "CVodeB", 1)) return(1); CVodeGetNumSteps(CVodeGetAdjCVodeBmem(cvode_mem, indexB), &nstB); printf("done ( nst = %ld )\n", nstB); flag = CVodeGetB(cvode_mem, indexB, &time, yB); if (check_flag(&flag, "CVodeGetB", 1)) return(1); flag = CVodeGetQuadB(cvode_mem, indexB, &time, qB); if (check_flag(&flag, "CVodeGetQuadB", 1)) return(1); PrintOutput(TB1, yB, qB); /* Reinitialize backward phase (new tB0) */ Ith(yB,1) = ZERO; Ith(yB,2) = ZERO; Ith(yB,3) = ZERO; Ith(qB,1) = ZERO; Ith(qB,2) = ZERO; Ith(qB,3) = ZERO; printf("Re-initialize CVODES memory for backward run\n"); flag = CVodeReInitB(cvode_mem, indexB, TB2, yB); if (check_flag(&flag, "CVodeReInitB", 1)) return(1); flag = CVodeQuadReInitB(cvode_mem, indexB, qB); if (check_flag(&flag, "CVodeQuadReInitB", 1)) return(1); printf("Backward integration ... "); flag = CVodeB(cvode_mem, T0, CV_NORMAL); if (check_flag(&flag, "CVodeB", 1)) return(1); CVodeGetNumSteps(CVodeGetAdjCVodeBmem(cvode_mem, indexB), &nstB); printf("done ( nst = %ld )\n", nstB); flag = CVodeGetB(cvode_mem, indexB, &time, yB); if (check_flag(&flag, "CVodeGetB", 1)) return(1); flag = CVodeGetQuadB(cvode_mem, indexB, &time, qB); if (check_flag(&flag, "CVodeGetQuadB", 1)) return(1); PrintOutput(TB2, yB, qB); /* Free memory */ printf("Free memory\n\n"); CVodeFree(&cvode_mem); N_VDestroy_Serial(y); N_VDestroy_Serial(q); N_VDestroy_Serial(yB); N_VDestroy_Serial(qB); if (ckpnt != NULL) free(ckpnt); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; UserData data; realtype p1, p2, p3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; yd1 = Ith(ydot,1) = -p1*y1 + p2*y2*y3; yd3 = Ith(ydot,3) = p3*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * Jacobian routine. Compute J(t,y). */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; UserData data; realtype p1, p2, p3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(J,1,1) = -p1; IJth(J,1,2) = p2*y3; IJth(J,1,3) = p2*y2; IJth(J,2,1) = p1; IJth(J,2,2) = -p2*y3-2*p3*y2; IJth(J,2,3) = -p2*y2; IJth(J,3,2) = 2*p3*y2; return(0); } /* * fQ routine. Compute fQ(t,y). */ static int fQ(realtype t, N_Vector y, N_Vector qdot, void *user_data) { Ith(qdot,1) = Ith(y,3); return(0); } /* * EwtSet function. Computes the error weights at the current solution. */ static int ewt(N_Vector y, N_Vector w, void *user_data) { int i; realtype yy, ww, rtol, atol[3]; rtol = RTOL; atol[0] = ATOL1; atol[1] = ATOL2; atol[2] = ATOL3; for (i=1; i<=3; i++) { yy = Ith(y,i); ww = rtol * ABS(yy) + atol[i-1]; if (ww <= 0.0) return (-1); Ith(w,i) = 1.0/ww; } return(0); } /* * fB routine. Compute fB(t,y,yB). */ static int fB(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3; realtype l21, l32, y23; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* The lambda vector */ l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); /* Temporary variables */ l21 = l2-l1; l32 = l3-l2; y23 = y2*y3; /* Load yBdot */ Ith(yBdot,1) = - p1*l21; Ith(yBdot,2) = p2*y3*l21 - RCONST(2.0)*p3*y2*l32; Ith(yBdot,3) = p2*y2*l21 - RCONST(1.0); return(0); } /* * JacB routine. Compute JB(t,y,yB). */ static int JacB(long int NB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* Load JB */ IJth(JB,1,1) = p1; IJth(JB,1,2) = -p1; IJth(JB,2,1) = -p2*y3; IJth(JB,2,2) = p2*y3+2.0*p3*y2; IJth(JB,2,3) = RCONST(-2.0)*p3*y2; IJth(JB,3,1) = -p2*y2; IJth(JB,3,2) = p2*y2; return(0); } /* * fQB routine. Compute integrand for quadratures */ static int fQB(realtype t, N_Vector y, N_Vector yB, N_Vector qBdot, void *user_dataB) { UserData data; realtype y1, y2, y3; realtype p1, p2, p3; realtype l1, l2, l3; realtype l21, l32, y23; data = (UserData) user_dataB; /* The p vector */ p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; /* The y vector */ y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* The lambda vector */ l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); /* Temporary variables */ l21 = l2-l1; l32 = l3-l2; y23 = y2*y3; Ith(qBdot,1) = y1*l21; Ith(qBdot,2) = - y23*l21; Ith(qBdot,3) = y2*y2*l32; return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Print results after backward integration */ static void PrintOutput(realtype tfinal, N_Vector yB, N_Vector qB) { printf("--------------------------------------------------------\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("tB0: %12.4Le\n",tfinal); printf("dG/dp: %12.4Le %12.4Le %12.4Le\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4Le %12.4Le %12.4Le\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("tB0: %12.4le\n",tfinal); printf("dG/dp: %12.4le %12.4le %12.4le\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4le %12.4le %12.4le\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #else printf("tB0: %12.4e\n",tfinal); printf("dG/dp: %12.4e %12.4e %12.4e\n", -Ith(qB,1), -Ith(qB,2), -Ith(qB,3)); printf("lambda(t0): %12.4e %12.4e %12.4e\n", Ith(yB,1), Ith(yB,2), Ith(yB,3)); #endif printf("--------------------------------------------------------\n\n"); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_bnd.c0000600000175000017500000003236011741421151023601 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem with a banded Jacobian, * with the program for its solution by CVODE. * The problem is the semi-discrete form of the advection-diffusion * equation in 2-D: * du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 * on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time * interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions * are posed, and the initial condition is * u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). * The PDE is discretized on a uniform MX+2 by MY+2 grid with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX*MY. * This program solves the problem with the BDF method, Newton * iteration with the CVBAND band linear solver, and a user-supplied * Jacobian routine. * It uses scalar relative and absolute tolerances. * Output is printed at t = .1, .2, ..., 1. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include #include #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVBand */ #include /* serial N_Vector types, fcts., and macros */ #include /* definitions of type DlsMat and macros */ #include /* definition of type realtype */ #include /* definition of ABS and EXP */ /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundaries */ #define YMAX RCONST(1.0) #define MX 10 /* mesh dimensions */ #define MY 5 #define NEQ MX*MY /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.1) /* first output time */ #define DTOUT RCONST(0.1) /* output time increment */ #define NOUT 10 /* number of output times */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FIVE RCONST(5.0) /* User-defined vector access macro IJth */ /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= MX, 1 <= j <= MY. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*MY]) /* Type : UserData (contains grid constants) */ typedef struct { realtype dx, dy, hdcoef, hacoef, vdcoef; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, UserData data); static void PrintHeader(realtype reltol, realtype abstol, realtype umax); static void PrintOutput(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype dx, dy, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag; long int nst; u = NULL; data = NULL; cvode_mem = NULL; /* Create a serial vector */ u = N_VNew_Serial(NEQ); /* Allocate u vector */ if(check_flag((void*)u, "N_VNew_Serial", 0)) return(1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2)) return(1); dx = data->dx = XMAX/(MX+1); /* Set grid coefficients in data */ dy = data->dy = YMAX/(MY+1); data->hdcoef = ONE/(dx*dx); data->hacoef = HALF/(TWO*dx); data->vdcoef = ONE/(dy*dy); SetIC(u, data); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerance */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVBand to specify the CVBAND band linear solver */ flag = CVBand(cvode_mem, NEQ, MY, MY); if(check_flag(&flag, "CVBand", 1)) return(1); /* Set the user-supplied Jacobian routine Jac */ flag = CVDlsSetBandJacFn(cvode_mem, Jac); if(check_flag(&flag, "CVDlsSetBandJacFn", 1)) return(1); /* In loop over output points: call CVode, print results, test for errors */ umax = N_VMaxNorm(u); PrintHeader(reltol, abstol, umax); for(iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); PrintOutput(t, umax, nst); } PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Serial(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free the user data */ return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u,N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); } /* Jacobian routine. Compute J(t,u). */ static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* The components of f = udot that depend on u(i,j) are f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*EXP(FIVE*x*y); } } } /* Print first lines of output (problem description) */ static void PrintHeader(realtype reltol, realtype abstol, realtype umax) { printf("\n2-D Advection-Diffusion Equation\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Total system size = %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: reltol = %Lg abstol = %Lg\n\n", reltol, abstol); printf("At t = %Lg max.norm(u) =%14.6Le \n", T0, umax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: reltol = %lg abstol = %lg\n\n", reltol, abstol); printf("At t = %lg max.norm(u) =%14.6le \n", T0, umax); #else printf("Tolerance parameters: reltol = %g abstol = %g\n\n", reltol, abstol); printf("At t = %g max.norm(u) =%14.6e \n", T0, umax); #endif return; } /* Print current value */ static void PrintOutput(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst = %4ld\n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst = %4ld\n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst = %4ld\n", t, umax, nst); #endif return; } /* Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { int flag; long int nst, nfe, nsetups, netf, nni, ncfn, nje, nfeLS; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_kry_bp.c0000600000175000017500000004437311741421151024426 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODES, with the BDF/GMRES * method (i.e. using the CVSPGMR linear solver) and a banded * preconditioner, generated by difference quotients, using the * module CVBANDPRE. The problem is solved with left and right * preconditioning. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* prototypes & constants for CVBANDPRE module */ #include /* serial N_Vector types, fct. and macros */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains problem constants */ typedef struct { realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static void InitUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintIntro(long int mu, long int ml); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Function Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int flag, iout, jpre; long int ml, mu; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate and initialize u, and set problem data and tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol = ATOL; reltol = RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* Call CVBandPreInit to initialize band preconditioner */ ml = mu = 2; flag = CVBandPrecInit(cvode_mem, NEQ, mu, ml); if(check_flag(&flag, "CVBandPrecInit", 0)) return(1); PrintIntro(mu, ml); /* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { /* On second run, re-initialize u, the solver, and CVSPGMR */ if (jpre == PREC_RIGHT) { SetInitialProfiles(u, data->dx, data->dy); flag = CVodeReInit(cvode_mem, T0, u); if(check_flag(&flag, "CVodeReInit", 1)) return(1); flag = CVSpilsSetPrecType(cvode_mem, PREC_RIGHT); check_flag(&flag, "CVSpilsSetPrecType", 1); printf("\n\n-------------------------------------------------------"); printf("------------\n"); } printf("\n\nPreconditioner type is: jpre = %s\n\n", (jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT"); /* In loop over output points, call CVode, print results, test for error */ for (iout = 1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); PrintOutput(cvode_mem, u, t); if (flag != CV_SUCCESS) { break; } } /* Print final statistics */ PrintFinalStats(cvode_mem); } /* End of jpre loop */ /* Free memory */ N_VDestroy_Serial(u); free(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy = 0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx = 0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } static void PrintIntro(long int mu, long int ml) { printf("2-species diurnal advection-diffusion problem, %d by %d mesh\n", MX, MY); printf("SPGMR solver; band preconditioner; mu = %d, ml = %d\n\n", mu, ml); return; } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u,realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int lenrwBP, leniwBP; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; long int nfeBP; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); flag = CVBandPrecGetWorkSpace(cvode_mem, &lenrwBP, &leniwBP); check_flag(&flag, "CVBandPrecGetWorkSpace", 1); flag = CVBandPrecGetNumRhsEvals(cvode_mem, &nfeBP); check_flag(&flag, "CVBandPrecGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwls = %5ld leniwls = %5ld\n", lenrwLS, leniwLS); printf("lenrwbp = %5ld leniwbp = %5ld\n", lenrwBP, leniwBP); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfetot = %5ld\n" , nfe, nfe+nfeLS+nfeBP); printf("nfeLS = %5ld nfeBP = %5ld\n" , nfeLS, nfeBP); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Function called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot,void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int idn, iup, ileft, iright, jx, jy; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy = 0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx = 0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsFoodWeb_ASAp_kry.c0000600000175000017500000011421611741421151024532 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2011/11/23 23:53:02 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * This program solves a stiff ODE system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector * is the following: * * 1 2 ns * c = (c , c , ..., c ) * * and the PDEs are as follows: * * i i i * dc /dt = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c *(b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2*np, with the first np being prey * and the last np being predators. The coefficients a(i,j), b(i), * d(i) are: * * a(i,i) = -a (all i) * a(i,j) = -g (i <= np, j > np) * a(i,j) = e (i > np, j <= np) * b(i) = b*(1 + alpha*x*y) (i <= np) * b(i) = -b*(1 + alpha*x*y) (i > np) * d(i) = Dprey (i <= np) * d(i) = Dpred (i > np) * * The spatial domain is the unit square. The final time is 10. * The boundary conditions are: normal derivative = 0. * A polynomial in x and y is used to set the initial conditions. * * The PDEs are discretized by central differencing on an MX by * MY mesh. The resulting ODE system is stiff. * * The ODE system is solved by CVODES using Newton iteration and * the CVSPGMR linear solver (scaled preconditioned GMRES). * * The preconditioner matrix used is the product of two matrices: * (1) A matrix, only defined implicitly, based on a fixed number * of Gauss-Seidel iterations using the diffusion terms only. * (2) A block-diagonal matrix based on the partial derivatives * of the interaction terms f only, using block-grouping (computing * only a subset of the ns by ns blocks). * * Additionally, CVODES can integrate backwards in time the * the semi-discrete form of the adjoint PDE: * d(lambda)/dt = - D^T ( lambda_xx + lambda_yy ) * - F_c^T lambda * with homogeneous Neumann boundary conditions and final conditions * lambda(x,y,t=t_final) = - g_c^T(t_final) * whose solution at t = 0 represents the sensitivity of * int_x int _y g(t_final,c) dx dy dt * with respect to the initial conditions of the original problem. * * In this example, * g(t,c) = c(ISPEC), with ISPEC defined below. * ----------------------------------------------------------------- * Reference: Peter N. Brown and Alan C. Hindmarsh, Reduced Storage * Matrix Methods in Stiff ODE Systems, J. Appl. Math. & Comp., 31 * (1989), pp. 40-91. Also available as Lawrence Livermore National * Laboratory Report UCRL-95088, Rev. 1, June 1987. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Problem Specification Constants */ #define AA ONE /* AA = a */ #define EE RCONST(1.0e4) /* EE = e */ #define GG RCONST(0.5e-6) /* GG = g */ #define BB ONE /* BB = b */ #define DPREY ONE #define DPRED RCONST(0.5) #define ALPH ONE #define NP 3 #define NS (2*NP) /* Method Constants */ #define MX 20 #define MY 20 #define MXNS (MX*NS) #define AX ONE #define AY ONE #define DX (AX/(realtype)(MX-1)) #define DY (AY/(realtype)(MY-1)) #define MP NS #define MQ (MX*MY) #define MXMP (MX*MP) #define NGX 2 #define NGY 2 #define NGRP (NGX*NGY) #define ITMAX 5 /* CVodeInit Constants */ #define NEQ (NS*MX*MY) #define T0 ZERO #define RTOL RCONST(1.0e-5) #define ATOL RCONST(1.0e-5) /* Output Constants */ #define TOUT RCONST(10.0) /* Note: The value for species i at mesh point (j,k) is stored in */ /* component number (i-1) + j*NS + k*NS*MX of an N_Vector, */ /* where 1 <= i <= NS, 0 <= j < MX, 0 <= k < MY. */ /* Structure for user data */ typedef struct { realtype **P[NGRP]; long int *pivot[NGRP]; int ns, mxns, mp, mq, mx, my, ngrp, ngx, ngy, mxmp; int jgx[NGX+1], jgy[NGY+1], jigx[MX], jigy[MY]; int jxr[NGX], jyr[NGY]; realtype acoef[NS][NS], bcoef[NS], diff[NS]; realtype cox[NS], coy[NS], dx, dy, srur; realtype fsave[NEQ]; realtype fBsave[NEQ]; N_Vector rewt; void *cvode_mem; int indexB; } *WebData; /* Adjoint calculation constants */ /* g = int_x int_y c(ISPEC) dy dx at t = Tfinal */ #define NSTEPS 80 /* check points every NSTEPS steps */ #define ISPEC 6 /* species # in objective */ /* Prototypes for user-supplied functions */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype t, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); static int fB(realtype t, N_Vector c, N_Vector cB, N_Vector cBdot, void *user_data); static int PrecondB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolveB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Prototypes for private functions */ static WebData AllocUserData(void); static void InitUserData(WebData wdata); static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]); static void CInit(N_Vector c, WebData wdata); static void CbInit(N_Vector c, int is, WebData wdata); static void PrintOutput(N_Vector c, int ns, int mxns, WebData wdata); static void FreeUserData(WebData wdata); static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata); static void WebRatesB(realtype x, realtype y, realtype t, realtype c[], realtype cB[], realtype rate[], realtype rateB[], WebData wdata); static void fblock (realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata); static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata); static realtype doubleIntgr(N_Vector c, int i, WebData wdata); static int check_flag(void *flagvalue, char *funcname, int opt); /* Small Vector Kernels */ static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n); static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n); static void v_prod(realtype u[], realtype v[], realtype w[], int n); static void v_zero(realtype u[], int n); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { realtype abstol=ATOL, reltol=RTOL, t; N_Vector c; WebData wdata; void *cvode_mem; int flag, ncheck; int indexB; realtype reltolB=RTOL, abstolB=ATOL; N_Vector cB; c = cB = NULL; wdata = NULL; cvode_mem = NULL; /* Allocate and initialize user data */ wdata = AllocUserData(); if(check_flag((void *)wdata, "AllocUserData", 2)) return(1); InitUserData(wdata); /* Set-up forward problem */ /* Initializations */ c = N_VNew_Serial(NEQ); if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1); CInit(c, wdata); /* Call CVodeCreate/CVodeInit for forward run */ printf("\nCreate and allocate CVODES memory for forward run\n"); cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); wdata->cvode_mem = cvode_mem; /* Used in Precond */ flag = CVodeSetUserData(cvode_mem, wdata); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeInit(cvode_mem, f, T0, c); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr for forward run */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* Set-up adjoint calculations */ printf("\nAllocate global memory\n"); flag = CVodeAdjInit(cvode_mem, NSTEPS, CV_HERMITE); if(check_flag(&flag, "CVodeAdjInit", 1)) return(1); /* Perform forward run */ printf("\nForward integration\n"); flag = CVodeF(cvode_mem, TOUT, c, &t, CV_NORMAL, &ncheck); if(check_flag(&flag, "CVodeF", 1)) return(1); printf("\nncheck = %d\n", ncheck); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("\n g = int_x int_y c%d(Tfinal,x,y) dx dy = %Lf \n\n", ISPEC, doubleIntgr(c,ISPEC,wdata)); #else printf("\n g = int_x int_y c%d(Tfinal,x,y) dx dy = %f \n\n", ISPEC, doubleIntgr(c,ISPEC,wdata)); #endif /* Set-up backward problem */ /* Allocate cB */ cB = N_VNew_Serial(NEQ); if(check_flag((void *)cB, "N_VNew_Serial", 0)) return(1); /* Initialize cB = 0 */ CbInit(cB, ISPEC, wdata); /* Create and allocate CVODES memory for backward run */ printf("\nCreate and allocate CVODES memory for backward run\n"); flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB); if(check_flag(&flag, "CVodeCreateB", 1)) return(1); flag = CVodeSetUserDataB(cvode_mem, indexB, wdata); if(check_flag(&flag, "CVodeSetUserDataB", 1)) return(1); flag = CVodeInitB(cvode_mem, indexB, fB, TOUT, cB); if(check_flag(&flag, "CVodeInitB", 1)) return(1); flag = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB); if(check_flag(&flag, "CVodeSStolerancesB", 1)) return(1); wdata->indexB = indexB; /* Call CVSpgmr */ flag = CVSpgmrB(cvode_mem, indexB, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmrB", 1)) return(1); flag = CVSpilsSetPreconditionerB(cvode_mem, indexB, PrecondB, PSolveB); if(check_flag(&flag, "CVSpilsSetPreconditionerB", 1)) return(1); /* Perform backward integration */ printf("\nBackward integration\n"); flag = CVodeB(cvode_mem, T0, CV_NORMAL); if(check_flag(&flag, "CVodeB", 1)) return(1); flag = CVodeGetB(cvode_mem, indexB, &t, cB); if(check_flag(&flag, "CVodeGetB", 1)) return(1); PrintOutput(cB, NS, MXNS, wdata); /* Free all memory */ CVodeFree(&cvode_mem); N_VDestroy_Serial(c); N_VDestroy_Serial(cB); FreeUserData(wdata); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * This routine computes the right-hand side of the ODE system and * returns it in cdot. The interaction rates are computed by calls to WebRates, * and these are saved in fsave for use in preconditioning. */ static int f(realtype t, N_Vector c, N_Vector cdot, void *user_data) { int i, ic, ici, idxl, idxu, idyl, idyu, iyoff, jx, jy, ns, mxns; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy; realtype *cdata, *cdotdata; WebData wdata; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cdotdata = NV_DATA_S(cdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRates(x, y, t, cdata+ic, fsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cdata[ici] - cdata[ici-idyl]; dcyui = cdata[ici+idyu] - cdata[ici]; /* Do differencing in x. */ dcxli = cdata[ici] - cdata[ici-idxl]; dcxui = cdata[ici+idxu] - cdata[ici]; /* Collect terms and load cdot elements. */ cdotdata[ici] = coy[i-1]*(dcyui - dcyli) + cox[i-1]*(dcxui - dcxli) + fsave[ici]; } } } return(0); } /* * This routine generates the block-diagonal part of the Jacobian * corresponding to the interaction rates, multiplies by -gamma, adds * the identity matrix, and calls denseGETRF to do the LU decomposition of * each diagonal block. The computation of the diagonal blocks uses * the preset block and grouping information. One block per group is * computed. The Jacobian elements are generated by difference * quotients using calls to the routine fblock. * * This routine can be regarded as a prototype for the general case * of a block-diagonal preconditioner. The blocks are of size mp, and * there are ngrp=ngx*ngy blocks computed in the block-grouping scheme. */ static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype ***P; long int **pivot, ier; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag; long int mp; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; WebData wdata; N_Vector rewt; wdata = (WebData) user_data; rewt = wdata->rewt; flag = CVodeGetErrWeights(wdata->cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); cdata = NV_DATA_S(c); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fc, rewt); r0 = RCONST(1000.0)*ABS(gamma)*uround*NEQ*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = -gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][j][i] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* * This routine applies two inverse preconditioner matrices * to the vector r, using the interaction-only block-diagonal Jacobian * with block-grouping, denoted Jr, and Gauss-Seidel applied to the * diffusion contribution to the Jacobian, denoted Jd. * It first calls GSIter for a Gauss-Seidel approximation to * ((I - gamma*Jd)-inverse)*r, and stores the result in z. * Then it computes ((I - gamma*Jr)-inverse)*z, using LU factors of the * blocks in P, and pivot information in pivot, and returns the result in z. */ static int PSolve(realtype t, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx, mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations */ GSIter(gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } return(0); } /* * This routine computes the right-hand side of the adjoint ODE system and * returns it in cBdot. The interaction rates are computed by calls to WebRates, * and these are saved in fsave for use in preconditioning. The adjoint * interaction rates are computed by calls to WebRatesB. */ static int fB(realtype t, N_Vector c, N_Vector cB, N_Vector cBdot, void *user_data) { int i, ic, ici, idxl, idxu, idyl, idyu, iyoff, jx, jy, ns, mxns; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, *fBsave, dx, dy; realtype *cdata, *cBdata, *cBdotdata; WebData wdata; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cBdata = NV_DATA_S(cB); cBdotdata = NV_DATA_S(cBdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; fBsave = wdata->fBsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRatesB(x, y, t, cdata+ic, cBdata+ic, fsave+ic, fBsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cBdata[ici] - cBdata[ici-idyl]; dcyui = cBdata[ici+idyu] - cBdata[ici]; /* Do differencing in x. */ dcxli = cBdata[ici] - cBdata[ici-idxl]; dcxui = cBdata[ici+idxu] - cBdata[ici]; /* Collect terms and load cdot elements. */ cBdotdata[ici] = - coy[i-1]*(dcyui - dcyli) - cox[i-1]*(dcxui - dcxli) - fBsave[ici]; } } } return(0); } /* * Preconditioner setup function for the backward problem */ static int PrecondB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype ***P; long int **pivot, ier; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, mp, ngrp, ngx, ngy, mxmp, flag; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; void *cvode_mem; WebData wdata; N_Vector rewt; wdata = (WebData) user_data; cvode_mem = CVodeGetAdjCVodeBmem(wdata->cvode_mem, wdata->indexB); if(check_flag((void *)cvode_mem, "CVadjGetCVodeBmem", 0)) return(1); rewt = wdata->rewt; flag = CVodeGetErrWeights(cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); cdata = NV_DATA_S(c); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fcB, rewt); r0 = RCONST(1000.0)*ABS(gamma)*uround*NEQ*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][i][j] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* * Preconditioner solve function for the backward problem */ static int PSolveB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx; long int mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations (same routine but with gamma=-gamma) */ GSIter(-gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Allocate space for user data structure */ static WebData AllocUserData(void) { int i, ngrp = NGRP; long int ns = NS; WebData wdata; wdata = (WebData) malloc(sizeof *wdata); for(i=0; i < ngrp; i++) { (wdata->P)[i] = newDenseMat(ns, ns); (wdata->pivot)[i] = newLintArray(ns); } wdata->rewt = N_VNew_Serial(NEQ); return(wdata); } /* * Initialize user data structure */ static void InitUserData(WebData wdata) { int i, j, ns; realtype *bcoef, *diff, *cox, *coy, dx, dy; realtype (*acoef)[NS]; acoef = wdata->acoef; bcoef = wdata->bcoef; diff = wdata->diff; cox = wdata->cox; coy = wdata->coy; ns = wdata->ns = NS; for (j = 0; j < NS; j++) { for (i = 0; i < NS; i++) acoef[i][j] = ZERO; } for (j = 0; j < NP; j++) { for (i = 0; i < NP; i++) { acoef[NP+i][j] = EE; acoef[i][NP+j] = -GG; } acoef[j][j] = -AA; acoef[NP+j][NP+j] = -AA; bcoef[j] = BB; bcoef[NP+j] = -BB; diff[j] = DPREY; diff[NP+j] = DPRED; } /* Set remaining problem parameters */ wdata->mxns = MXNS; dx = wdata->dx = DX; dy = wdata->dy = DY; for (i = 0; i < ns; i++) { cox[i] = diff[i]/SQR(dx); coy[i] = diff[i]/SQR(dy); } /* Set remaining method parameters */ wdata->mp = MP; wdata->mq = MQ; wdata->mx = MX; wdata->my = MY; wdata->srur = SQRT(UNIT_ROUNDOFF); wdata->mxmp = MXMP; wdata->ngrp = NGRP; wdata->ngx = NGX; wdata->ngy = NGY; SetGroups(MX, NGX, wdata->jgx, wdata->jigx, wdata->jxr); SetGroups(MY, NGY, wdata->jgy, wdata->jigy, wdata->jyr); } /* * This routine sets arrays jg, jig, and jr describing * a uniform partition of (0,1,2,...,m-1) into ng groups. * The arrays set are: * jg = length ng+1 array of group boundaries. * Group ig has indices j = jg[ig],...,jg[ig+1]-1. * jig = length m array of group indices vs node index. * Node index j is in group jig[j]. * jr = length ng array of indices representing the groups. * The index for group ig is j = jr[ig]. */ static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]) { int ig, j, len1, mper, ngm1; mper = m/ng; /* does integer division */ for (ig=0; ig < ng; ig++) jg[ig] = ig*mper; jg[ng] = m; ngm1 = ng - 1; len1 = ngm1*mper; for (j = 0; j < len1; j++) jig[j] = j/mper; for (j = len1; j < m; j++) jig[j] = ngm1; for (ig = 0; ig < ngm1; ig++) jr[ig] = ((2*ig+1)*mper-1)/2; jr[ngm1] = (ngm1*mper+m-1)/2; } /* * This routine computes and loads the vector of initial values. */ static void CInit(N_Vector c, WebData wdata) { int i, ici, ioff, iyoff, jx, jy, ns, mxns; realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata; cdata = NV_DATA_S(c); ns = wdata->ns; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; x_factor = RCONST(4.0)/SQR(AX); y_factor = RCONST(4.0)/SQR(AY); for (jy = 0; jy < MY; jy++) { y = jy*dy; argy = SQR(y_factor*y*(AY-y)); iyoff = mxns*jy; for (jx = 0; jx < MX; jx++) { x = jx*dx; argx = SQR(x_factor*x*(AX-x)); ioff = iyoff + ns*jx; for (i = 1; i <= ns; i++) { ici = ioff + i-1; cdata[ici] = RCONST(10.0) + i*argx*argy; } } } } /* * This function computes and loads the final values for the adjoint variables */ static void CbInit(N_Vector c, int is, WebData wdata) { int i, ici, ioff, iyoff, jx, jy, ns, mxns; realtype *cdata; realtype gu[NS]; cdata = NV_DATA_S(c); ns = wdata->ns; mxns = wdata->mxns; for ( i = 1; i <= ns; i++ ) gu[i-1] = ZERO; gu[ISPEC-1] = ONE; for (jy = 0; jy < MY; jy++) { iyoff = mxns*jy; for (jx = 0; jx < MX; jx++) { ioff = iyoff + ns*jx; for (i = 1; i <= ns; i++) { ici = ioff + i-1; cdata[ici] = gu[i-1]; } } } } /* * This routine computes the interaction rates for the species * c_1, ... ,c_ns (stored in c[0],...,c[ns-1]), at one spatial point * and at time t. */ static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; for (i = 0; i < ns; i++) rate[i] = ZERO; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += c[j] * acoef[i][j]; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = c[i]*(bcoef[i]*fac + rate[i]); } /* * This routine computes the interaction rates for the backward problem */ static void WebRatesB(realtype x, realtype y, realtype t, realtype c[], realtype cB[], realtype rate[], realtype rateB[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = bcoef[i]*fac; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += acoef[i][j]*c[j]; for (i = 0; i < ns; i++) { rateB[i] = cB[i]*rate[i]; rate[i] = c[i]*rate[i]; } for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rateB[i] += acoef[j][i]*c[j]*cB[j]; } /* * This routine computes one block of the interaction terms of the * system, namely block (jx,jy), for use in preconditioning. * Here jx and jy count from 0. */ static void fblock(realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata) { int iblok, ic; realtype x, y; iblok = jx + jy*(wdata->mx); y = jy*(wdata->dy); x = jx*(wdata->dx); ic = (wdata->ns)*(iblok); WebRates(x, y, t, cdata+ic, cdotdata, wdata); } /* * This routine performs ITMAX=5 Gauss-Seidel iterations to compute an * approximation to (P-inverse)*z, where P = I - gamma*Jd, and * Jd represents the diffusion contributions to the Jacobian. * The answer is stored in z on return, and x is a temporary vector. * The dimensions below assume a global constant NS >= ns. * Some inner loops of length ns are implemented with the small * vector kernels v_sum_prods, v_prod, v_inc_by_prod. */ static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata) { int i, ic, iter, iyoff, jx, jy, ns, mxns, mx, my, x_loc, y_loc; realtype beta[NS], beta2[NS], cof1[NS], gam[NS], gam2[NS]; realtype temp, *cox, *coy, *xd, *zd; xd = NV_DATA_S(x); zd = NV_DATA_S(z); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; cox = wdata->cox; coy = wdata->coy; /* Write matrix as P = D - L - U. Load local arrays beta, beta2, gam, gam2, and cof1. */ for (i = 0; i < ns; i++) { temp = ONE/(ONE + TWO*gamma*(cox[i] + coy[i])); beta[i] = gamma*cox[i]*temp; beta2[i] = TWO*beta[i]; gam[i] = gamma*coy[i]*temp; gam2[i] = TWO*gam[i]; cof1[i] = temp; } /* Begin iteration loop. Load vector x with (D-inverse)*z for first iteration. */ for (jy = 0; jy < my; jy++) { iyoff = mxns*jy; for (jx = 0; jx < mx; jx++) { ic = iyoff + ns*jx; v_prod(xd+ic, cof1, zd+ic, ns); /* x[ic+i] = cof1[i]z[ic+i] */ } } N_VConst(ZERO, z); /* Looping point for iterations. */ for (iter=1; iter <= ITMAX; iter++) { /* Calculate (D-inverse)*U*x if not the first iteration. */ if (iter > 1) { for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] = gam2[i]x[ic+mxns+i] */ v_prod(xd+ic, gam2, xd+ic+mxns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] = gam[i]x[ic+mxns+i] */ v_prod(xd+ic, gam, xd+ic+mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] = beta2[i]x[ic+ns+i] */ v_prod(xd+ic, beta2, xd+ic+ns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] = beta[i]x[ic+ns+i] */ v_prod(xd+ic, beta, xd+ic+ns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] = ZERO */ v_zero(xd+ic, ns); break; } } } } /* end if (iter > 1) */ /* Overwrite x with [(I - (D-inverse)*L)-inverse]*x. */ for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] += beta[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] += beta2[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] += gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] += gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; } } } /* Add increment x to z : z <- z+x */ N_VLinearSum(ONE, z, ONE, x, z); } } static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] += v[i]*w[i]; } static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = p[i]*q[i] + v[i]*w[i]; } static void v_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = v[i]*w[i]; } static void v_zero(realtype u[], int n) { int i; for (i=0; i < n; i++) u[i] = ZERO; } /* * Print maximum sensitivity of G for each species */ static void PrintOutput(N_Vector cB, int ns, int mxns, WebData wdata) { int i, jx, jy; realtype *cdata, cij, cmax, x, y; x = y = ZERO; cdata = NV_DATA_S(cB); for (i=1; i <= ns; i++) { cmax = ZERO; for (jy=MY-1; jy >= 0; jy--) { for (jx=0; jx < MX; jx++) { cij = cdata[(i-1) + jx*ns + jy*mxns]; if (ABS(cij) > cmax) { cmax = cij; x = jx * wdata->dx; y = jy * wdata->dy; } } } printf("\nMaximum sensitivity with respect to I.C. of species %d\n", i); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" mu max = %Le\n",cmax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" mu max = %le\n",cmax); #else printf(" mu max = %e\n",cmax); #endif printf("at\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" x = %Le\n y = %Le\n", x, y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" x = %le\n y = %le\n", x, y); #else printf(" x = %e\n y = %e\n", x, y); #endif } } /* * Compute double space integral */ static realtype doubleIntgr(N_Vector c, int i, WebData wdata) { realtype *cdata; int ns, mx, my, mxns; realtype dx, dy; realtype intgr_xy, intgr_x; int jx, jy; cdata = NV_DATA_S(c); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; jy = 0; intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += TWO*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy = intgr_x; for (jy = 1; jy < my-1; jy++) { intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += TWO*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy += TWO*intgr_x; } jy = my-1; intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += TWO*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy += intgr_x; intgr_xy *= RCONST(0.5)*dy; return(intgr_xy); } /* * Free space allocated for the user data structure */ static void FreeUserData(WebData wdata) { int i, ngrp; ngrp = wdata->ngrp; for(i=0; i < ngrp; i++) { destroyMat((wdata->P)[i]); destroyArray((wdata->pivot)[i]); } N_VDestroy_Serial(wdata->rewt); free(wdata); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dnsL.c0000600000175000017500000002577711741421151024071 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:58:00 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the LAPACK dense linear solver, and a * user-supplied Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVLapackDense */ #include /* serial N_Vector types, fcts., and macros */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ #define ZERO RCONST(0.0) /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype reltol, t, tout; N_Vector y, abstol; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = abstol = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. and abstol */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); abstol = N_VNew_Serial(NEQ); if (check_flag((void *)abstol, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Set the scalar relative tolerance */ reltol = RTOL; /* Set the vector absolute tolerance */ Ith(abstol,1) = ATOL1; Ith(abstol,2) = ATOL2; Ith(abstol,3) = ATOL3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSVtolerances to specify the scalar relative tolerance * and vector absolute tolerances */ flag = CVodeSVtolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSVtolerances", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVLapackDense to specify the LAPACK dense linear solver */ flag = CVLapackDense(cvode_mem, NEQ); if (check_flag(&flag, "CVLapackDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. * Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); if (check_flag(&flagr, "CVodeGetRootInfo", 1)) return(1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y vector */ N_VDestroy_Serial(y); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,1) = ZERO; IJth(J,3,2) = RCONST(6.0e7)*y2; IJth(J,3,3) = ZERO; return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_kry.c0000600000175000017500000006232311741421151023740 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODES, with the BDF/GMRES * method (i.e. using the CVSPGMR linear solver) and the * block-diagonal part of the Newton matrix as a left * preconditioner. A copy of the block-diagonal part of the * Jacobian is saved and conditionally reused within the Precond * routine. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* serial N_Vector types, fct. and macros */ #include /* use generic DENSE solver in preconditioning */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY], **Jbd[MX][MY]; long int *pivot[MX][MY]; realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem); static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int jtv(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int iout, flag; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = AllocUserData(); if(check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol=ATOL; reltol=RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr to specify the linear solver CVSPGMR * with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* set the JAcobian-times-vector function */ flag = CVSpilsSetJacTimesVecFn(cvode_mem, jtv); if(check_flag(&flag, "CVSpilsSetJacTimesVecFn", 1)) return(1); /* Set modified Gram-Schmidt orthogonalization */ flag = CVSpilsSetGSType(cvode_mem, MODIFIED_GS); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); /* Set the preconditioner solve and setup functions */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* In loop over output points, call CVode, print results, test for error */ printf(" \n2-species diurnal advection-diffusion problem\n\n"); for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); PrintOutput(cvode_mem, u, t); if(check_flag(&flag, "CVode", 1)) break; } PrintFinalStats(cvode_mem); /* Free memory */ N_VDestroy_Serial(u); FreeUserData(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Allocate memory for data structure of type UserData */ static UserData AllocUserData(void) { int jx, jy; UserData data; data = (UserData) malloc(sizeof *data); for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { (data->P)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->Jbd)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } return(data); } /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyMat((data->Jbd)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy=0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx=0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u, realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwLS = %5ld leniwLS = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfeLS = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute RHS function f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int jx, jy, idn, iup, ileft, iright; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Jacobian-times-vector routine. */ static int jtv(N_Vector v, N_Vector Jv, realtype t, N_Vector u, N_Vector fu, void *user_data, N_Vector tmp) { realtype c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt, c1rt, c2rt; realtype v1, v2, v1dn, v2dn, v1up, v2up, v1lt, v2lt, v1rt, v2rt; realtype Jv1, Jv2; realtype cydn, cyup; realtype s, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; int jx, jy, idn, iup, ileft, iright; realtype *udata, *vdata, *Jvdata; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); vdata = NV_DATA_S(v); Jvdata = NV_DATA_S(Jv); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { data->q4 = EXP(-A4/s); } else { data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { Jv1 = ZERO; Jv2 = ZERO; /* Extract c1 and c2 at the current location and at neighbors */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); v1 = IJKth(vdata,1,jx,jy); v2 = IJKth(vdata,2,jx,jy); c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); v1dn = IJKth(vdata,1,jx,jy+idn); v2dn = IJKth(vdata,2,jx,jy+idn); v1up = IJKth(vdata,1,jx,jy+iup); v2up = IJKth(vdata,2,jx,jy+iup); ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); v1lt = IJKth(vdata,1,jx+ileft,jy); v2lt = IJKth(vdata,2,jx+ileft,jy); v1rt = IJKth(vdata,1,jx+iright,jy); v2rt = IJKth(vdata,2,jx+iright,jy); /* Set kinetic rate terms. */ //rkin1 = -Q1*C3 * c1 - Q2 * c1*c2 + q4coef * c2 + TWO*C3*q3; //rkin2 = Q1*C3 * c1 - Q2 * c1*c2 - q4coef * c2; Jv1 += -(Q1*C3 + Q2*c2) * v1 + (q4coef - Q2*c1) * v2; Jv2 += (Q1*C3 - Q2*c2) * v1 - (q4coef + Q2*c1) * v2; /* Set vertical diffusion terms. */ //vertd1 = -(cyup+cydn) * c1 + cyup * c1up + cydn * c1dn; //vertd2 = -(cyup+cydn) * c2 + cyup * c2up + cydn * c2dn; Jv1 += -(cyup+cydn) * v1 + cyup * v1up + cydn * v1dn; Jv2 += -(cyup+cydn) * v2 + cyup * v2up + cydn * v2dn; /* Set horizontal diffusion and advection terms. */ //hord1 = hordco*(c1rt - TWO*c1 + c1lt); //hord2 = hordco*(c2rt - TWO*c2 + c2lt); Jv1 += hordco*(v1rt - TWO*v1 + v1lt); Jv2 += hordco*(v2rt - TWO*v2 + v2lt); //horad1 = horaco*(c1rt - c1lt); //horad2 = horaco*(c2rt - c2lt); Jv1 += horaco*(v1rt - v1lt); Jv2 += horaco*(v2rt - v2lt); /* Load two components of J*v */ //IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; //IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; IJKth(Jvdata, 1, jx, jy) = Jv1; IJKth(Jvdata, 2, jx, jy) = Jv2; } } return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MY], **(*Jbd)[MY]; long int *(*pivot)[MY], ier; int jx, jy; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, and of pointer to u's data */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jy=0; jy < MY; jy++) { ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + TWO*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); j = Jbd[jx][jy]; a = P[jx][jy]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NUM_SPECIES, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseScale(-gamma, P[jx][jy], NUM_SPECIES, NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { denseAddIdentity(P[jx][jy], NUM_SPECIES); ier = denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MY]; long int *(*pivot)[MY]; int jx, jy; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data. */ data = (UserData) user_data; P = data->P; pivot = data->pivot; zdata = NV_DATA_S(z); N_VScale(ONE, r, z); /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { v = &(IJKth(zdata, 1, jx, jy)); denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v); } } return(0); } sundials-2.5.0/examples/cvodes/serial/CMakeLists.txt0000600000175000017500000001070711741421151023334 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.7 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for CVODES serial examples # Add variable CVODES_examples with the names of the serial CVODES examples SET(CVODES_examples cvsAdvDiff_ASAi_bnd cvsAdvDiff_bnd cvsAdvDiff_FSA_non cvsDirectDemo_ls cvsDiurnal_FSA_kry cvsDiurnal_kry_bp cvsDiurnal_kry cvsFoodWeb_ASAi_kry cvsFoodWeb_ASAp_kry cvsHessian_ASA_FSA cvsKrylovDemo_ls cvsKrylovDemo_prec cvsRoberts_ASAi_dns cvsRoberts_dns cvsRoberts_dns_uw cvsRoberts_FSA_dns ) # Add variable CVODES_examples_BL with the names of the serial CVODES examples # that use Lapack SET(CVODES_examples_BL cvsAdvDiff_bndL cvsRoberts_dnsL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODES_LIB sundials_cvodes_static) SET(NVECS_LIB sundials_nvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(CVODES_LIB sundials_cvodes_shared) SET(NVECS_LIB sundials_nvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${CVODES_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each CVODES example FOREACH(example ${CVODES_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) FILE(GLOB example_out ${example}.out*) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example_out} DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODES_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${CVODES_examples_BL}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) FILE(GLOB example_out ${example}.out*) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example_out} DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${CVODES_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "CVODES") SET(SOLVER_LIB "sundials_cvodes") LIST2STRING(CVODES_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(CVODES_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvodes/serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvodes/serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/cvodes/serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/cvodes/serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/cvodes/serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/cvodes/serial/Makefile.in0000600000175000017500000001124511741421151022637 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.12 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for CVODES serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/cvodes/libsundials_cvodes.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = cvsAdvDiff_ASAi_bnd \ cvsAdvDiff_bnd \ cvsAdvDiff_FSA_non \ cvsDirectDemo_ls \ cvsDiurnal_FSA_kry \ cvsDiurnal_kry_bp \ cvsDiurnal_kry \ cvsFoodWeb_ASAi_kry \ cvsFoodWeb_ASAp_kry \ cvsHessian_ASA_FSA \ cvsKrylovDemo_ls \ cvsKrylovDemo_prec \ cvsRoberts_ASAi_dns \ cvsRoberts_dns \ cvsRoberts_dns_uw \ cvsRoberts_FSA_dns EXAMPLES_BL = cvsAdvDiff_bndL \ cvsRoberts_dnsL OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/cvodes/serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/cvodes/serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/serial/README $(EXS_INSTDIR)/cvodes/serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/serial/$${i}.c $(EXS_INSTDIR)/cvodes/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/serial/$${i}.out $(EXS_INSTDIR)/cvodes/serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/serial/$${i}.c $(EXS_INSTDIR)/cvodes/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/cvodes/serial/$${i}.out $(EXS_INSTDIR)/cvodes/serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/cvodes/serial/Makefile rm -f $(EXS_INSTDIR)/cvodes/serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/cvodes/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvodes/serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/cvodes/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/cvodes/serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/cvodes/serial $(rminstalldirs) $(EXS_INSTDIR)/cvodes clean: rm -rf .libs rm -f *.lo rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_FSA_kry.c0000600000175000017500000007035511741421151024435 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen and Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dz)(Kv(z)*dc(i)/dz) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(z) = Kv0*exp(z/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= z <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODES, with the BDF/GMRES method * (i.e. using the CVSPGMR linear solver) and the block-diagonal * part of the Newton matrix as a left preconditioner. A copy of * the block-diagonal part of the Jacobian is saved and * conditionally reused within the Precond routine. * * Optionally, CVODES can compute sensitivities with respect to the * problem parameters q1 and q2. * Any of three sensitivity methods (SIMULTANEOUS, STAGGERED, and * STAGGERED1) can be used and sensitivities may be included in the * error test or not (error control set on FULL or PARTIAL, * respectively). * * Execution: * * If no sensitivities are desired: * % cvsDiurnal_FSA_kry -nosensi * If sensitivities are to be computed: * % cvsDiurnal_FSA_kry -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg, stg1} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include #include /* main CVODES header file */ #include /* use CVSPGMR linear */ #include /* definitions N_Vector, macro NV_DATA_S */ #include /* use generic DENSE solver for prec. */ #include /* definition of realtype */ #include /* contains macros SQR and EXP */ /* Problem Constants */ #define NUM_SPECIES 2 /* number of species */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 RCONST(0.0) /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN RCONST(0.0) /* grid boundaries in x */ #define XMAX RCONST(20.0) #define ZMIN RCONST(30.0) /* grid boundaries in z */ #define ZMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,z */ #define ZMID RCONST(40.0) #define MX 15 /* MX = number of x mesh points */ #define MZ 15 /* MZ = number of z mesh points */ #define NSMX NUM_SPECIES*MX /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MZ) /* MM = MX*MZ */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* Sensitivity Constants */ #define NP 8 #define NS 2 #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into small dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MZ-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the small matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, problem parameters, and problem constants */ typedef struct { realtype *p; realtype **P[MX][MZ], **Jbd[MX][MZ]; long int *pivot[MX][MZ]; realtype q4, om, dx, dz, hdco, haco, vdco; } *UserData; /* Prototypes of user-supplied functions */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Prototypes of private functions */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(char *name); static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector y, realtype dx, realtype dz); static void PrintOutput(void *cvode_mem, realtype t, N_Vector y); static void PrintOutputS(N_Vector *uS); static void PrintFinalStats(void *cvode_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { void *cvode_mem; UserData data; realtype abstol, reltol, t, tout; N_Vector y; int iout, flag; realtype *pbar; int is, *plist; N_Vector *uS; booleantype sensi, err_con; int sensi_meth; pbar = NULL; plist = NULL; uS = NULL; y = NULL; data = NULL; cvode_mem = NULL; /* Process arguments */ ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con); /* Problem parameters */ data = AllocUserData(); if(check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); /* Initial states */ y = N_VNew_Serial(NEQ); if(check_flag((void *)y, "N_VNew_Serial", 0)) return(1); SetInitialProfiles(y, data->dx, data->dz); /* Tolerances */ abstol=ATOL; reltol=RTOL; /* Create CVODES object */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeSetMaxNumSteps(cvode_mem, 2000); if(check_flag(&flag, "CVodeSetMaxNumSteps", 1)) return(1); /* Allocate CVODES memory */ flag = CVodeInit(cvode_mem, f, T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Attach CVSPGMR linear solver */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); printf("\n2-species diurnal advection-diffusion problem\n"); /* Forward sensitivity analysis */ if(sensi) { plist = (int *) malloc(NS * sizeof(int)); if(check_flag((void *)plist, "malloc", 2)) return(1); for(is=0; isp[plist[is]]; uS = N_VCloneVectorArray_Serial(NS, y); if(check_flag((void *)uS, "N_VCloneVectorArray_Serial", 0)) return(1); for(is=0;isp, pbar, plist); if(check_flag(&flag, "CVodeSetSensParams", 1)) return(1); printf("Sensitivity: YES "); if(sensi_meth == CV_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +"); else printf("( STAGGERED1 +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } else { printf("Sensitivity: NO "); } /* In loop over output points, call CVode, print results, test for error */ printf("\n\n"); printf("========================================================================\n"); printf(" T Q H NST Bottom left Top right \n"); printf("========================================================================\n"); for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; PrintOutput(cvode_mem, t, y); if (sensi) { flag = CVodeGetSens(cvode_mem, &t, uS); if(check_flag(&flag, "CVodeGetSens", 1)) break; PrintOutputS(uS); } printf("------------------------------------------------------------------------\n"); } /* Print final statistics */ PrintFinalStats(cvode_mem, sensi); /* Free memory */ N_VDestroy_Serial(y); if (sensi) { N_VDestroyVectorArray_Serial(uS, NS); free(pbar); free(plist); } FreeUserData(data); CVodeFree(&cvode_mem); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, czdn, czup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, zdn, zup; realtype q4coef, delz, verdco, hordco, horaco; realtype *ydata, *dydata; int jx, jz, idn, iup, ileft, iright; UserData data; realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; data = (UserData) user_data; ydata = NV_DATA_S(y); dydata = NV_DATA_S(ydot); /* Load problem coefficients and parameters */ Q1 = data->p[0]; Q2 = data->p[1]; C3 = data->p[2]; A3 = data->p[3]; A4 = data->p[4]; KH = data->p[5]; VEL = data->p[6]; KV0 = data->p[7]; /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; delz = data->dz; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jz=0; jz < MZ; jz++) { /* Set vertical diffusion coefficients at jz +- 1/2 */ zdn = ZMIN + (jz - RCONST(0.5))*delz; zup = zdn + delz; czdn = verdco*EXP(RCONST(0.2)*zdn); czup = verdco*EXP(RCONST(0.2)*zup); idn = (jz == 0) ? 1 : -1; iup = (jz == MZ-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(ydata,1,jx,jz); c2 = IJKth(ydata,2,jx,jz); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + RCONST(2.0)*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(ydata,1,jx,jz+idn); c2dn = IJKth(ydata,2,jx,jz+idn); c1up = IJKth(ydata,1,jx,jz+iup); c2up = IJKth(ydata,2,jx,jz+iup); vertd1 = czup*(c1up - c1) - czdn*(c1 - c1dn); vertd2 = czup*(c2up - c2) - czdn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(ydata,1,jx+ileft,jz); c2lt = IJKth(ydata,2,jx+ileft,jz); c1rt = IJKth(ydata,1,jx+iright,jz); c2rt = IJKth(ydata,2,jx+iright,jz); hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt); hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into ydot. */ IJKth(dydata, 1, jx, jz) = vertd1 + hord1 + horad1 + rkin1; IJKth(dydata, 2, jx, jz) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* * Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco; realtype **(*P)[MZ], **(*Jbd)[MZ]; long int *(*pivot)[MZ]; int ier, jx, jz; realtype *ydata, **a, **j; UserData data; realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; /* Make local copies of pointers in user_data, and of pointer to y's data */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; ydata = NV_DATA_S(y); /* Load problem coefficients and parameters */ Q1 = data->p[0]; Q2 = data->p[1]; C3 = data->p[2]; A3 = data->p[3]; A4 = data->p[4]; KH = data->p[5]; VEL = data->p[6]; KV0 = data->p[7]; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jz=0; jz < MZ; jz++) for (jx=0; jx < MX; jx++) denseCopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES, NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; delz = data->dz; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jz=0; jz < MZ; jz++) { zdn = ZMIN + (jz - RCONST(0.5))*delz; zup = zdn + delz; czdn = verdco*EXP(RCONST(0.2)*zdn); czup = verdco*EXP(RCONST(0.2)*zup); diag = -(czdn + czup + RCONST(2.0)*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(ydata,1,jx,jz); c2 = IJKth(ydata,2,jx,jz); j = Jbd[jx][jz]; a = P[jx][jz]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NUM_SPECIES, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jz=0; jz < MZ; jz++) for (jx=0; jx < MX; jx++) denseScale(-gamma, P[jx][jz], NUM_SPECIES, NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jz=0; jz < MZ; jz++) { denseAddIdentity(P[jx][jz], NUM_SPECIES); ier = denseGETRF(P[jx][jz], NUM_SPECIES, NUM_SPECIES, pivot[jx][jz]); if (ier != 0) return(1); } } return(0); } /* * Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MZ]; long int *(*pivot)[MZ]; int jx, jz; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data. */ data = (UserData) user_data; P = data->P; pivot = data->pivot; zdata = NV_DATA_S(z); N_VScale(ONE, r, z); /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. */ for (jx=0; jx < MX; jx++) { for (jz=0; jz < MZ; jz++) { v = &(IJKth(zdata, 1, jx, jz)); denseGETRS(P[jx][jz], NUM_SPECIES, pivot[jx][jz], v); } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Process and verify arguments to cvsfwdkryx. */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con) { *sensi = FALSE; *sensi_meth = -1; *err_con = FALSE; if (argc < 2) WrongArgs(argv[0]); if (strcmp(argv[1],"-nosensi") == 0) *sensi = FALSE; else if (strcmp(argv[1],"-sensi") == 0) *sensi = TRUE; else WrongArgs(argv[0]); if (*sensi) { if (argc != 4) WrongArgs(argv[0]); if (strcmp(argv[2],"sim") == 0) *sensi_meth = CV_SIMULTANEOUS; else if (strcmp(argv[2],"stg") == 0) *sensi_meth = CV_STAGGERED; else if (strcmp(argv[2],"stg1") == 0) *sensi_meth = CV_STAGGERED1; else WrongArgs(argv[0]); if (strcmp(argv[3],"t") == 0) *err_con = TRUE; else if (strcmp(argv[3],"f") == 0) *err_con = FALSE; else WrongArgs(argv[0]); } } static void WrongArgs(char *name) { printf("\nUsage: %s [-nosensi] [-sensi sensi_meth err_con]\n",name); printf(" sensi_meth = sim, stg, or stg1\n"); printf(" err_con = t or f\n"); exit(0); } /* * Allocate memory for data structure of type UserData */ static UserData AllocUserData(void) { int jx, jz; UserData data; data = (UserData) malloc(sizeof *data); for (jx=0; jx < MX; jx++) { for (jz=0; jz < MZ; jz++) { (data->P)[jx][jz] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->Jbd)[jx][jz] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jz] = newLintArray(NUM_SPECIES); } } data->p = (realtype *) malloc(NP*sizeof(realtype)); return(data); } /* * Load problem constants in data */ static void InitUserData(UserData data) { realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0; /* Set problem parameters */ Q1 = RCONST(1.63e-16); /* Q1 coefficients q1, q2, c3 */ Q2 = RCONST(4.66e-16); /* Q2 */ C3 = RCONST(3.7e16); /* C3 */ A3 = RCONST(22.62); /* A3 coefficient in expression for q3(t) */ A4 = RCONST(7.601); /* A4 coefficient in expression for q4(t) */ KH = RCONST(4.0e-6); /* KH horizontal diffusivity Kh */ VEL = RCONST(0.001); /* VEL advection velocity V */ KV0 = RCONST(1.0e-8); /* KV0 coefficient in Kv(z) */ data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dz = (ZMAX-ZMIN)/(MZ-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(RCONST(2.0)*data->dx); data->vdco = (ONE/SQR(data->dz))*KV0; data->p[0] = Q1; data->p[1] = Q2; data->p[2] = C3; data->p[3] = A3; data->p[4] = A4; data->p[5] = KH; data->p[6] = VEL; data->p[7] = KV0; } /* * Free user data memory */ static void FreeUserData(UserData data) { int jx, jz; for (jx=0; jx < MX; jx++) { for (jz=0; jz < MZ; jz++) { destroyMat((data->P)[jx][jz]); destroyMat((data->Jbd)[jx][jz]); destroyArray((data->pivot)[jx][jz]); } } free(data->p); free(data); } /* * Set initial conditions in y */ static void SetInitialProfiles(N_Vector y, realtype dx, realtype dz) { int jx, jz; realtype x, z, cx, cz; realtype *ydata; /* Set pointer to data array in vector y. */ ydata = NV_DATA_S(y); /* Load initial profiles of c1 and c2 into y vector */ for (jz=0; jz < MZ; jz++) { z = ZMIN + jz*dz; cz = SQR(RCONST(0.1)*(z - ZMID)); cz = ONE - cz + RCONST(0.5)*SQR(cz); for (jx=0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(ydata,1,jx,jz) = C1_SCALE*cx*cz; IJKth(ydata,2,jx,jz) = C2_SCALE*cx*cz; } } } /* * Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, realtype t, N_Vector y) { long int nst; int qu, flag; realtype hu; realtype *ydata; ydata = NV_DATA_S(y); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.3Le %2d %8.3Le %5ld\n", t,qu,hu,nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.3le %2d %8.3le %5ld\n", t,qu,hu,nst); #else printf("%8.3e %2d %8.3e %5ld\n", t,qu,hu,nst); #endif printf(" Solution "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1)); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1)); #endif } /* * Print sampled sensitivities */ static void PrintOutputS(N_Vector *uS) { realtype *sdata; sdata = NV_DATA_S(uS[0]); printf(" ----------------------------------------\n"); printf(" Sensitivity 1 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #endif sdata = NV_DATA_S(uS[1]); printf(" ----------------------------------------\n"); printf(" Sensitivity 2 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1)); #endif printf(" "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #else printf("%12.4e %12.4e \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1)); #endif } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *cvode_mem, booleantype sensi) { long int nst; long int nfe, nsetups, nni, ncfn, netf; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; long int nli, ncfl, npe, nps; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); if (sensi) { flag = CVodeGetSensNumRhsEvals(cvode_mem, &nfSe); check_flag(&flag, "CVodeGetSensNumRhsEvals", 1); flag = CVodeGetNumRhsEvalsSens(cvode_mem, &nfeS); check_flag(&flag, "CVodeGetNumRhsEvalsSens", 1); flag = CVodeGetSensNumLinSolvSetups(cvode_mem, &nsetupsS); check_flag(&flag, "CVodeGetSensNumLinSolvSetups", 1); flag = CVodeGetSensNumErrTestFails(cvode_mem, &netfS); check_flag(&flag, "CVodeGetSensNumErrTestFails", 1); flag = CVodeGetSensNumNonlinSolvIters(cvode_mem, &nniS); check_flag(&flag, "CVodeGetSensNumNonlinSolvIters", 1); flag = CVodeGetSensNumNonlinSolvConvFails(cvode_mem, &ncfnS); check_flag(&flag, "CVodeGetSensNumNonlinSolvConvFails", 1); } flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); printf("\nFinal Statistics\n\n"); printf("nst = %5ld\n\n", nst); printf("nfe = %5ld\n", nfe); printf("netf = %5ld nsetups = %5ld\n", netf, nsetups); printf("nni = %5ld ncfn = %5ld\n", nni, ncfn); if(sensi) { printf("\n"); printf("nfSe = %5ld nfeS = %5ld\n", nfSe, nfeS); printf("netfs = %5ld nsetupsS = %5ld\n", netfS, nsetupsS); printf("nniS = %5ld ncfnS = %5ld\n", nniS, ncfnS); } printf("\n"); printf("nli = %5ld ncfl = %5ld\n", nli, ncfl); printf("npe = %5ld nps = %5ld\n", npe, nps); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsKrylovDemo_ls.c0000600000175000017500000005740211741421151024250 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * * This example loops through the available iterative linear solvers: * SPGMR, SPBCG and SPTFQMR. * * Example problem: * * An ODE system is generated from the following 2-species diurnal * kinetics advection-diffusion PDE system in 2 space dimensions: * * dc(i)/dt = Kh*(d/dx)^2 c(i) + V*dc(i)/dx + (d/dy)(Kv(y)*dc(i)/dy) * + Ri(c1,c2,t) for i = 1,2, where * R1(c1,c2,t) = -q1*c1*c3 - q2*c1*c2 + 2*q3(t)*c3 + q4(t)*c2 , * R2(c1,c2,t) = q1*c1*c3 - q2*c1*c2 - q4(t)*c2 , * Kv(y) = Kv0*exp(y/5) , * Kh, V, Kv0, q1, q2, and c3 are constants, and q3(t) and q4(t) * vary diurnally. The problem is posed on the square * 0 <= x <= 20, 30 <= y <= 50 (all in km), * with homogeneous Neumann boundary conditions, and for time t in * 0 <= t <= 86400 sec (1 day). * The PDE system is treated by central differences on a uniform * 10 x 10 mesh, with simple polynomial initial profiles. * The problem is solved with CVODES, with the BDF/GMRES, * BDF/Bi-CGStab, and BDF/TFQMR methods (i.e. using the CVSPGMR, * CVSPBCG and CVSPTFQMR linear solvers) and the block-diagonal * part of the Newton matrix as a left preconditioner. A copy of * the block-diagonal part of the Jacobian is saved and * conditionally reused within the Precond routine. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* prototypes & constants for CVSPBCG solver */ #include /* prototypes & constants for CVSPTFQMR solver */ #include /* serial N_Vector types, fct. and macros */ #include /* use generic DENSE solver in preconditioning */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP */ /* Problem Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define NUM_SPECIES 2 /* number of species */ #define KH RCONST(4.0e-6) /* horizontal diffusivity Kh */ #define VEL RCONST(0.001) /* advection velocity V */ #define KV0 RCONST(1.0e-8) /* coefficient in Kv(y) */ #define Q1 RCONST(1.63e-16) /* coefficients q1, q2, c3 */ #define Q2 RCONST(4.66e-16) #define C3 RCONST(3.7e16) #define A3 RCONST(22.62) /* coefficient in expression for q3(t) */ #define A4 RCONST(7.601) /* coefficient in expression for q4(t) */ #define C1_SCALE RCONST(1.0e6) /* coefficients in initial profiles */ #define C2_SCALE RCONST(1.0e12) #define T0 ZERO /* initial time */ #define NOUT 12 /* number of output times */ #define TWOHR RCONST(7200.0) /* number of seconds in two hours */ #define HALFDAY RCONST(4.32e4) /* number of seconds in a half day */ #define PI RCONST(3.1415926535898) /* pi */ #define XMIN ZERO /* grid boundaries in x */ #define XMAX RCONST(20.0) #define YMIN RCONST(30.0) /* grid boundaries in y */ #define YMAX RCONST(50.0) #define XMID RCONST(10.0) /* grid midpoints in x,y */ #define YMID RCONST(40.0) #define MX 10 /* MX = number of x mesh points */ #define MY 10 /* MY = number of y mesh points */ #define NSMX 20 /* NSMX = NUM_SPECIES*MX */ #define MM (MX*MY) /* MM = MX*MY */ /* CVodeInit Constants */ #define RTOL RCONST(1.0e-5) /* scalar relative tolerance */ #define FLOOR RCONST(100.0) /* value of C1 or C2 at which tolerances */ /* change from relative to absolute */ #define ATOL (RTOL*FLOOR) /* scalar absolute tolerance */ #define NEQ (NUM_SPECIES*MM) /* NEQ = number of equations */ /* Linear Solver Loop Constants */ #define USE_SPGMR 0 #define USE_SPBCG 1 #define USE_SPTFQMR 2 /* User-defined vector and matrix accessor macros: IJKth, IJth */ /* IJKth is defined in order to isolate the translation from the mathematical 3-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth is defined in order to write code which indexes into dense matrices with a (row,column) pair, where 1 <= row, column <= NUM_SPECIES. IJKth(vdata,i,j,k) references the element in the vdata array for species i at mesh point (j,k), where 1 <= i <= NUM_SPECIES, 0 <= j <= MX-1, 0 <= k <= MY-1. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. For each mesh point (j,k), the elements for species i and i+1 are contiguous within vdata. IJth(a,i,j) references the (i,j)th entry of the matrix realtype **a, where 1 <= i,j <= NUM_SPECIES. The small matrix routines in sundials_dense.h work with matrices stored by column in a 2-dimensional array. In C, arrays are indexed starting at 0, not 1. */ #define IJKth(vdata,i,j,k) (vdata[i-1 + (j)*NUM_SPECIES + (k)*NSMX]) #define IJth(a,i,j) (a[j-1][i-1]) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY], **Jbd[MX][MY]; long int *pivot[MX][MY]; realtype q4, om, dx, dy, hdco, haco, vdco; } *UserData; /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy); static void PrintOutput(void *cvode_mem, N_Vector u, realtype t); static void PrintFinalStats(void *cvode_mem, int linsolver); static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *cvode_mem; int linsolver, iout, flag; u = NULL; data = NULL; cvode_mem = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); data = AllocUserData(); if(check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); abstol=ATOL; reltol=RTOL; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerances */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ for (linsolver = 0; linsolver < 3; ++linsolver) { if (linsolver != 0) { /* Re-initialize user data */ InitUserData(data); SetInitialProfiles(u, data->dx, data->dy); /* Re-initialize CVode for the solution of the same problem, but using a different linear solver module */ flag = CVodeReInit(cvode_mem, T0, u); if (check_flag(&flag, "CVodeReInit", 1)) return(1); } /* Attach a linear solver module */ switch(linsolver) { /* (a) SPGMR */ case(USE_SPGMR): /* Print header */ printf(" -------"); printf(" \n| SPGMR |\n"); printf(" -------\n"); /* Call CVSpgmr to specify the linear solver CVSPGMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); /* Set modified Gram-Schmidt orthogonalization, preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetGSType(cvode_mem, MODIFIED_GS); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); break; /* (b) SPBCG */ case(USE_SPBCG): /* Print header */ printf(" -------"); printf(" \n| SPBCG |\n"); printf(" -------\n"); /* Call CVSpbcg to specify the linear solver CVSPBCG with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSpbcg(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpbcg", 1)) return(1); break; /* (c) SPTFQMR */ case(USE_SPTFQMR): /* Print header */ printf(" ---------"); printf(" \n| SPTFQMR |\n"); printf(" ---------\n"); /* Call CVSptfqmr to specify the linear solver CVSPTFQMR with left preconditioning and the maximum Krylov dimension maxl */ flag = CVSptfqmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSptfqmr", 1)) return(1); break; } /* Set preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* In loop over output points, call CVode, print results, test for error */ printf(" \n2-species diurnal advection-diffusion problem\n\n"); for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); PrintOutput(cvode_mem, u, t); if(check_flag(&flag, "CVode", 1)) break; } PrintFinalStats(cvode_mem, linsolver); } /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ /* Free memory */ N_VDestroy_Serial(u); FreeUserData(data); CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Allocate memory for data structure of type UserData */ static UserData AllocUserData(void) { int jx, jy; UserData data; data = (UserData) malloc(sizeof *data); for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { (data->P)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->Jbd)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } return(data); } /* Load problem constants in data */ static void InitUserData(UserData data) { data->om = PI/HALFDAY; data->dx = (XMAX-XMIN)/(MX-1); data->dy = (YMAX-YMIN)/(MY-1); data->hdco = KH/SQR(data->dx); data->haco = VEL/(TWO*data->dx); data->vdco = (ONE/SQR(data->dy))*KV0; } /* Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyMat((data->Jbd)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } free(data); } /* Set initial conditions in u */ static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy) { int jx, jy; realtype x, y, cx, cy; realtype *udata; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profiles of c1 and c2 into u vector */ for (jy=0; jy < MY; jy++) { y = YMIN + jy*dy; cy = SQR(RCONST(0.1)*(y - YMID)); cy = ONE - cy + RCONST(0.5)*SQR(cy); for (jx=0; jx < MX; jx++) { x = XMIN + jx*dx; cx = SQR(RCONST(0.1)*(x - XMID)); cx = ONE - cx + RCONST(0.5)*SQR(cx); IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy; IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy; } } } /* Print current t, step count, order, stepsize, and sampled c1,c2 values */ static void PrintOutput(void *cvode_mem, N_Vector u, realtype t) { long int nst; int qu, flag; realtype hu, *udata; int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %.2le no. steps = %ld order = %d stepsize = %.2le\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3le %12.3le %12.3le\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #else printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n", t, nst, qu, hu); printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n", IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1)); printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n", IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1)); #endif } /* Get and print final statistics */ static void PrintFinalStats(void *cvode_mem, int linsolver) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\nFinal Statistics.. \n\n"); printf("lenrw = %5ld leniw = %5ld\n", lenrw, leniw); printf("lenrwLS = %5ld leniwLS = %5ld\n", lenrwLS, leniwLS); printf("nst = %5ld\n" , nst); printf("nfe = %5ld nfeLS = %5ld\n" , nfe, nfeLS); printf("nni = %5ld nli = %5ld\n" , nni, nli); printf("nsetups = %5ld netf = %5ld\n" , nsetups, netf); printf("npe = %5ld nps = %5ld\n" , npe, nps); printf("ncfn = %5ld ncfl = %5ld\n\n", ncfn, ncfl); if (linsolver < 2) printf("======================================================================\n\n"); } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute RHS function f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt; realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2; realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup; realtype q4coef, dely, verdco, hordco, horaco; realtype *udata, *dudata; int jx, jy, idn, iup, ileft, iright; UserData data; data = (UserData) user_data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Set diurnal rate coefficients. */ s = sin(data->om*t); if (s > ZERO) { q3 = EXP(-A3/s); data->q4 = EXP(-A4/s); } else { q3 = ZERO; data->q4 = ZERO; } /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; horaco = data->haco; /* Loop over all grid points. */ for (jy=0; jy < MY; jy++) { /* Set vertical diffusion coefficients at jy +- 1/2 */ ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); idn = (jy == 0) ? 1 : -1; iup = (jy == MY-1) ? -1 : 1; for (jx=0; jx < MX; jx++) { /* Extract c1 and c2, and set kinetic rate terms. */ c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); qq1 = Q1*c1*C3; qq2 = Q2*c1*c2; qq3 = q3*C3; qq4 = q4coef*c2; rkin1 = -qq1 - qq2 + TWO*qq3 + qq4; rkin2 = qq1 - qq2 - qq4; /* Set vertical diffusion terms. */ c1dn = IJKth(udata,1,jx,jy+idn); c2dn = IJKth(udata,2,jx,jy+idn); c1up = IJKth(udata,1,jx,jy+iup); c2up = IJKth(udata,2,jx,jy+iup); vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn); vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn); /* Set horizontal diffusion and advection terms. */ ileft = (jx == 0) ? 1 : -1; iright =(jx == MX-1) ? -1 : 1; c1lt = IJKth(udata,1,jx+ileft,jy); c2lt = IJKth(udata,2,jx+ileft,jy); c1rt = IJKth(udata,1,jx+iright,jy); c2rt = IJKth(udata,2,jx+iright,jy); hord1 = hordco*(c1rt - TWO*c1 + c1lt); hord2 = hordco*(c2rt - TWO*c2 + c2lt); horad1 = horaco*(c1rt - c1lt); horad2 = horaco*(c2rt - c2lt); /* Load all terms into udot. */ IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1; IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2; } } return(0); } /* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco; realtype **(*P)[MY], **(*Jbd)[MY]; long int *(*pivot)[MY], ier; int jx, jy; realtype *udata, **a, **j; UserData data; /* Make local copies of pointers in user_data, and of pointer to u's data */ data = (UserData) user_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, NUM_SPECIES); *jcurPtr = FALSE; } else { /* jok = FALSE: Generate Jbd from scratch and copy to P */ /* Make local copies of problem variables, for efficiency. */ q4coef = data->q4; dely = data->dy; verdco = data->vdco; hordco = data->hdco; /* Compute 2x2 diagonal Jacobian blocks (using q4 values computed on the last f call). Load into P. */ for (jy=0; jy < MY; jy++) { ydn = YMIN + (jy - RCONST(0.5))*dely; yup = ydn + dely; cydn = verdco*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + TWO*hordco); for (jx=0; jx < MX; jx++) { c1 = IJKth(udata,1,jx,jy); c2 = IJKth(udata,2,jx,jy); j = Jbd[jx][jy]; a = P[jx][jy]; IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag; IJth(j,1,2) = -Q2*c1 + q4coef; IJth(j,2,1) = Q1*C3 - Q2*c2; IJth(j,2,2) = (-Q2*c1 - q4coef) + diag; denseCopy(j, a, NUM_SPECIES, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denseScale(-gamma, P[jx][jy], NUM_SPECIES, NUM_SPECIES); /* Add identity matrix and do LU decompositions on blocks in place. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { denseAddIdentity(P[jx][jy], NUM_SPECIES); ier =denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); } /* Preconditioner solve routine */ static int PSolve(realtype tn, N_Vector u, N_Vector fu, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype **(*P)[MY]; long int *(*pivot)[MY]; int jx, jy; realtype *zdata, *v; UserData data; /* Extract the P and pivot arrays from user_data. */ data = (UserData) user_data; P = data->P; pivot = data->pivot; zdata = NV_DATA_S(z); N_VScale(ONE, r, z); /* Solve the block-diagonal system Px = r using LU factors stored in P and pivot data in pivot, and return the solution in z. */ for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { v = &(IJKth(zdata, 1, jx, jy)); denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v); } } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dns.out0000600000175000017500000000233611741421151024324 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158010e-01 9.185084e-06 2.841898e-01 At t = 4.0000e+02 y = 4.504693e-01 3.222627e-06 5.495274e-01 At t = 4.0000e+03 y = 1.832126e-01 8.943459e-07 8.167865e-01 At t = 4.0000e+04 y = 3.897839e-02 1.621552e-07 9.610214e-01 At t = 4.0000e+05 y = 4.940533e-03 1.985905e-08 9.950594e-01 At t = 4.0000e+06 y = 5.170046e-04 2.069075e-09 9.994830e-01 At t = 2.0803e+07 y = 1.000000e-04 4.000395e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.199610e-05 2.079951e-10 9.999480e-01 At t = 4.0000e+08 y = 5.200133e-06 2.080064e-11 9.999948e-01 At t = 4.0000e+09 y = 5.131179e-07 2.052473e-12 9.999995e-01 At t = 4.0000e+10 y = 5.470287e-08 2.188115e-13 9.999999e-01 Final Statistics: nst = 566 nfe = 817 nsetups = 119 nfeLS = 0 nje = 12 nni = 813 ncfn = 0 netf = 32 nge = 600 sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_bndL.out0000600000175000017500000000152211741421151024276 0ustar sylvestresylvestre 2-D Advection-Diffusion Equation Mesh dimensions = 10 X 5 Total system size = 50 Tolerance parameters: reltol = 0 abstol = 1e-05 At t = 0 max.norm(u) = 8.954716e+01 At t = 0.10 max.norm(u) = 4.132889e+00 nst = 85 At t = 0.20 max.norm(u) = 1.039294e+00 nst = 103 At t = 0.30 max.norm(u) = 2.979829e-01 nst = 113 At t = 0.40 max.norm(u) = 8.765774e-02 nst = 120 At t = 0.50 max.norm(u) = 2.625637e-02 nst = 126 At t = 0.60 max.norm(u) = 7.830425e-03 nst = 130 At t = 0.70 max.norm(u) = 2.329387e-03 nst = 134 At t = 0.80 max.norm(u) = 6.953434e-04 nst = 137 At t = 0.90 max.norm(u) = 2.115983e-04 nst = 140 At t = 1.00 max.norm(u) = 6.556853e-05 nst = 142 Final Statistics: nst = 142 nfe = 174 nsetups = 23 nfeLS = 0 nje = 3 nni = 170 ncfn = 0 netf = 3 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dnsL.out0000600000175000017500000000233611741421151024440 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158010e-01 9.185084e-06 2.841898e-01 At t = 4.0000e+02 y = 4.504693e-01 3.222627e-06 5.495274e-01 At t = 4.0000e+03 y = 1.832126e-01 8.943459e-07 8.167865e-01 At t = 4.0000e+04 y = 3.897839e-02 1.621552e-07 9.610214e-01 At t = 4.0000e+05 y = 4.940533e-03 1.985905e-08 9.950594e-01 At t = 4.0000e+06 y = 5.170046e-04 2.069075e-09 9.994830e-01 At t = 2.0803e+07 y = 1.000000e-04 4.000395e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.199601e-05 2.079947e-10 9.999480e-01 At t = 4.0000e+08 y = 5.221400e-06 2.088571e-11 9.999948e-01 At t = 4.0000e+09 y = 5.217838e-07 2.087137e-12 9.999995e-01 At t = 4.0000e+10 y = 5.466519e-08 2.186608e-13 9.999999e-01 Final Statistics: nst = 595 nfe = 857 nsetups = 125 nfeLS = 0 nje = 12 nni = 853 ncfn = 0 netf = 34 nge = 629 sundials-2.5.0/examples/cvodes/serial/cvsDirectDemo_ls.out0000600000175000017500000004247511741421151024565 0ustar sylvestresylvestreDemonstration program for CVODE package - direct linear solvers Problem 1: Van der Pol oscillator xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0 neq = 2, reltol = 0, abstol = 1e-06 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : FUNCTIONAL t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 9.8626e-02 3.60761 -2.12392e-05 -3.16877e+00 5 2.2756e-02 5.82239 -1.68010e+00 2.91060e-01 4 1.4079e-01 8.03716 9.57612e-05 3.16900e+00 5 2.0348e-02 Final statistics for this run: CVode real workspace length = 130 CVode integer workspace length = 69 Number of steps = 196 Number of f-s = 391 Number of setups = 0 Number of nonlinear iterations = 387 Number of nonlinear convergence failures = 0 Number of error test failures = 15 Error overrun = 95.761 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Dense, User-Supplied Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 7 6.5178e-02 3.60761 2.42943e-06 -3.16870e+00 7 2.0626e-02 5.82239 -1.68010e+00 2.91062e-01 7 1.3038e-01 8.03716 1.99078e-05 3.16879e+00 7 2.3923e-02 Final statistics for this run: CVode real workspace length = 130 CVode integer workspace length = 69 Number of steps = 266 Number of f-s = 366 Number of setups = 46 Number of nonlinear iterations = 362 Number of nonlinear convergence failures = 0 Number of error test failures = 23 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 5 Number of f evals. in linear solver = 0 Error overrun = 19.908 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Dense, Difference Quotient Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 6.5835e-02 3.60761 -2.28046e-05 -3.16879e+00 6 3.1773e-02 5.82239 -1.68010e+00 2.91059e-01 6 9.3514e-02 8.03716 -9.84882e-06 3.16869e+00 6 2.8095e-02 Final statistics for this run: CVode real workspace length = 130 CVode integer workspace length = 69 Number of steps = 195 Number of f-s = 268 Number of setups = 34 Number of nonlinear iterations = 264 Number of nonlinear convergence failures = 0 Number of error test failures = 15 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 4 Number of f evals. in linear solver = 8 Error overrun = 22.805 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Diagonal Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91054e-01 6 5.9553e-02 3.60761 6.36071e-05 -3.16853e+00 6 2.8912e-02 5.82239 -1.68011e+00 2.91057e-01 5 9.8199e-02 8.03716 -3.15637e-05 3.16849e+00 6 1.5418e-02 Final statistics for this run: CVode real workspace length = 130 CVode integer workspace length = 69 Number of steps = 241 Number of f-s = 340 Number of setups = 42 Number of nonlinear iterations = 336 Number of nonlinear convergence failures = 0 Number of error test failures = 21 Linear solver real workspace length = 6 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 42 Number of f evals. in linear solver = 42 Error overrun = 63.607 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : FUNCTIONAL t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 4 9.6100e-02 3.60761 -1.35636e-04 -3.16912e+00 5 1.5675e-02 5.82239 -1.68009e+00 2.91063e-01 5 1.1210e-01 8.03716 2.20969e-04 3.16937e+00 5 1.4732e-02 Final statistics for this run: CVode real workspace length = 116 CVode integer workspace length = 62 Number of steps = 262 Number of f-s = 498 Number of setups = 0 Number of nonlinear iterations = 494 Number of nonlinear convergence failures = 0 Number of error test failures = 22 Error overrun = 220.969 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Dense, User-Supplied Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 1.1991e-01 3.60761 -5.46907e-05 -3.16886e+00 5 1.6403e-02 5.82239 -1.68010e+00 2.91061e-01 4 1.0146e-01 8.03716 1.54312e-04 3.16917e+00 4 9.5378e-03 Final statistics for this run: CVode real workspace length = 116 CVode integer workspace length = 62 Number of steps = 265 Number of f-s = 358 Number of setups = 40 Number of nonlinear iterations = 354 Number of nonlinear convergence failures = 0 Number of error test failures = 18 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 5 Number of f evals. in linear solver = 0 Error overrun = 154.312 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Dense, Difference Quotient Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91058e-01 4 8.1067e-02 3.60761 -5.84200e-05 -3.16886e+00 4 1.1360e-02 5.82239 -1.68010e+00 2.91062e-01 5 6.4941e-02 8.03716 9.61737e-05 3.16899e+00 5 1.5216e-02 Final statistics for this run: CVode real workspace length = 116 CVode integer workspace length = 62 Number of steps = 276 Number of f-s = 367 Number of setups = 40 Number of nonlinear iterations = 363 Number of nonlinear convergence failures = 0 Number of error test failures = 17 Linear solver real workspace length = 8 Linear solver integer workspace length = 2 Number of Jacobian evaluations = 6 Number of f evals. in linear solver = 12 Error overrun = 96.174 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Diagonal Jacobian t x xdot qu hu 1.39284 1.68010e+00 -2.91056e-01 5 1.1430e-01 3.60761 -9.83501e-05 -3.16900e+00 5 1.6712e-02 5.82239 -1.68009e+00 2.91063e-01 4 8.1261e-02 8.03716 1.66641e-04 3.16920e+00 4 1.0547e-02 Final statistics for this run: CVode real workspace length = 116 CVode integer workspace length = 62 Number of steps = 266 Number of f-s = 360 Number of setups = 39 Number of nonlinear iterations = 356 Number of nonlinear convergence failures = 0 Number of error test failures = 17 Linear solver real workspace length = 6 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 39 Number of f evals. in linear solver = 39 Error overrun = 166.641 ------------------------------------------------------------- ------------------------------------------------------------- Problem 2: ydot = A * y, where A is a banded lower triangular matrix derived from 2-D advection PDE neq = 25, ml = 5, mu = 0 itol = CV_SS, reltol = 0, abstol = 1e-06 t max.err qu hu ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : FUNCTIONAL t max.err qu hu 0.010 1.4690e-07 3 1.1459e-02 0.100 5.2543e-07 4 4.1413e-02 1.000 1.2207e-06 5 6.8243e-02 10.000 9.7711e-07 3 2.8481e-01 100.000 2.1231e-07 1 1.3200e-01 Final statistics for this run: CVode real workspace length = 521 CVode integer workspace length = 69 Number of steps = 339 Number of f-s = 602 Number of setups = 0 Number of nonlinear iterations = 598 Number of nonlinear convergence failures = 80 Number of error test failures = 0 Error overrun = 1.221 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Diagonal Jacobian t max.err qu hu 0.010 1.3734e-07 3 1.0327e-02 0.100 2.4956e-06 3 2.3048e-02 1.000 4.2328e-06 4 4.3778e-02 10.000 9.7310e-07 4 3.1286e-01 100.000 1.0443e-09 1 3.7883e+02 Final statistics for this run: CVode real workspace length = 521 CVode integer workspace length = 69 Number of steps = 154 Number of f-s = 219 Number of setups = 33 Number of nonlinear iterations = 215 Number of nonlinear convergence failures = 0 Number of error test failures = 5 Linear solver real workspace length = 75 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 33 Number of f evals. in linear solver = 33 Error overrun = 4.233 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Band, User-Supplied Jacobian t max.err qu hu 0.010 1.3670e-07 3 1.2164e-02 0.100 4.7920e-07 4 4.2115e-02 1.000 2.5077e-07 6 1.0365e-01 10.000 6.0790e-07 4 4.7206e-01 100.000 5.7390e-08 2 1.0750e+01 Final statistics for this run: CVode real workspace length = 521 CVode integer workspace length = 69 Number of steps = 149 Number of f-s = 184 Number of setups = 32 Number of nonlinear iterations = 180 Number of nonlinear convergence failures = 0 Number of error test failures = 6 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 0 Error overrun = 0.608 ------------------------------------------------------------- Linear Multistep Method : ADAMS Iteration : NEWTON Linear Solver : Band, Difference Quotient Jacobian t max.err qu hu 0.010 1.4285e-07 3 1.3840e-02 0.100 5.7337e-07 4 4.2111e-02 1.000 7.3281e-07 5 6.3684e-02 10.000 3.8507e-07 5 2.6026e-01 100.000 4.1035e-12 1 6.2591e+01 Final statistics for this run: CVode real workspace length = 521 CVode integer workspace length = 69 Number of steps = 124 Number of f-s = 142 Number of setups = 24 Number of nonlinear iterations = 138 Number of nonlinear convergence failures = 0 Number of error test failures = 1 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 18 Error overrun = 0.733 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : FUNCTIONAL t max.err qu hu 0.010 5.5931e-07 2 8.1257e-03 0.100 5.2896e-06 3 1.7769e-02 1.000 2.3209e-06 5 7.5291e-02 10.000 1.2861e-06 5 2.7791e-01 100.000 2.0520e-07 1 8.3614e-01 Final statistics for this run: CVode real workspace length = 346 CVode integer workspace length = 62 Number of steps = 373 Number of f-s = 690 Number of setups = 0 Number of nonlinear iterations = 686 Number of nonlinear convergence failures = 55 Number of error test failures = 1 Error overrun = 5.290 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Diagonal Jacobian t max.err qu hu 0.010 5.6365e-07 2 8.1241e-03 0.100 7.9753e-07 4 1.8910e-02 1.000 5.9100e-06 5 5.1976e-02 10.000 2.1569e-06 4 3.1156e-01 100.000 6.3727e-10 1 1.6301e+02 Final statistics for this run: CVode real workspace length = 346 CVode integer workspace length = 62 Number of steps = 177 Number of f-s = 259 Number of setups = 46 Number of nonlinear iterations = 255 Number of nonlinear convergence failures = 2 Number of error test failures = 5 Linear solver real workspace length = 75 Linear solver integer workspace length = 3 Number of Jacobian evaluations = 46 Number of f evals. in linear solver = 46 Error overrun = 5.910 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Band, User-Supplied Jacobian t max.err qu hu 0.010 5.6372e-07 2 8.1246e-03 0.100 5.2784e-06 3 1.7819e-02 1.000 1.8169e-06 5 6.0110e-02 10.000 5.4997e-07 5 4.1661e-01 100.000 1.7764e-09 2 2.9748e+01 Final statistics for this run: CVode real workspace length = 346 CVode integer workspace length = 62 Number of steps = 119 Number of f-s = 144 Number of setups = 25 Number of nonlinear iterations = 140 Number of nonlinear convergence failures = 0 Number of error test failures = 2 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 0 Error overrun = 5.278 ------------------------------------------------------------- Linear Multistep Method : BDF Iteration : NEWTON Linear Solver : Band, Difference Quotient Jacobian t max.err qu hu 0.010 5.6492e-07 2 8.1361e-03 0.100 5.9968e-06 3 1.7105e-02 1.000 1.6902e-06 5 8.7628e-02 10.000 5.2314e-07 5 3.1091e-01 100.000 1.4380e-09 2 2.1635e+01 Final statistics for this run: CVode real workspace length = 346 CVode integer workspace length = 62 Number of steps = 121 Number of f-s = 145 Number of setups = 24 Number of nonlinear iterations = 141 Number of nonlinear convergence failures = 0 Number of error test failures = 1 Linear solver real workspace length = 425 Linear solver integer workspace length = 25 Number of Jacobian evaluations = 3 Number of f evals. in linear solver = 18 Error overrun = 5.997 ------------------------------------------------------------- ------------------------------------------------------------- Number of errors encountered = 0 sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_ASAi_bnd.c0000600000175000017500000003674411741421151024450 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2011/11/23 23:53:02 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Adjoint sensitivity example problem: * * The following is a simple example problem with a banded Jacobian, * with the program for its solution by CVODES. * The problem is the semi-discrete form of the advection-diffusion * equation in 2-D: * du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 * on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time * interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions * are posed, and the initial condition is the following: * u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). * The PDE is discretized on a uniform MX+2 by MY+2 grid with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX*MY. * This program solves the problem with the BDF method, Newton * iteration with the CVODE band linear solver, and a user-supplied * Jacobian routine. * It uses scalar relative and absolute tolerances. * Output is printed at t = .1, .2, ..., 1. * Run statistics (optional outputs) are printed at the end. * * Additionally, CVODES integrates backwards in time the * the semi-discrete form of the adjoint PDE: * d(lambda)/dt = - d^2(lambda) / dx^2 + 0.5 d(lambda) / dx * - d^2(lambda) / dy^2 - 1.0 * with homogeneous Dirichlet boundary conditions and final * conditions: * lambda(x,y,t=t_final) = 0.0 * whose solution at t = 0 represents the sensitivity of * G = int_0^t_final int_x int _y u(t,x,y) dx dy dt * with respect to the initial conditions of the original problem. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundaries */ #define YMAX RCONST(1.0) #define MX 40 /* mesh dimensions */ #define MY 20 #define NEQ MX*MY /* number of equations */ #define ATOL RCONST(1.e-5) #define RTOLB RCONST(1.e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.1) /* first output time */ #define DTOUT RCONST(0.1) /* output time increment */ #define NOUT 10 /* number of output times */ #define TOUT RCONST(1.0) /* final time */ #define NSTEP 50 /* check point saved every NSTEP */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* User-defined vector access macro IJth */ /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= MX, 1 <= j <= MY. The vdata array is obtained via the macro call vdata = N_VDATA(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*MY]) /* Type : UserData contains grid constants */ typedef struct { realtype dx, dy, hdcoef, hacoef, vdcoef; } *UserData; /* Prototypes of user-supplied functions */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int fB(realtype tB, N_Vector u, N_Vector uB, N_Vector uBdot, void *user_dataB); static int JacB(long int NB, long int muB, long int mlB, realtype tB, N_Vector u, N_Vector uB, N_Vector fuB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* Prototypes of private functions */ static void SetIC(N_Vector u, UserData data); static void PrintOutput(N_Vector uB, UserData data); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; realtype dx, dy, reltol, abstol, t; N_Vector u; int indexB; realtype reltolB, abstolB; N_Vector uB; int flag, ncheck; data = NULL; cvode_mem = NULL; u = uB = NULL; /* Allocate and initialize user data memory */ data = (UserData) malloc(sizeof *data); if(check_flag((void *)data, "malloc", 2)) return(1); dx = data->dx = XMAX/(MX+1); dy = data->dy = YMAX/(MY+1); data->hdcoef = ONE/(dx*dx); data->hacoef = RCONST(1.5)/(TWO*dx); data->vdcoef = ONE/(dy*dy); /* Set the tolerances for the forward integration */ reltol = ZERO; abstol = ATOL; /* Allocate u vector */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew", 0)) return(1); /* Initialize u vector */ SetIC(u, data); /* Create and allocate CVODES memory for forward run */ printf("\nCreate and allocate CVODES memory for forward runs\n"); cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVBand with bandwidths ml = mu = MY, */ flag = CVBand(cvode_mem, NEQ, MY, MY); if(check_flag(&flag, "CVBand", 1)) return(1); flag = CVDlsSetBandJacFn(cvode_mem, Jac); if(check_flag(&flag, "CVDlsSetBandJacFn", 1)) return(1); /* Allocate global memory */ printf("\nAllocate global memory\n"); flag = CVodeAdjInit(cvode_mem, NSTEP, CV_HERMITE); if(check_flag(&flag, "CVodeAdjInit", 1)) return(1); /* Perform forward run */ printf("\nForward integration\n"); flag = CVodeF(cvode_mem, TOUT, u, &t, CV_NORMAL, &ncheck); if(check_flag(&flag, "CVodeF", 1)) return(1); printf("\nncheck = %d\n", ncheck); /* Set the tolerances for the backward integration */ reltolB = RTOLB; abstolB = ATOL; /* Allocate uB */ uB = N_VNew_Serial(NEQ); if(check_flag((void *)uB, "N_VNew", 0)) return(1); /* Initialize uB = 0 */ N_VConst(ZERO, uB); /* Create and allocate CVODES memory for backward run */ printf("\nCreate and allocate CVODES memory for backward run\n"); flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB); if(check_flag(&flag, "CVodeCreateB", 1)) return(1); flag = CVodeSetUserDataB(cvode_mem, indexB, data); if(check_flag(&flag, "CVodeSetUserDataB", 1)) return(1); flag = CVodeInitB(cvode_mem, indexB, fB, TOUT, uB); if(check_flag(&flag, "CVodeInitB", 1)) return(1); flag = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB); if(check_flag(&flag, "CVodeSStolerancesB", 1)) return(1); flag = CVBandB(cvode_mem, indexB, NEQ, MY, MY); if(check_flag(&flag, "CVBandB", 1)) return(1); flag = CVDlsSetBandJacFnB(cvode_mem, indexB, JacB); if(check_flag(&flag, "CVDlsSetBandJacFnB", 1)) return(1); /* Perform backward integration */ printf("\nBackward integration\n"); flag = CVodeB(cvode_mem, T0, CV_NORMAL); if(check_flag(&flag, "CVodeB", 1)) return(1); flag = CVodeGetB(cvode_mem, indexB, &t, uB); if(check_flag(&flag, "CVodeGetB", 1)) return(1); PrintOutput(uB, data); N_VDestroy_Serial(u); /* Free the u vector */ N_VDestroy_Serial(uB); /* Free the uB vector */ CVodeFree(&cvode_mem); /* Free the CVODE problem memory */ free(data); /* Free the user data */ return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. right-hand side of forward ODE. */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); } /* * Jac function. Jacobian of forward ODE. */ static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* The components of f = udot that depend on u(i,j) are f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); } /* * fB function. Right-hand side of backward ODE. */ static int fB(realtype tB, N_Vector u, N_Vector uB, N_Vector uBdot, void *user_dataB) { UserData data; realtype *uBdata, *duBdata; realtype hordc, horac, verdc; realtype uBij, uBdn, uBup, uBlt, uBrt; realtype hdiffB, hadvB, vdiffB; int i, j; uBdata = NV_DATA_S(uB); duBdata = NV_DATA_S(uBdot); /* Extract needed constants from data */ data = (UserData) user_dataB; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uBij = IJth(uBdata, i, j); uBdn = (j == 1) ? ZERO : IJth(uBdata, i, j-1); uBup = (j == MY) ? ZERO : IJth(uBdata, i, j+1); uBlt = (i == 1) ? ZERO : IJth(uBdata, i-1, j); uBrt = (i == MX) ? ZERO : IJth(uBdata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiffB = hordc*(- uBlt + TWO*uBij - uBrt); hadvB = horac*(uBrt - uBlt); vdiffB = verdc*(- uBup + TWO*uBij - uBdn); IJth(duBdata, i, j) = hdiffB + hadvB + vdiffB - ONE; } } return(0); } /* * JacB function. Jacobian of backward ODE */ static int JacB(long int NB, long int muB, long int mlB, realtype tB, N_Vector u, N_Vector uB, N_Vector fuB, DlsMat JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* The Jacobian of the adjoint system is: JB = -J^T */ data = (UserData) user_dataB; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(JB,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = - hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = - hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = - verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = - verdc; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Set initial conditions in u vector */ static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*EXP(RCONST(5.0)*x*y); } } } /* * Print results after backward integration */ static void PrintOutput(N_Vector uB, UserData data) { realtype *uBdata, uBij, uBmax, x, y, dx, dy; int i, j; x = y = ZERO; dx = data->dx; dy = data->dy; uBdata = NV_DATA_S(uB); uBmax = ZERO; for(j=1; j<= MY; j++) { for(i=1; i<=MX; i++) { uBij = IJth(uBdata, i, j); if (ABS(uBij) > uBmax) { uBmax = uBij; x = i*dx; y = j*dy; } } } printf("\nMaximum sensitivity\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" lambda max = %Le\n", uBmax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" lambda max = %le\n", uBmax); #else printf(" lambda max = %e\n", uBmax); #endif printf("at\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" x = %Le\n y = %Le\n", x, y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" x = %le\n y = %le\n", x, y); #else printf(" x = %e\n y = %e\n", x, y); #endif } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_FSA_non.c0000600000175000017500000003575511741421151024334 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2008/12/31 00:04:42 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, George D. Byrne, * and Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the program for * its solution by CVODES. The problem is the semi-discrete form of * the advection-diffusion equation in 1-D: * du/dt = q1 * d^2 u / dx^2 + q2 * du/dx * on the interval 0 <= x <= 2, and the time interval 0 <= t <= 5. * Homogeneous Dirichlet boundary conditions are posed, and the * initial condition is: * u(x,y,t=0) = x(2-x)exp(2x). * The PDE is discretized on a uniform grid of size MX+2 with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX. * This program solves the problem with the option for nonstiff * systems: ADAMS method and functional iteration. * It uses scalar relative and absolute tolerances. * Output is printed at t = .5, 1.0, ..., 5. * Run statistics (optional outputs) are printed at the end. * * Optionally, CVODES can compute sensitivities with respect to the * problem parameters q1 and q2. * Any of three sensitivity methods (SIMULTANEOUS, STAGGERED, and * STAGGERED1) can be used and sensitivities may be included in the * error test or not (error control set on FULL or PARTIAL, * respectively). * * Execution: * * If no sensitivities are desired: * % cvsAdvDiff_FSA_non -nosensi * If sensitivities are to be computed: * % cvsAdvDiff_FSA_non -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg, stg1} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundary */ #define MX 10 /* mesh dimension */ #define NEQ MX /* number of equations */ #define ATOL RCONST(1.e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.5) /* first output time */ #define DTOUT RCONST(0.5) /* output time increment */ #define NOUT 10 /* number of output times */ #define NP 2 #define NS 2 #define ZERO RCONST(0.0) /* Type : UserData contains problem parameters, grid constants, work array. */ typedef struct { realtype *p; realtype dx; } *UserData; /* Functions Called by the CVODES Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); /* Private Helper Functions */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(char *name); static void SetIC(N_Vector u, realtype dx); static void PrintOutput(void *cvode_mem, realtype t, N_Vector u); static void PrintOutputS(N_Vector *uS); static void PrintFinalStats(void *cvode_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { void *cvode_mem; UserData data; realtype dx, reltol, abstol, t, tout; N_Vector u; int iout, flag; realtype *pbar; int is, *plist; N_Vector *uS; booleantype sensi, err_con; int sensi_meth; cvode_mem = NULL; data = NULL; u = NULL; pbar = NULL; plist = NULL; uS = NULL; /* Process arguments */ ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con); /* Set user data */ data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2)) return(1); data->p = (realtype *) malloc(NP * sizeof(realtype)); dx = data->dx = XMAX/((realtype)(MX+1)); data->p[0] = RCONST(1.0); data->p[1] = RCONST(0.5); /* Allocate and set initial states */ u = N_VNew_Serial(NEQ); if(check_flag((void *)u, "N_VNew_Serial", 0)) return(1); SetIC(u, dx); /* Set integration tolerances */ reltol = ZERO; abstol = ATOL; /* Create CVODES object */ cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Allocate CVODES memory */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); printf("\n1-D advection-diffusion equation, mesh size =%3d\n", MX); /* Sensitivity-related settings */ if(sensi) { plist = (int *) malloc(NS * sizeof(int)); if(check_flag((void *)plist, "malloc", 2)) return(1); for(is=0; isp[plist[is]]; uS = N_VCloneVectorArray_Serial(NS, u); if(check_flag((void *)uS, "N_VCloneVectorArray_Serial", 0)) return(1); for(is=0;isp, pbar, plist); if(check_flag(&flag, "CVodeSetSensParams", 1)) return(1); printf("Sensitivity: YES "); if(sensi_meth == CV_SIMULTANEOUS) printf("( SIMULTANEOUS +"); else if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +"); else printf("( STAGGERED1 +"); if(err_con) printf(" FULL ERROR CONTROL )"); else printf(" PARTIAL ERROR CONTROL )"); } else { printf("Sensitivity: NO "); } /* In loop over output points, call CVode, print results, test for error */ printf("\n\n"); printf("============================================================\n"); printf(" T Q H NST Max norm \n"); printf("============================================================\n"); for (iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; PrintOutput(cvode_mem, t, u); if (sensi) { flag = CVodeGetSens(cvode_mem, &t, uS); if(check_flag(&flag, "CVodeGetSens", 1)) break; PrintOutputS(uS); } printf("------------------------------------------------------------\n"); } /* Print final statistics */ PrintFinalStats(cvode_mem, sensi); /* Free memory */ N_VDestroy_Serial(u); if (sensi) { N_VDestroyVectorArray_Serial(uS, NS); free(plist); free(pbar); } free(data); CVodeFree(&cvode_mem); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data) { realtype ui, ult, urt, hordc, horac, hdiff, hadv; realtype dx; realtype *udata, *dudata; int i; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed problem constants from data */ data = (UserData) user_data; dx = data->dx; hordc = data->p[0]/(dx*dx); horac = data->p[1]/(RCONST(2.0)*dx); /* Loop over all grid points. */ for (i=0; i= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsFoodWeb_ASAp_kry.out0000600000175000017500000000170111741421151025111 0ustar sylvestresylvestre Create and allocate CVODES memory for forward run Allocate global memory Forward integration ncheck = 11 g = int_x int_y c6(Tfinal,x,y) dx dy = 35988.914996 Create and allocate CVODES memory for backward run Backward integration Maximum sensitivity with respect to I.C. of species 1 mu max = 5.105006e-04 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 2 mu max = 4.865450e-04 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 3 mu max = 4.644767e-04 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 4 mu max = 3.447561e-12 at x = 1.000000e+00 y = 8.421053e-01 Maximum sensitivity with respect to I.C. of species 5 mu max = 3.434214e-12 at x = 1.000000e+00 y = 8.421053e-01 Maximum sensitivity with respect to I.C. of species 6 mu max = 6.326559e-12 at x = 1.000000e+00 y = 0.000000e+00 sundials-2.5.0/examples/cvodes/serial/cvsKrylovDemo_prec.out0000600000175000017500000006351611741421151025153 0ustar sylvestresylvestre Demonstration program for CVODES - CVSPGMR linear solver Food web problem with ns species, ns = 6 Predator-prey interaction and diffusion on a 2-D square Matrix parameters: a = 1 e = 1e+04 g = 5e-07 b parameter = 1 Diffusion coefficients: Dprey = 1 Dpred = 0.5 Rate parameter alpha = 1 Mesh dimensions (mx,my) are 6, 6. Total system size is neq = 216 Tolerances: reltol = 1e-05, abstol = 1e-05 Preconditioning uses a product of: (1) Gauss-Seidel iterations with itmax = 5 iterations, and (2) interaction-only block-diagonal matrix with block-grouping Number of diagonal block groups = ngrp = 4 (ngx by ngy, ngx = 2, ngy = 2) ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_LEFT Gram-Schmidt method type is gstype = MODIFIED_GS c values at t = 0: Species 1 10 10 10 10 10 10 10 10.1678 10.3775 10.3775 10.1678 10 10 10.3775 10.8493 10.8493 10.3775 10 10 10.3775 10.8493 10.8493 10.3775 10 10 10.1678 10.3775 10.3775 10.1678 10 10 10 10 10 10 10 Species 2 10 10 10 10 10 10 10 10.3355 10.755 10.755 10.3355 10 10 10.755 11.6987 11.6987 10.755 10 10 10.755 11.6987 11.6987 10.755 10 10 10.3355 10.755 10.755 10.3355 10 10 10 10 10 10 10 Species 3 10 10 10 10 10 10 10 10.5033 11.1325 11.1325 10.5033 10 10 11.1325 12.548 12.548 11.1325 10 10 11.1325 12.548 12.548 11.1325 10 10 10.5033 11.1325 11.1325 10.5033 10 10 10 10 10 10 10 Species 4 10 10 10 10 10 10 10 10.6711 11.5099 11.5099 10.6711 10 10 11.5099 13.3974 13.3974 11.5099 10 10 11.5099 13.3974 13.3974 11.5099 10 10 10.6711 11.5099 11.5099 10.6711 10 10 10 10 10 10 10 Species 5 10 10 10 10 10 10 10 10.8389 11.8874 11.8874 10.8389 10 10 11.8874 14.2467 14.2467 11.8874 10 10 11.8874 14.2467 14.2467 11.8874 10 10 10.8389 11.8874 11.8874 10.8389 10 10 10 10 10 10 10 Species 6 10 10 10 10 10 10 10 11.0066 12.2649 12.2649 11.0066 10 10 12.2649 15.0961 15.0961 12.2649 10 10 12.2649 15.0961 15.0961 12.2649 10 10 11.0066 12.2649 12.2649 11.0066 10 10 10 10 10 10 10 t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 c values at t = 1e-06: Species 1 9.99991 9.99992 9.99993 9.99993 9.99993 9.99992 9.99992 10.1677 10.3774 10.3774 10.1677 9.99993 9.99993 10.3774 10.8492 10.8492 10.3774 9.99993 9.99993 10.3774 10.8492 10.8492 10.3774 9.99993 9.99992 10.1677 10.3774 10.3774 10.1677 9.99992 9.99991 9.99992 9.99993 9.99993 9.99992 9.99991 Species 2 9.99991 9.99993 9.99995 9.99995 9.99993 9.99992 9.99993 10.3355 10.7549 10.7549 10.3355 9.99993 9.99995 10.7549 11.6985 11.6985 10.7549 9.99995 9.99995 10.7549 11.6985 11.6985 10.7549 9.99995 9.99993 10.3355 10.7549 10.7549 10.3355 9.99993 9.99991 9.99993 9.99995 9.99995 9.99993 9.99991 Species 3 9.99991 9.99994 9.99997 9.99997 9.99994 9.99992 9.99994 10.5032 11.1323 11.1323 10.5032 9.99994 9.99997 11.1323 12.5478 12.5478 11.1323 9.99997 9.99997 11.1323 12.5478 12.5478 11.1323 9.99997 9.99994 10.5032 11.1323 11.1323 10.5032 9.99994 9.99991 9.99994 9.99997 9.99997 9.99994 9.99991 Species 4 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 14.5506 15.8932 15.8932 14.5506 13.499 13.499 15.8932 19.0308 19.0308 15.8932 13.499 13.499 15.8932 19.0308 19.0308 15.8932 13.499 13.499 14.5506 15.8932 15.8932 14.5506 13.499 13.499 13.499 13.499 13.499 13.499 13.499 Species 5 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 14.7794 16.4145 16.4145 14.7794 13.499 13.499 16.4145 20.2373 20.2373 16.4145 13.499 13.499 16.4145 20.2373 20.2373 16.4145 13.499 13.499 14.7794 16.4145 16.4145 14.7794 13.499 13.499 13.499 13.499 13.499 13.499 13.499 Species 6 13.499 13.499 13.499 13.499 13.499 13.4989 13.499 15.0082 16.9357 16.9357 15.0082 13.499 13.499 16.9357 21.4437 21.4437 16.9357 13.499 13.499 16.9357 21.4437 21.4437 16.9357 13.499 13.499 15.0082 16.9357 16.9357 15.0082 13.499 13.499 13.499 13.499 13.499 13.499 13.499 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 116 nfe = 137 nni = 133 qu = 5 hu = 5.51e-06 t = 1.00e-03 nst = 135 nfe = 156 nni = 152 qu = 2 hu = 3.53e-04 c values at t = 0.001: Species 1 9.90702 9.91664 9.92836 9.93033 9.92253 9.91674 9.91472 10.0746 10.2769 10.2785 10.0795 9.92253 9.92446 10.2748 10.7181 10.7194 10.2785 9.93033 9.92445 10.2744 10.7173 10.7181 10.2769 9.92836 9.91469 10.0734 10.2744 10.2748 10.0746 9.91664 9.90697 9.91469 9.92445 9.92446 9.91472 9.90702 Species 2 9.90741 9.92474 9.94623 9.9482 9.93064 9.91713 9.92282 10.2412 10.644 10.6457 10.2461 9.93064 9.94232 10.6419 11.5267 11.5281 10.6457 9.9482 9.94231 10.6415 11.5258 11.5267 10.644 9.94623 9.92279 10.24 10.6415 10.6419 10.2412 9.92474 9.90737 9.92279 9.94231 9.94232 9.92282 9.90741 Species 3 9.90781 9.93284 9.96408 9.96606 9.93874 9.91752 9.93092 10.4078 11.0109 11.0127 10.4127 9.93874 9.96017 11.0088 12.3339 12.3354 11.0127 9.96606 9.96016 11.0083 12.3329 12.3339 11.0109 9.96408 9.93089 10.4065 11.0083 11.0088 10.4078 9.93284 9.90776 9.93089 9.96016 9.96017 9.93092 9.90781 Species 4 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 Species 5 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 Species 6 297231 297749 298393 298451 297925 297520 297692 307244 319327 319378 307390 297925 298276 319264 345799 345840 319378 298451 298276 319252 345771 345799 319327 298393 297691 307208 319252 319264 307244 297749 297229 297691 298276 298276 297692 297231 t = 1.00e-02 nst = 143 nfe = 166 nni = 162 qu = 3 hu = 1.37e-03 t = 1.00e-01 nst = 165 nfe = 191 nni = 187 qu = 5 hu = 6.02e-03 t = 1.00e+00 nst = 235 nfe = 265 nni = 261 qu = 4 hu = 2.49e-02 c values at t = 1: Species 1 1.58853 1.59926 1.62153 1.64766 1.67038 1.68151 1.58535 1.59505 1.61549 1.63954 1.66035 1.67038 1.57758 1.58549 1.60241 1.62237 1.63954 1.64766 1.56822 1.57414 1.58708 1.60241 1.61549 1.62153 1.5605 1.56465 1.57414 1.58549 1.59505 1.59926 1.55734 1.5605 1.56822 1.57758 1.58535 1.58853 Species 2 1.59068 1.60143 1.62373 1.64989 1.67263 1.68377 1.5875 1.59721 1.61768 1.64175 1.66259 1.67263 1.57973 1.58764 1.60458 1.62456 1.64175 1.64989 1.57036 1.57628 1.58923 1.60458 1.61768 1.62373 1.56263 1.56678 1.57628 1.58764 1.59721 1.60143 1.55947 1.56263 1.57036 1.57973 1.5875 1.59068 Species 3 1.59272 1.60347 1.6258 1.65199 1.67476 1.68591 1.58953 1.59926 1.61975 1.64384 1.6647 1.67476 1.58175 1.58968 1.60664 1.62664 1.64384 1.65199 1.57237 1.5783 1.59127 1.60664 1.61975 1.6258 1.56464 1.56879 1.5783 1.58968 1.59926 1.60347 1.56147 1.56464 1.57237 1.58175 1.58953 1.59272 Species 4 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 Species 5 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 Species 6 47718.9 48040.8 48709.6 49494 50176.1 50509.9 47623.3 47914.5 48528.3 49250.2 49874.9 50176.1 47390.2 47627.5 48135.5 48734.6 49250.2 49494 47109 47286.6 47675.1 48135.5 48528.3 48709.6 46877.1 47001.6 47286.6 47627.5 47914.5 48040.8 46782.3 46877.1 47109 47390.2 47623.3 47718.9 t = 2.00e+00 nst = 272 nfe = 305 nni = 301 qu = 3 hu = 3.80e-02 t = 3.00e+00 nst = 288 nfe = 322 nni = 318 qu = 3 hu = 6.59e-02 t = 4.00e+00 nst = 303 nfe = 337 nni = 333 qu = 3 hu = 6.59e-02 c values at t = 4: Species 1 1.19535 1.20368 1.2211 1.24158 1.25935 1.268 1.19281 1.20035 1.21636 1.23523 1.25154 1.25935 1.18657 1.19274 1.20603 1.22174 1.23523 1.24158 1.17905 1.18368 1.1939 1.20603 1.21636 1.2211 1.17285 1.17613 1.18368 1.19274 1.20035 1.20368 1.17032 1.17285 1.17905 1.18657 1.19281 1.19535 Species 2 1.19539 1.20372 1.22113 1.24161 1.25939 1.26804 1.19284 1.20039 1.2164 1.23527 1.25158 1.25939 1.18661 1.19277 1.20606 1.22177 1.23527 1.24161 1.17908 1.18372 1.19393 1.20606 1.2164 1.22113 1.17288 1.17616 1.18372 1.19277 1.20039 1.20372 1.17036 1.17288 1.17908 1.18661 1.19284 1.19539 Species 3 1.19542 1.20375 1.22117 1.24164 1.25942 1.26807 1.19287 1.20042 1.21643 1.2353 1.25161 1.25942 1.18664 1.1928 1.20609 1.2218 1.2353 1.24164 1.17911 1.18375 1.19396 1.20609 1.21643 1.22117 1.17291 1.17619 1.18375 1.1928 1.20042 1.20375 1.17039 1.17291 1.17911 1.18664 1.19287 1.19542 Species 4 35860.8 36110.3 36632.5 37246.5 37779.6 38038.8 35784.3 36010.5 36490.5 37056.4 37545.4 37779.6 35597.3 35782.1 36180.6 36651.7 37056.4 37246.5 35371.5 35510.5 35816.8 36180.6 36490.5 36632.5 35185.5 35283.9 35510.5 35782.1 36010.5 36110.3 35109.8 35185.5 35371.5 35597.3 35784.3 35860.8 Species 5 35860.8 36110.2 36632.5 37246.5 37779.6 38038.8 35784.3 36010.5 36490.5 37056.4 37545.4 37779.6 35597.4 35782.1 36180.6 36651.7 37056.4 37246.5 35371.5 35510.5 35816.8 36180.6 36490.5 36632.5 35185.5 35283.9 35510.5 35782.1 36010.5 36110.2 35109.8 35185.5 35371.5 35597.4 35784.3 35860.8 Species 6 35860.8 36110.2 36632.5 37246.5 37779.6 38038.8 35784.3 36010.5 36490.5 37056.4 37545.4 37779.6 35597.4 35782.1 36180.7 36651.6 37056.4 37246.5 35371.5 35510.5 35816.8 36180.7 36490.5 36632.5 35185.6 35283.8 35510.5 35782.1 36010.5 36110.2 35109.8 35185.6 35371.5 35597.4 35784.3 35860.8 t = 5.00e+00 nst = 313 nfe = 349 nni = 345 qu = 3 hu = 1.26e-01 t = 6.00e+00 nst = 321 nfe = 357 nni = 353 qu = 3 hu = 1.26e-01 t = 7.00e+00 nst = 329 nfe = 366 nni = 362 qu = 3 hu = 1.26e-01 c values at t = 7: Species 1 1.18854 1.19682 1.21415 1.23453 1.25221 1.26082 1.186 1.19351 1.20944 1.22821 1.24444 1.25221 1.1798 1.18593 1.19916 1.21479 1.22821 1.23453 1.17231 1.17692 1.18708 1.19916 1.20944 1.21415 1.16614 1.1694 1.17692 1.18593 1.19351 1.19682 1.16363 1.16614 1.17231 1.1798 1.186 1.18854 Species 2 1.18854 1.19682 1.21415 1.23453 1.25221 1.26082 1.186 1.19351 1.20944 1.22822 1.24444 1.25221 1.1798 1.18593 1.19916 1.21479 1.22822 1.23453 1.17231 1.17692 1.18708 1.19916 1.20944 1.21415 1.16614 1.1694 1.17692 1.18593 1.19351 1.19682 1.16363 1.16614 1.17231 1.1798 1.186 1.18854 Species 3 1.18854 1.19683 1.21415 1.23453 1.25222 1.26082 1.186 1.19351 1.20944 1.22822 1.24444 1.25222 1.1798 1.18593 1.19916 1.21479 1.22822 1.23453 1.17231 1.17692 1.18709 1.19916 1.20944 1.21415 1.16614 1.1694 1.17692 1.18593 1.19351 1.19683 1.16363 1.16614 1.17231 1.1798 1.186 1.18854 Species 4 35655.3 35903.5 36423.2 37034.1 37564.5 37822.3 35579.2 35804.3 36281.8 36844.9 37331.4 37564.5 35393.1 35577 35973.5 36442.2 36844.9 37034.1 35168.3 35306.6 35611.4 35973.5 36281.8 36423.2 34983.2 35081.1 35306.6 35577 35804.3 35903.5 34907.9 34983.2 35168.3 35393.1 35579.2 35655.3 Species 5 35655.3 35903.5 36423.3 37034 37564.5 37822.3 35579.1 35804.3 36281.8 36845 37331.4 37564.5 35393.2 35576.9 35973.5 36442.1 36845 37034 35168.3 35306.7 35611.3 35973.5 36281.8 36423.3 34983.2 35081.1 35306.7 35576.9 35804.3 35903.5 34907.8 34983.2 35168.3 35393.2 35579.1 35655.3 Species 6 35655.3 35903.5 36423.3 37034 37564.5 37822.2 35579.1 35804.3 36281.8 36845 37331.3 37564.5 35393.2 35576.9 35973.6 36442.1 36845 37034 35168.3 35306.7 35611.3 35973.6 36281.8 36423.3 34983.3 35081 35306.7 35576.9 35804.3 35903.5 34907.8 34983.3 35168.3 35393.2 35579.1 35655.3 t = 8.00e+00 nst = 337 nfe = 374 nni = 370 qu = 3 hu = 1.26e-01 t = 9.00e+00 nst = 345 nfe = 382 nni = 378 qu = 3 hu = 1.26e-01 t = 1.00e+01 nst = 353 nfe = 391 nni = 387 qu = 3 hu = 1.26e-01 c values at t = 10: Species 1 1.18838 1.19667 1.21399 1.23437 1.25205 1.26066 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23437 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 2 1.18838 1.19667 1.21399 1.23437 1.25205 1.26066 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23437 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 3 1.18838 1.19667 1.21399 1.23437 1.25205 1.26066 1.18585 1.19335 1.20928 1.22805 1.24428 1.25205 1.17964 1.18578 1.199 1.21463 1.22805 1.23437 1.17215 1.17676 1.18693 1.199 1.20928 1.21399 1.16598 1.16925 1.17676 1.18578 1.19335 1.19667 1.16347 1.16598 1.17215 1.17964 1.18585 1.18838 Species 4 35650.5 35898.8 36418.4 37029.3 37559.4 37817.4 35574.5 35799.5 36277.1 36840 37326.6 37559.4 35388.5 35572.3 35968.7 36437.4 36840 37029.3 35163.7 35302 35606.7 35968.7 36277.1 36418.4 34978.5 35076.5 35302 35572.3 35799.5 35898.8 34903.3 34978.5 35163.7 35388.5 35574.5 35650.5 Species 5 35650.5 35898.8 36418.4 37029.3 37559.4 37817.4 35574.5 35799.5 36277.1 36840 37326.6 37559.4 35388.5 35572.3 35968.7 36437.4 36840 37029.3 35163.7 35302 35606.7 35968.7 36277.1 36418.4 34978.5 35076.5 35302 35572.3 35799.5 35898.8 34903.3 34978.5 35163.7 35388.5 35574.5 35650.5 Species 6 35650.5 35898.8 36418.4 37029.3 37559.4 37817.4 35574.5 35799.5 36277.1 36840 37326.6 37559.4 35388.5 35572.3 35968.7 36437.4 36840 37029.3 35163.7 35302 35606.7 35968.7 36277.1 36418.4 34978.5 35076.5 35302 35572.3 35799.5 35898.8 34903.3 34978.5 35163.7 35388.5 35574.5 35650.5 Final statistics for this run: CVode real workspace length = 2256 CVode integer workspace length = 62 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 353 Number of f-s = 391 Number of f-s (SPGMR) = 585 Number of f-s (TOTAL) = 976 Number of setups = 43 Number of nonlinear iterations = 387 Number of linear iterations = 585 Number of preconditioner evaluations = 43 Number of preconditioner solves = 956 Number of error test failures = 1 Number of nonlinear conv. failures = 0 Number of linear convergence failures = 0 Average Krylov subspace dimension = 1.512 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_LEFT Gram-Schmidt method type is gstype = CLASSICAL_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 116 nfe = 137 nni = 133 qu = 5 hu = 5.51e-06 t = 1.00e-03 nst = 135 nfe = 156 nni = 152 qu = 2 hu = 3.53e-04 t = 1.00e-02 nst = 143 nfe = 166 nni = 162 qu = 3 hu = 1.37e-03 t = 1.00e-01 nst = 165 nfe = 191 nni = 187 qu = 5 hu = 6.02e-03 t = 1.00e+00 nst = 235 nfe = 265 nni = 261 qu = 4 hu = 2.49e-02 t = 2.00e+00 nst = 272 nfe = 305 nni = 301 qu = 3 hu = 3.80e-02 t = 3.00e+00 nst = 288 nfe = 322 nni = 318 qu = 3 hu = 6.58e-02 t = 4.00e+00 nst = 303 nfe = 338 nni = 334 qu = 3 hu = 6.58e-02 t = 5.00e+00 nst = 316 nfe = 352 nni = 348 qu = 2 hu = 1.06e-01 t = 6.00e+00 nst = 323 nfe = 359 nni = 355 qu = 3 hu = 1.94e-01 t = 7.00e+00 nst = 326 nfe = 364 nni = 360 qu = 3 hu = 4.05e-01 t = 8.00e+00 nst = 328 nfe = 366 nni = 362 qu = 3 hu = 4.05e-01 t = 9.00e+00 nst = 331 nfe = 369 nni = 365 qu = 3 hu = 4.05e-01 t = 1.00e+01 nst = 333 nfe = 371 nni = 367 qu = 3 hu = 4.05e-01 Final statistics for this run: CVode real workspace length = 2256 CVode integer workspace length = 62 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 333 Number of f-s = 371 Number of f-s (SPGMR) = 534 Number of f-s (TOTAL) = 905 Number of setups = 44 Number of nonlinear iterations = 367 Number of linear iterations = 534 Number of preconditioner evaluations = 44 Number of preconditioner solves = 885 Number of error test failures = 1 Number of nonlinear conv. failures = 0 Number of linear convergence failures = 4 Average Krylov subspace dimension = 1.455 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_RIGHT Gram-Schmidt method type is gstype = MODIFIED_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 118 nfe = 138 nni = 134 qu = 5 hu = 6.64e-06 t = 1.00e-03 nst = 138 nfe = 163 nni = 159 qu = 2 hu = 4.17e-04 t = 1.00e-02 nst = 146 nfe = 174 nni = 170 qu = 3 hu = 1.64e-03 t = 1.00e-01 nst = 169 nfe = 200 nni = 196 qu = 5 hu = 9.35e-03 t = 1.00e+00 nst = 207 nfe = 247 nni = 243 qu = 5 hu = 5.17e-02 t = 2.00e+00 nst = 218 nfe = 262 nni = 258 qu = 5 hu = 1.36e-01 t = 3.00e+00 nst = 226 nfe = 270 nni = 266 qu = 5 hu = 1.36e-01 t = 4.00e+00 nst = 233 nfe = 277 nni = 273 qu = 5 hu = 1.36e-01 t = 5.00e+00 nst = 241 nfe = 285 nni = 281 qu = 5 hu = 1.36e-01 t = 6.00e+00 nst = 248 nfe = 292 nni = 288 qu = 5 hu = 1.36e-01 t = 7.00e+00 nst = 255 nfe = 299 nni = 295 qu = 5 hu = 1.36e-01 t = 8.00e+00 nst = 260 nfe = 305 nni = 301 qu = 5 hu = 2.06e-01 t = 9.00e+00 nst = 270 nfe = 319 nni = 315 qu = 5 hu = 5.14e-02 t = 1.00e+01 nst = 278 nfe = 328 nni = 324 qu = 3 hu = 3.01e-01 Final statistics for this run: CVode real workspace length = 2256 CVode integer workspace length = 62 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 278 Number of f-s = 328 Number of f-s (SPGMR) = 666 Number of f-s (TOTAL) = 994 Number of setups = 46 Number of nonlinear iterations = 324 Number of linear iterations = 666 Number of preconditioner evaluations = 46 Number of preconditioner solves = 954 Number of error test failures = 3 Number of nonlinear conv. failures = 1 Number of linear convergence failures = 55 Average Krylov subspace dimension = 2.056 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- Preconditioner type is jpre = PREC_RIGHT Gram-Schmidt method type is gstype = CLASSICAL_GS t = 1.00e-08 nst = 3 nfe = 10 nni = 6 qu = 2 hu = 1.76e-08 t = 1.00e-07 nst = 7 nfe = 14 nni = 10 qu = 2 hu = 4.78e-08 t = 1.00e-06 nst = 15 nfe = 24 nni = 20 qu = 3 hu = 1.50e-07 t = 1.00e-05 nst = 34 nfe = 47 nni = 43 qu = 5 hu = 6.11e-07 t = 1.00e-04 nst = 118 nfe = 138 nni = 134 qu = 5 hu = 6.64e-06 t = 1.00e-03 nst = 138 nfe = 163 nni = 159 qu = 2 hu = 4.17e-04 t = 1.00e-02 nst = 146 nfe = 174 nni = 170 qu = 3 hu = 1.64e-03 t = 1.00e-01 nst = 169 nfe = 200 nni = 196 qu = 5 hu = 9.35e-03 t = 1.00e+00 nst = 207 nfe = 247 nni = 243 qu = 5 hu = 5.18e-02 t = 2.00e+00 nst = 219 nfe = 263 nni = 259 qu = 5 hu = 1.21e-01 t = 3.00e+00 nst = 227 nfe = 271 nni = 267 qu = 5 hu = 1.21e-01 t = 4.00e+00 nst = 233 nfe = 278 nni = 274 qu = 5 hu = 1.85e-01 t = 5.00e+00 nst = 238 nfe = 283 nni = 279 qu = 5 hu = 1.85e-01 t = 6.00e+00 nst = 248 nfe = 298 nni = 294 qu = 5 hu = 7.06e-02 t = 7.00e+00 nst = 255 nfe = 305 nni = 301 qu = 4 hu = 2.07e-01 t = 8.00e+00 nst = 258 nfe = 308 nni = 304 qu = 3 hu = 3.42e-01 t = 9.00e+00 nst = 261 nfe = 311 nni = 307 qu = 3 hu = 3.42e-01 t = 1.00e+01 nst = 263 nfe = 313 nni = 309 qu = 3 hu = 5.33e-01 Final statistics for this run: CVode real workspace length = 2256 CVode integer workspace length = 62 CVSPGMR real workspace length = 2206 CVSPGMR integer workspace length = 10 Number of steps = 263 Number of f-s = 313 Number of f-s (SPGMR) = 594 Number of f-s (TOTAL) = 907 Number of setups = 47 Number of nonlinear iterations = 309 Number of linear iterations = 594 Number of preconditioner evaluations = 47 Number of preconditioner solves = 867 Number of error test failures = 3 Number of nonlinear conv. failures = 1 Number of linear convergence failures = 42 Average Krylov subspace dimension = 1.922 ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_bnd.out0000600000175000017500000000152211741421151024162 0ustar sylvestresylvestre 2-D Advection-Diffusion Equation Mesh dimensions = 10 X 5 Total system size = 50 Tolerance parameters: reltol = 0 abstol = 1e-05 At t = 0 max.norm(u) = 8.954716e+01 At t = 0.10 max.norm(u) = 4.132889e+00 nst = 85 At t = 0.20 max.norm(u) = 1.039294e+00 nst = 103 At t = 0.30 max.norm(u) = 2.979829e-01 nst = 113 At t = 0.40 max.norm(u) = 8.765774e-02 nst = 120 At t = 0.50 max.norm(u) = 2.625637e-02 nst = 126 At t = 0.60 max.norm(u) = 7.830425e-03 nst = 130 At t = 0.70 max.norm(u) = 2.329387e-03 nst = 134 At t = 0.80 max.norm(u) = 6.953434e-04 nst = 137 At t = 0.90 max.norm(u) = 2.115983e-04 nst = 140 At t = 1.00 max.norm(u) = 6.556853e-05 nst = 142 Final Statistics: nst = 142 nfe = 174 nsetups = 23 nfeLS = 0 nje = 3 nni = 170 ncfn = 0 netf = 3 sundials-2.5.0/examples/cvodes/serial/cvsKrylovDemo_prec.c0000600000175000017500000010777411741421151024573 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.5 $ * $Date: 2010/12/30 00:22:20 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * -------------------------------------------------------------------- * Demonstration program for CVODES - Krylov linear solver. * ODE system from ns-species interaction PDE in 2 dimensions. * * This program solves a stiff ODE system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector is: * * 1 2 ns * c = (c , c , ..., c ) * * and the PDEs are as follows: * * i i i * dc /dt = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c *(b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2*np, with the first np being prey * and the last np being predators. The coefficients a(i,j), b(i), * d(i) are: * * a(i,i) = -a (all i) * a(i,j) = -g (i <= np, j > np) * a(i,j) = e (i > np, j <= np) * b(i) = b*(1 + alpha*x*y) (i <= np) * b(i) = -b*(1 + alpha*x*y) (i > np) * d(i) = Dprey (i <= np) * d(i) = Dpred (i > np) * * The spatial domain is the unit square. The final time is 10. * The boundary conditions are: normal derivative = 0. * A polynomial in x and y is used to set the initial conditions. * * The PDEs are discretized by central differencing on an MX by MY mesh. * * The resulting ODE system is stiff. * * The ODE system is solved using Newton iteration and the CVSPGMR * linear solver (scaled preconditioned GMRES). * * The preconditioner matrix used is the product of two matrices: * (1) A matrix, only defined implicitly, based on a fixed number * of Gauss-Seidel iterations using the diffusion terms only. * (2) A block-diagonal matrix based on the partial derivatives * of the interaction terms f only, using block-grouping (computing * only a subset of the ns by ns blocks). * * Four different runs are made for this problem. * The product preconditoner is applied on the left and on the * right. In each case, both the modified and classical Gram-Schmidt * options are tested. * In the series of runs, CVodeInit and CVSpgmr are called only * for the first run, whereas CVodeReInit and CVReInitSpgmr are * called for each of the remaining three runs. * * A problem description, performance statistics at selected output * times, and final statistics are written to standard output. * On the first run, solution values are also printed at output * times. Error and warning messages are written to standard error, * but there should be no such messages. * * Note: This program requires the dense linear solver functions * newDenseMat, newLintArray, denseAddIdentity, denseGETRF, denseGETRS, * destroyMat and destroyArray. * * Note: This program assumes the sequential implementation for the * type N_Vector and uses the NV_DATA_S macro to gain access to the * contiguous array of components of an N_Vector. * -------------------------------------------------------------------- * Reference: Peter N. Brown and Alan C. Hindmarsh, Reduced Storage * Matrix Methods in Stiff ODE Systems, J. Appl. Math. & Comp., 31 * (1989), pp. 40-91. Also available as Lawrence Livermore National * Laboratory Report UCRL-95088, Rev. 1, June 1987. * -------------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* prototypes & constants for CVSPGMR solver */ #include /* serial N_Vector types, fct. and macros */ #include /* use generic DENSE solver in preconditioning */ #include /* definition of realtype */ #include /* contains the macros ABS and SQR */ /* Constants */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Problem Specification Constants */ #define AA ONE /* AA = a */ #define EE RCONST(1.0e4) /* EE = e */ #define GG RCONST(0.5e-6) /* GG = g */ #define BB ONE /* BB = b */ #define DPREY ONE #define DPRED RCONST(0.5) #define ALPH ONE #define NP 3 #define NS (2*NP) /* Method Constants */ #define MX 6 #define MY 6 #define MXNS (MX*NS) #define AX ONE #define AY ONE #define DX (AX/(realtype)(MX-1)) #define DY (AY/(realtype)(MY-1)) #define MP NS #define MQ (MX*MY) #define MXMP (MX*MP) #define NGX 2 #define NGY 2 #define NGRP (NGX*NGY) #define ITMAX 5 /* CVodeInit Constants */ #define NEQ (NS*MX*MY) #define T0 ZERO #define RTOL RCONST(1.0e-5) #define ATOL RCONST(1.0e-5) /* CVSpgmr Constants */ #define MAXL 0 /* => use default = MIN(NEQ, 5) */ #define DELT ZERO /* => use default = 0.05 */ /* Output Constants */ #define T1 RCONST(1.0e-8) #define TOUT_MULT RCONST(10.0) #define DTOUT ONE #define NOUT 18 /* Note: The value for species i at mesh point (j,k) is stored in */ /* component number (i-1) + j*NS + k*NS*MX of an N_Vector, */ /* where 1 <= i <= NS, 0 <= j < MX, 0 <= k < MY. */ /* Structure for user data */ typedef struct { realtype **P[NGRP]; long int *pivot[NGRP]; int ns, mxns; int mp, mq, mx, my, ngrp, ngx, ngy, mxmp; int jgx[NGX+1], jgy[NGY+1], jigx[MX], jigy[MY]; int jxr[NGX], jyr[NGY]; realtype acoef[NS][NS], bcoef[NS], diff[NS]; realtype cox[NS], coy[NS], dx, dy, srur; realtype fsave[NEQ]; N_Vector rewt; void *cvode_mem; } *WebData; /* Private Helper Functions */ static WebData AllocUserData(void); static void InitUserData(WebData wdata); static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]); static void CInit(N_Vector c, WebData wdata); static void PrintIntro(void); static void PrintHeader(int jpre, int gstype); static void PrintAllSpecies(N_Vector c, int ns, int mxns, realtype t); static void PrintOutput(void *cvode_mem, realtype t); static void PrintFinalStats(void *cvode_mem); static void FreeUserData(WebData wdata); static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata); static void fblock (realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata); static void GSIter(realtype gamma, N_Vector z, N_Vector x,WebData wdata); /* Small Vector Kernels */ static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n); static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n); static void v_prod(realtype u[], realtype v[], realtype w[], int n); static void v_zero(realtype u[], int n); /* Functions Called By The Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Precond(realtype tn, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype tn, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Implementation */ int main() { realtype abstol=ATOL, reltol=RTOL, t, tout; N_Vector c; WebData wdata; void *cvode_mem; booleantype firstrun; int jpre, gstype, flag; int ns, mxns, iout; c = NULL; wdata = NULL; cvode_mem = NULL; /* Initializations */ c = N_VNew_Serial(NEQ); if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1); wdata = AllocUserData(); if(check_flag((void *)wdata, "AllocUserData", 2)) return(1); InitUserData(wdata); ns = wdata->ns; mxns = wdata->mxns; /* Print problem description */ PrintIntro(); /* Loop over jpre and gstype (four cases) */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) { /* Initialize c and print heading */ CInit(c, wdata); PrintHeader(jpre, gstype); /* Call CVodeInit or CVodeReInit, then CVSpgmr to set up problem */ firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS); if (firstrun) { cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); wdata->cvode_mem = cvode_mem; flag = CVodeSetUserData(cvode_mem, wdata); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeInit(cvode_mem, f, T0, c); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); flag = CVSpgmr(cvode_mem, jpre, MAXL); if(check_flag(&flag, "CVSpgmr", 1)) return(1); flag = CVSpilsSetGSType(cvode_mem, gstype); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); flag = CVSpilsSetEpsLin(cvode_mem, DELT); if(check_flag(&flag, "CVSpilsSetEpsLin", 1)) return(1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); } else { flag = CVodeReInit(cvode_mem, T0, c); if(check_flag(&flag, "CVodeReInit", 1)) return(1); flag = CVSpilsSetPrecType(cvode_mem, jpre); check_flag(&flag, "CVSpilsSetPrecType", 1); flag = CVSpilsSetGSType(cvode_mem, gstype); if(check_flag(&flag, "CVSpilsSetGSType", 1)) return(1); } /* Print initial values */ if (firstrun) PrintAllSpecies(c, ns, mxns, T0); /* Loop over output points, call CVode, print sample solution values. */ tout = T1; for (iout = 1; iout <= NOUT; iout++) { flag = CVode(cvode_mem, tout, c, &t, CV_NORMAL); PrintOutput(cvode_mem, t); if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t); if(check_flag(&flag, "CVode", 1)) break; if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT; } /* Print final statistics, and loop for next case */ PrintFinalStats(cvode_mem); } } /* Free all memory */ CVodeFree(&cvode_mem); N_VDestroy_Serial(c); FreeUserData(wdata); return(0); } static WebData AllocUserData(void) { int i, ngrp = NGRP; long int ns = NS; WebData wdata; wdata = (WebData) malloc(sizeof *wdata); for(i=0; i < ngrp; i++) { (wdata->P)[i] = newDenseMat(ns, ns); (wdata->pivot)[i] = newLintArray(ns); } wdata->rewt = N_VNew_Serial(NEQ); return(wdata); } static void InitUserData(WebData wdata) { int i, j, ns; realtype *bcoef, *diff, *cox, *coy, dx, dy; realtype (*acoef)[NS]; acoef = wdata->acoef; bcoef = wdata->bcoef; diff = wdata->diff; cox = wdata->cox; coy = wdata->coy; ns = wdata->ns = NS; for (j = 0; j < NS; j++) { for (i = 0; i < NS; i++) acoef[i][j] = 0.; } for (j = 0; j < NP; j++) { for (i = 0; i < NP; i++) { acoef[NP+i][j] = EE; acoef[i][NP+j] = -GG; } acoef[j][j] = -AA; acoef[NP+j][NP+j] = -AA; bcoef[j] = BB; bcoef[NP+j] = -BB; diff[j] = DPREY; diff[NP+j] = DPRED; } /* Set remaining problem parameters */ wdata->mxns = MXNS; dx = wdata->dx = DX; dy = wdata->dy = DY; for (i = 0; i < ns; i++) { cox[i] = diff[i]/SQR(dx); coy[i] = diff[i]/SQR(dy); } /* Set remaining method parameters */ wdata->mp = MP; wdata->mq = MQ; wdata->mx = MX; wdata->my = MY; wdata->srur = SQRT(UNIT_ROUNDOFF); wdata->mxmp = MXMP; wdata->ngrp = NGRP; wdata->ngx = NGX; wdata->ngy = NGY; SetGroups(MX, NGX, wdata->jgx, wdata->jigx, wdata->jxr); SetGroups(MY, NGY, wdata->jgy, wdata->jigy, wdata->jyr); } /* This routine sets arrays jg, jig, and jr describing a uniform partition of (0,1,2,...,m-1) into ng groups. The arrays set are: jg = length ng+1 array of group boundaries. Group ig has indices j = jg[ig],...,jg[ig+1]-1. jig = length m array of group indices vs node index. Node index j is in group jig[j]. jr = length ng array of indices representing the groups. The index for group ig is j = jr[ig]. */ static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]) { int ig, j, len1, mper, ngm1; mper = m/ng; /* does integer division */ for (ig=0; ig < ng; ig++) jg[ig] = ig*mper; jg[ng] = m; ngm1 = ng - 1; len1 = ngm1*mper; for (j = 0; j < len1; j++) jig[j] = j/mper; for (j = len1; j < m; j++) jig[j] = ngm1; for (ig = 0; ig < ngm1; ig++) jr[ig] = ((2*ig+1)*mper-1)/2; jr[ngm1] = (ngm1*mper+m-1)/2; } /* This routine computes and loads the vector of initial values. */ static void CInit(N_Vector c, WebData wdata) { int jx, jy, ns, mxns, ioff, iyoff, i, ici; realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata; cdata = NV_DATA_S(c); ns = wdata->ns; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; x_factor = RCONST(4.0)/SQR(AX); y_factor = RCONST(4.0)/SQR(AY); for (jy = 0; jy < MY; jy++) { y = jy*dy; argy = SQR(y_factor*y*(AY-y)); iyoff = mxns*jy; for (jx = 0; jx < MX; jx++) { x = jx*dx; argx = SQR(x_factor*x*(AX-x)); ioff = iyoff + ns*jx; for (i = 1; i <= ns; i++) { ici = ioff + i-1; cdata[ici] = RCONST(10.0) + i*argx*argy; } } } } static void PrintIntro(void) { printf("\n\nDemonstration program for CVODES - CVSPGMR linear solver\n\n"); printf("Food web problem with ns species, ns = %d\n", NS); printf("Predator-prey interaction and diffusion on a 2-D square\n\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Matrix parameters: a = %.2Lg e = %.2Lg g = %.2Lg\n", AA, EE, GG); printf("b parameter = %.2Lg\n", BB); printf("Diffusion coefficients: Dprey = %.2Lg Dpred = %.2Lg\n", DPREY, DPRED); printf("Rate parameter alpha = %.2Lg\n\n", ALPH); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Matrix parameters: a = %.2lg e = %.2lg g = %.2lg\n", AA, EE, GG); printf("b parameter = %.2lg\n", BB); printf("Diffusion coefficients: Dprey = %.2lg Dpred = %.2lg\n", DPREY, DPRED); printf("Rate parameter alpha = %.2lg\n\n", ALPH); #else printf("Matrix parameters: a = %.2g e = %.2g g = %.2g\n", AA, EE, GG); printf("b parameter = %.2g\n", BB); printf("Diffusion coefficients: Dprey = %.2g Dpred = %.2g\n", DPREY, DPRED); printf("Rate parameter alpha = %.2g\n\n", ALPH); #endif printf("Mesh dimensions (mx,my) are %d, %d. ", MX, MY); printf("Total system size is neq = %d \n\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerances: reltol = %.2Lg, abstol = %.2Lg \n\n", RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerances: reltol = %.2lg, abstol = %.2lg \n\n", RTOL, ATOL); #else printf("Tolerances: reltol = %.2g, abstol = %.2g \n\n", RTOL, ATOL); #endif printf("Preconditioning uses a product of:\n"); printf(" (1) Gauss-Seidel iterations with "); printf("itmax = %d iterations, and\n", ITMAX); printf(" (2) interaction-only block-diagonal matrix "); printf("with block-grouping\n"); printf(" Number of diagonal block groups = ngrp = %d", NGRP); printf(" (ngx by ngy, ngx = %d, ngy = %d)\n", NGX, NGY); printf("\n\n--------------------------------------------------------------"); printf("--------------\n"); } static void PrintHeader(int jpre, int gstype) { if(jpre == PREC_LEFT) printf("\n\nPreconditioner type is jpre = %s\n", "PREC_LEFT"); else printf("\n\nPreconditioner type is jpre = %s\n", "PREC_RIGHT"); if(gstype == MODIFIED_GS) printf("\nGram-Schmidt method type is gstype = %s\n\n\n", "MODIFIED_GS"); else printf("\nGram-Schmidt method type is gstype = %s\n\n\n", "CLASSICAL_GS"); } static void PrintAllSpecies(N_Vector c, int ns, int mxns, realtype t) { int i, jx ,jy; realtype *cdata; cdata = NV_DATA_S(c); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("c values at t = %Lg:\n\n", t); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("c values at t = %lg:\n\n", t); #else printf("c values at t = %g:\n\n", t); #endif for (i=1; i <= ns; i++) { printf("Species %d\n", i); for (jy=MY-1; jy >= 0; jy--) { for (jx=0; jx < MX; jx++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-10.6Lg", cdata[(i-1) + jx*ns + jy*mxns]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-10.6lg", cdata[(i-1) + jx*ns + jy*mxns]); #else printf("%-10.6g", cdata[(i-1) + jx*ns + jy*mxns]); #endif } printf("\n"); } printf("\n"); } } static void PrintOutput(void *cvode_mem, realtype t) { long int nst, nfe, nni; int qu, flag; realtype hu; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("t = %10.2Le nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2Le\n\n", qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("t = %10.2le nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2le\n\n", qu, hu); #else printf("t = %10.2e nst = %ld nfe = %ld nni = %ld", t, nst, nfe, nni); printf(" qu = %d hu = %11.2e\n\n", qu, hu); #endif } static void PrintFinalStats(void *cvode_mem) { long int lenrw, leniw ; long int lenrwLS, leniwLS; long int nst, nfe, nsetups, nni, ncfn, netf; long int nli, npe, nps, ncfl, nfeLS; int flag; realtype avdim; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVSpilsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVSpilsGetWorkSpace", 1); flag = CVSpilsGetNumLinIters(cvode_mem, &nli); check_flag(&flag, "CVSpilsGetNumLinIters", 1); flag = CVSpilsGetNumPrecEvals(cvode_mem, &npe); check_flag(&flag, "CVSpilsGetNumPrecEvals", 1); flag = CVSpilsGetNumPrecSolves(cvode_mem, &nps); check_flag(&flag, "CVSpilsGetNumPrecSolves", 1); flag = CVSpilsGetNumConvFails(cvode_mem, &ncfl); check_flag(&flag, "CVSpilsGetNumConvFails", 1); flag = CVSpilsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVSpilsGetNumRhsEvals", 1); printf("\n\n Final statistics for this run:\n\n"); printf(" CVode real workspace length = %4ld \n", lenrw); printf(" CVode integer workspace length = %4ld \n", leniw); printf(" CVSPGMR real workspace length = %4ld \n", lenrwLS); printf(" CVSPGMR integer workspace length = %4ld \n", leniwLS); printf(" Number of steps = %4ld \n", nst); printf(" Number of f-s = %4ld \n", nfe); printf(" Number of f-s (SPGMR) = %4ld \n", nfeLS); printf(" Number of f-s (TOTAL) = %4ld \n", nfe + nfeLS); printf(" Number of setups = %4ld \n", nsetups); printf(" Number of nonlinear iterations = %4ld \n", nni); printf(" Number of linear iterations = %4ld \n", nli); printf(" Number of preconditioner evaluations = %4ld \n", npe); printf(" Number of preconditioner solves = %4ld \n", nps); printf(" Number of error test failures = %4ld \n", netf); printf(" Number of nonlinear conv. failures = %4ld \n", ncfn); printf(" Number of linear convergence failures = %4ld \n", ncfl); avdim = (nni > 0) ? ((realtype)nli)/((realtype)nni) : ZERO; #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" Average Krylov subspace dimension = %.3Lf \n", avdim); #else printf(" Average Krylov subspace dimension = %.3f \n", avdim); #endif printf("\n\n--------------------------------------------------------------"); printf("--------------\n"); printf( "--------------------------------------------------------------"); printf("--------------\n"); } static void FreeUserData(WebData wdata) { int i, ngrp; ngrp = wdata->ngrp; for(i=0; i < ngrp; i++) { destroyMat((wdata->P)[i]); destroyArray((wdata->pivot)[i]); } N_VDestroy_Serial(wdata->rewt); free(wdata); } /* This routine computes the right-hand side of the ODE system and returns it in cdot. The interaction rates are computed by calls to WebRates, and these are saved in fsave for use in preconditioning. */ static int f(realtype t, N_Vector c, N_Vector cdot,void *user_data) { int i, ic, ici, idxl, idxu, jx, ns, mxns, iyoff, jy, idyu, idyl; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy; realtype *cdata, *cdotdata; WebData wdata; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cdotdata = NV_DATA_S(cdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRates(x, y, t, cdata+ic, fsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cdata[ici] - cdata[ici-idyl]; dcyui = cdata[ici+idyu] - cdata[ici]; /* Do differencing in x. */ dcxli = cdata[ici] - cdata[ici-idxl]; dcxui = cdata[ici+idxu] - cdata[ici]; /* Collect terms and load cdot elements. */ cdotdata[ici] = coy[i-1]*(dcyui - dcyli) + cox[i-1]*(dcxui - dcxli) + fsave[ici]; } } } return(0); } /* This routine computes the interaction rates for the species c_1, ... ,c_ns (stored in c[0],...,c[ns-1]), at one spatial point and at time t. */ static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; for (i = 0; i < ns; i++) rate[i] = ZERO; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += c[j] * acoef[i][j]; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = c[i]*(bcoef[i]*fac + rate[i]); } /* This routine generates the block-diagonal part of the Jacobian corresponding to the interaction rates, multiplies by -gamma, adds the identity matrix, and calls denseGETRF to do the LU decomposition of each diagonal block. The computation of the diagonal blocks uses the preset block and grouping information. One block per group is computed. The Jacobian elements are generated by difference quotients using calls to the routine fblock. This routine can be regarded as a prototype for the general case of a block-diagonal preconditioner. The blocks are of size mp, and there are ngrp=ngx*ngy blocks computed in the block-grouping scheme. */ static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype ***P; long int **pivot, ier; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag; long int mp; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; WebData wdata; void *cvode_mem; N_Vector rewt; wdata = (WebData) user_data; cvode_mem = wdata->cvode_mem; cdata = NV_DATA_S(c); rewt = wdata->rewt; flag = CVodeGetErrWeights(cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fc, rewt); r0 = RCONST(1000.0)*ABS(gamma)*uround*NEQ*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = -gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][j][i] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* This routine computes one block of the interaction terms of the system, namely block (jx,jy), for use in preconditioning. Here jx and jy count from 0. */ static void fblock(realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata) { int iblok, ic; realtype x, y; iblok = jx + jy*(wdata->mx); y = jy*(wdata->dy); x = jx*(wdata->dx); ic = (wdata->ns)*(iblok); WebRates(x, y, t, cdata+ic, cdotdata, wdata); } /* This routine applies two inverse preconditioner matrices to the vector r, using the interaction-only block-diagonal Jacobian with block-grouping, denoted Jr, and Gauss-Seidel applied to the diffusion contribution to the Jacobian, denoted Jd. It first calls GSIter for a Gauss-Seidel approximation to ((I - gamma*Jd)-inverse)*r, and stores the result in z. Then it computes ((I - gamma*Jr)-inverse)*z, using LU factors of the blocks in P, and pivot information in pivot, and returns the result in z. */ static int PSolve(realtype tn, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx; long int mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations */ GSIter(gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } return(0); } /* This routine performs ITMAX=5 Gauss-Seidel iterations to compute an approximation to (P-inverse)*z, where P = I - gamma*Jd, and Jd represents the diffusion contributions to the Jacobian. The answer is stored in z on return, and x is a temporary vector. The dimensions below assume a global constant NS >= ns. Some inner loops of length ns are implemented with the small vector kernels v_sum_prods, v_prod, v_inc_by_prod. */ static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata) { int jx, jy, mx, my, x_loc, y_loc; int ns, mxns, i, iyoff, ic, iter; realtype beta[NS], beta2[NS], cof1[NS], gam[NS], gam2[NS]; realtype temp, *cox, *coy, *xd, *zd; xd = NV_DATA_S(x); zd = NV_DATA_S(z); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; cox = wdata->cox; coy = wdata->coy; /* Write matrix as P = D - L - U. Load local arrays beta, beta2, gam, gam2, and cof1. */ for (i = 0; i < ns; i++) { temp = ONE/(ONE + RCONST(2.0)*gamma*(cox[i] + coy[i])); beta[i] = gamma*cox[i]*temp; beta2[i] = RCONST(2.0)*beta[i]; gam[i] = gamma*coy[i]*temp; gam2[i] = RCONST(2.0)*gam[i]; cof1[i] = temp; } /* Begin iteration loop. Load vector x with (D-inverse)*z for first iteration. */ for (jy = 0; jy < my; jy++) { iyoff = mxns*jy; for (jx = 0; jx < mx; jx++) { ic = iyoff + ns*jx; v_prod(xd+ic, cof1, zd+ic, ns); /* x[ic+i] = cof1[i]z[ic+i] */ } } N_VConst(ZERO, z); /* Looping point for iterations. */ for (iter=1; iter <= ITMAX; iter++) { /* Calculate (D-inverse)*U*x if not the first iteration. */ if (iter > 1) { for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] = gam2[i]x[ic+mxns+i] */ v_prod(xd+ic, gam2, xd+ic+mxns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] = gam[i]x[ic+mxns+i] */ v_prod(xd+ic, gam, xd+ic+mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] = beta2[i]x[ic+ns+i] */ v_prod(xd+ic, beta2, xd+ic+ns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] = beta[i]x[ic+ns+i] */ v_prod(xd+ic, beta, xd+ic+ns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] = 0.0 */ v_zero(xd+ic, ns); break; } } } } /* end if (iter > 1) */ /* Overwrite x with [(I - (D-inverse)*L)-inverse]*x. */ for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] += beta[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] += beta2[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] += gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] += gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; } } } /* Add increment x to z : z <- z+x */ N_VLinearSum(ONE, z, ONE, x, z); } } static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] += v[i]*w[i]; } static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = p[i]*q[i] + v[i]*w[i]; } static void v_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = v[i]*w[i]; } static void v_zero(realtype u[], int n) { int i; for (i=0; i < n; i++) u[i] = ZERO; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsRoberts_ASAi_dns.out0000600000175000017500000000226011741421151025155 0ustar sylvestresylvestre Adjoint Sensitivity Example for Chemical Kinetics ------------------------------------------------- ODE: dy1/dt = -p1*y1 + p2*y2*y3 dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2 dy3/dt = p3*(y2)^2 Find dG/dp for G = int_t0^tB0 g(t,p,y) dt g(t,p,y) = y3 Create and allocate CVODES memory for forward runs Forward integration ... done ( nst = 851 ) ncheck = 5 -------------------------------------------------------- G: 3.9983e+07 -------------------------------------------------------- Create and allocate CVODES memory for backward run Backward integration ... done ( nst = 260 ) -------------------------------------------------------- tB0: 4.0000e+07 dG/dp: 7.6844e+05 -3.0691e+00 5.1152e-04 lambda(t0): 3.9967e+07 3.9967e+07 3.9967e+07 -------------------------------------------------------- Re-initialize CVODES memory for backward run Backward integration ... done ( nst = 196 ) -------------------------------------------------------- tB0: 5.0000e+01 dG/dp: 1.7341e+02 -5.0590e-04 8.4320e-08 lambda(t0): 8.4190e+00 1.6097e+01 1.6097e+01 -------------------------------------------------------- Free memory sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_kry_bp.out0000600000175000017500000001362711741421151025011 0ustar sylvestresylvestre2-species diurnal advection-diffusion problem, 10 by 10 mesh SPGMR solver; band preconditioner; mu = 2, ml = 2 Preconditioner type is: jpre = PREC_LEFT t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.61e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 221 order = 5 stepsize = 3.83e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 246 order = 5 stepsize = 2.78e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 291 order = 4 stepsize = 1.14e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 331 order = 4 stepsize = 8.86e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 402 order = 4 stepsize = 4.15e+02 c1 (bot.left/middle/top rt.) = -5.769e-09 3.421e-09 -3.866e-09 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 415 order = 5 stepsize = 4.58e+02 c1 (bot.left/middle/top rt.) = -4.979e-18 -7.193e-15 -2.653e-15 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 430 order = 4 stepsize = 2.19e+02 c1 (bot.left/middle/top rt.) = 1.611e-17 4.587e-16 -4.704e-18 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 444 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 9.505e-16 1.154e-14 -2.316e-16 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 457 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 3.910e-16 -4.848e-14 2.545e-15 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 469 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = -2.903e-15 2.152e-13 3.551e-16 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 481 order = 4 stepsize = 5.79e+02 c1 (bot.left/middle/top rt.) = 2.358e-23 2.316e-18 -6.007e-16 c2 (bot.left/middle/top rt.) = 3.352e+11 9.108e+11 4.162e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwls = 2046 leniwls = 10 lenrwbp = 2400 leniwbp = 200 nst = 481 nfe = 620 nfetot = 1226 nfeLS = 561 nfeBP = 45 nni = 616 nli = 561 nsetups = 88 netf = 28 npe = 9 nps = 1096 ncfn = 0 ncfl = 0 ------------------------------------------------------------------- Preconditioner type is: jpre = PREC_RIGHT t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.55e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.59e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 279 order = 5 stepsize = 3.58e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 2.40e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 330 order = 5 stepsize = 1.31e+02 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 381 order = 4 stepsize = 3.91e+02 c1 (bot.left/middle/top rt.) = 3.125e-10 2.750e-10 3.496e-10 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 395 order = 5 stepsize = 4.06e+02 c1 (bot.left/middle/top rt.) = -3.259e-14 -1.715e-12 -6.477e-14 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 408 order = 5 stepsize = 4.57e+02 c1 (bot.left/middle/top rt.) = 2.382e-14 5.871e-12 6.950e-14 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 420 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = 1.493e-18 1.862e-17 -7.080e-16 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 430 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = -1.345e-20 1.847e-18 -6.157e-16 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 440 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = 3.617e-20 -3.355e-18 -7.407e-16 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 450 order = 5 stepsize = 7.04e+02 c1 (bot.left/middle/top rt.) = -5.505e-20 3.704e-18 -2.929e-15 c2 (bot.left/middle/top rt.) = 3.352e+11 9.106e+11 4.163e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwls = 2046 leniwls = 10 lenrwbp = 2400 leniwbp = 200 nst = 450 nfe = 564 nfetot = 1319 nfeLS = 670 nfeBP = 85 nni = 560 nli = 670 nsetups = 71 netf = 21 npe = 8 nps = 1140 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dns.c0000600000175000017500000002610211741421151023734 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:58:00 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the CVDENSE dense linear solver, and a * user-supplied Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts. and consts. */ #include /* serial N_Vector types, fcts., and macros */ #include /* prototype for CVDense */ #include /* definitions DlsMat DENSE_ELEM */ #include /* definition of type realtype */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype reltol, t, tout; N_Vector y, abstol; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = abstol = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. and abstol */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); abstol = N_VNew_Serial(NEQ); if (check_flag((void *)abstol, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Set the scalar relative tolerance */ reltol = RTOL; /* Set the vector absolute tolerance */ Ith(abstol,1) = ATOL1; Ith(abstol,2) = ATOL2; Ith(abstol,3) = ATOL3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSVtolerances to specify the scalar relative tolerance * and vector absolute tolerances */ flag = CVodeSVtolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSVtolerances", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVDense to specify the CVDENSE dense linear solver */ flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); if (check_flag(&flagr, "CVodeGetRootInfo", 1)) return(1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y vector */ N_VDestroy_Serial(y); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsDirectDemo_ls.c0000600000175000017500000006163511741421151024177 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Demonstration program for CVODE - direct linear solvers. * Two separate problems are solved using both the CV_ADAMS and CV_BDF * linear multistep methods in combination with CV_FUNCTIONAL and * CV_NEWTON iterations: * * Problem 1: Van der Pol oscillator * xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0. * This second-order ODE is converted to a first-order system by * defining y0 = x and y1 = xdot. * The NEWTON iteration cases use the following types of Jacobian * approximation: (1) dense, user-supplied, (2) dense, difference * quotient approximation, (3) diagonal approximation. * * Problem 2: ydot = A * y, where A is a banded lower triangular * matrix derived from 2-D advection PDE. * The NEWTON iteration cases use the following types of Jacobian * approximation: (1) band, user-supplied, (2) band, difference * quotient approximation, (3) diagonal approximation. * * For each problem, in the series of eight runs, CVodeInit is * called only once, for the first run, whereas CVodeReInit is * called for each of the remaining seven runs. * * Notes: This program demonstrates the usage of the sequential * macros NV_Ith_S, NV_DATA_S, DENSE_ELEM, BAND_COL, and * BAND_COL_ELEM. The NV_Ith_S macro is used to reference the * components of an N_Vector. It works for any size N=NEQ, but * due to efficiency concerns it should only by used when the * problem size is small. The Problem 1 right hand side and * Jacobian functions f1 and Jac1 both use NV_Ith_S. The NV_DATA_S * macro gives the user access to the memory used for the component * storage of an N_Vector. In the sequential case, the user may * assume that this is one contiguous array of reals. The NV_DATA_S * macro gives a more efficient means (than the NV_Ith_S macro) to * access the components of an N_Vector and should be used when the * problem size is large. The Problem 2 right hand side function f2 * uses the NV_DATA_S macro. The DENSE_ELEM macro used in Jac1 * gives access to an element of a dense matrix of type DlsMat. * It should be used only when the problem size is small (the size * of a DlsMat is NEQ x NEQ) due to efficiency concerns. For * larger problem sizes, the macro DENSE_COL can be used in order * to work directly with a column of a DlsMat. The BAND_COL and * BAND_COL_ELEM allow efficient columnwise access to the elements * of a band matrix of type DlsMat. These macros are used in the * Jac2 function. * ----------------------------------------------------------------- */ #include #include #include #include /* main integrator header file */ #include /* use CVDENSE linear solver */ #include /* use CVBAND linear solver */ #include /* use CVDIAG linear solver */ #include /* serial N_Vector types, fct. and macros */ #include /* definition of realtype */ #include /* contains the macros ABS, SQR, and EXP*/ /* Shared Problem Constants */ #define ATOL RCONST(1.0e-6) #define RTOL RCONST(0.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define THIRTY RCONST(30.0) /* Problem #1 Constants */ #define P1_NEQ 2 #define P1_ETA RCONST(3.0) #define P1_NOUT 4 #define P1_T0 RCONST(0.0) #define P1_T1 RCONST(1.39283880203) #define P1_DTOUT RCONST(2.214773875) #define P1_TOL_FACTOR RCONST(1.0e4) /* Problem #2 Constants */ #define P2_MESHX 5 #define P2_MESHY 5 #define P2_NEQ P2_MESHX*P2_MESHY #define P2_ALPH1 RCONST(1.0) #define P2_ALPH2 RCONST(1.0) #define P2_NOUT 5 #define P2_ML 5 #define P2_MU 0 #define P2_T0 RCONST(0.0) #define P2_T1 RCONST(0.01) #define P2_TOUT_MULT RCONST(10.0) #define P2_TOL_FACTOR RCONST(1.0e3) /* Linear Solver Options */ enum {FUNC, DENSE_USER, DENSE_DQ, DIAG, BAND_USER, BAND_DQ}; /* Private Helper Functions */ static int Problem1(void); static void PrintIntro1(void); static void PrintHeader1(void); static void PrintOutput1(realtype t, realtype y0, realtype y1, int qu, realtype hu); static int Problem2(void); static void PrintIntro2(void); static void PrintHeader2(void); static void PrintOutput2(realtype t, realtype erm, int qu, realtype hu); static realtype MaxError(N_Vector y, realtype t); static int PrepareNextRun(void *cvode_mem, int lmm, int miter, long int mu, long int ml); static void PrintErrOutput(realtype tol_factor); static void PrintFinalStats(void *cvode_mem, int miter, realtype ero); static void PrintErrInfo(int nerr); /* Functions Called by the Solver */ static int f1(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac1(long int N, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int f2(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac2(long int N, long int mu, long int ml, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Implementation */ int main(void) { int nerr; nerr = Problem1(); nerr += Problem2(); PrintErrInfo(nerr); return(0); } static int Problem1(void) { realtype reltol=RTOL, abstol=ATOL, t, tout, ero, er; int miter, flag, temp_flag, iout, nerr=0; N_Vector y; void *cvode_mem; booleantype firstrun; int qu; realtype hu; y = NULL; cvode_mem = NULL; y = N_VNew_Serial(P1_NEQ); if(check_flag((void *)y, "N_VNew_Serial", 0)) return(1); PrintIntro1(); cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= DIAG; miter++) { ero = ZERO; NV_Ith_S(y,0) = TWO; NV_Ith_S(y,1) = ZERO; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f1, P1_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P1_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_ADAMS, miter, 0, 0); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader1(); for(iout=1, tout=P1_T1; iout <= P1_NOUT; iout++, tout += P1_DTOUT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput1(t, NV_Ith_S(y,0), NV_Ith_S(y,1), qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } if (iout%2 == 0) { er = ABS(NV_Ith_S(y,0)) / abstol; if (er > ero) ero = er; if (er > P1_TOL_FACTOR) { nerr++; PrintErrOutput(P1_TOL_FACTOR); } } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); cvode_mem = CVodeCreate(CV_BDF, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= DIAG; miter++) { ero = ZERO; NV_Ith_S(y,0) = TWO; NV_Ith_S(y,1) = ZERO; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f1, P1_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P1_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_BDF, miter, 0, 0); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader1(); for(iout=1, tout=P1_T1; iout <= P1_NOUT; iout++, tout += P1_DTOUT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput1(t, NV_Ith_S(y,0), NV_Ith_S(y,1), qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } if (iout%2 == 0) { er = ABS(NV_Ith_S(y,0)) / abstol; if (er > ero) ero = er; if (er > P1_TOL_FACTOR) { nerr++; PrintErrOutput(P1_TOL_FACTOR); } } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); N_VDestroy_Serial(y); return(nerr); } static void PrintIntro1(void) { printf("Demonstration program for CVODE package - direct linear solvers\n"); printf("\n\n"); printf("Problem 1: Van der Pol oscillator\n"); printf(" xdotdot - 3*(1 - x^2)*xdot + x = 0, x(0) = 2, xdot(0) = 0\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" neq = %d, reltol = %.2Lg, abstol = %.2Lg", P1_NEQ, RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" neq = %d, reltol = %.2lg, abstol = %.2lg", P1_NEQ, RTOL, ATOL); #else printf(" neq = %d, reltol = %.2g, abstol = %.2g", P1_NEQ, RTOL, ATOL); #endif } static void PrintHeader1(void) { printf("\n t x xdot qu hu \n"); return; } static void PrintOutput1(realtype t, realtype y0, realtype y1, int qu, realtype hu) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.5Lf %12.5Le %12.5Le %2d %6.4Le\n", t, y0, y1, qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.5f %12.5le %12.5le %2d %6.4le\n", t, y0, y1, qu, hu); #else printf("%10.5f %12.5e %12.5e %2d %6.4e\n", t, y0, y1, qu, hu); #endif return; } static int f1(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y0, y1; y0 = NV_Ith_S(y,0); y1 = NV_Ith_S(y,1); NV_Ith_S(ydot,0) = y1; NV_Ith_S(ydot,1) = (ONE - SQR(y0))* P1_ETA * y1 - y0; return(0); } static int Jac1(long int N, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y0, y1; y0 = NV_Ith_S(y,0); y1 = NV_Ith_S(y,1); DENSE_ELEM(J,0,1) = ONE; DENSE_ELEM(J,1,0) = -TWO * P1_ETA * y0 * y1 - ONE; DENSE_ELEM(J,1,1) = P1_ETA * (ONE - SQR(y0)); return(0); } static int Problem2(void) { realtype reltol=RTOL, abstol=ATOL, t, tout, er, erm, ero; int miter, flag, temp_flag, nerr=0; N_Vector y; void *cvode_mem; booleantype firstrun; int qu, iout; realtype hu; y = NULL; cvode_mem = NULL; y = N_VNew_Serial(P2_NEQ); if(check_flag((void *)y, "N_VNew", 0)) return(1); PrintIntro2(); cvode_mem = CVodeCreate(CV_ADAMS, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= BAND_DQ; miter++) { if ((miter==DENSE_USER) || (miter==DENSE_DQ)) continue; ero = ZERO; N_VConst(ZERO, y); NV_Ith_S(y,0) = ONE; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f2, P2_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P2_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_ADAMS, miter, P2_MU, P2_ML); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader2(); for(iout=1, tout=P2_T1; iout <= P2_NOUT; iout++, tout*=P2_TOUT_MULT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); erm = MaxError(y, t); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput2(t, erm, qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } er = erm / abstol; if (er > ero) ero = er; if (er > P2_TOL_FACTOR) { nerr++; PrintErrOutput(P2_TOL_FACTOR); } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); cvode_mem = CVodeCreate(CV_BDF, CV_FUNCTIONAL); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); for (miter=FUNC; miter <= BAND_DQ; miter++) { if ((miter==DENSE_USER) || (miter==DENSE_DQ)) continue; ero = ZERO; N_VConst(ZERO, y); NV_Ith_S(y,0) = ONE; firstrun = (miter==FUNC); if (firstrun) { flag = CVodeInit(cvode_mem, f2, P2_T0, y); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); } else { flag = CVodeSetIterType(cvode_mem, CV_NEWTON); if(check_flag(&flag, "CVodeSetIterType", 1)) ++nerr; flag = CVodeReInit(cvode_mem, P2_T0, y); if(check_flag(&flag, "CVodeReInit", 1)) return(1); } flag = PrepareNextRun(cvode_mem, CV_BDF, miter, P2_MU, P2_ML); if(check_flag(&flag, "PrepareNextRun", 1)) return(1); PrintHeader2(); for(iout=1, tout=P2_T1; iout <= P2_NOUT; iout++, tout*=P2_TOUT_MULT) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); check_flag(&flag, "CVode", 1); erm = MaxError(y, t); temp_flag = CVodeGetLastOrder(cvode_mem, &qu); if(check_flag(&temp_flag, "CVodeGetLastOrder", 1)) ++nerr; temp_flag = CVodeGetLastStep(cvode_mem, &hu); if(check_flag(&temp_flag, "CVodeGetLastStep", 1)) ++nerr; PrintOutput2(t, erm, qu, hu); if (flag != CV_SUCCESS) { nerr++; break; } er = erm / abstol; if (er > ero) ero = er; if (er > P2_TOL_FACTOR) { nerr++; PrintErrOutput(P2_TOL_FACTOR); } } PrintFinalStats(cvode_mem, miter, ero); } CVodeFree(&cvode_mem); N_VDestroy_Serial(y); return(nerr); } static void PrintIntro2(void) { printf("\n\n-------------------------------------------------------------"); printf("\n-------------------------------------------------------------"); printf("\n\nProblem 2: ydot = A * y, where A is a banded lower\n"); printf("triangular matrix derived from 2-D advection PDE\n\n"); printf(" neq = %d, ml = %d, mu = %d\n", P2_NEQ, P2_ML, P2_MU); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" itol = %s, reltol = %.2Lg, abstol = %.2Lg", "CV_SS", RTOL, ATOL); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" itol = %s, reltol = %.2lg, abstol = %.2lg", "CV_SS", RTOL, ATOL); #else printf(" itol = %s, reltol = %.2g, abstol = %.2g", "CV_SS", RTOL, ATOL); #endif printf("\n t max.err qu hu \n"); } static void PrintHeader2(void) { printf("\n t max.err qu hu \n"); return; } static void PrintOutput2(realtype t, realtype erm, int qu, realtype hu) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%10.3Lf %12.4Le %2d %12.4Le\n", t, erm, qu, hu); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%10.3f %12.4le %2d %12.4le\n", t, erm, qu, hu); #else printf("%10.3f %12.4e %2d %12.4e\n", t, erm, qu, hu); #endif return; } static int f2(realtype t, N_Vector y, N_Vector ydot, void *user_data) { long int i, j, k; realtype d, *ydata, *dydata; ydata = NV_DATA_S(y); dydata = NV_DATA_S(ydot); /* Excluding boundaries, ydot = f = -2 y + alpha1 * y + alpha2 * y i,j i,j i,j i-1,j i,j-1 */ for (j=0; j < P2_MESHY; j++) { for (i=0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; d = -TWO*ydata[k]; if (i != 0) d += P2_ALPH1 * ydata[k-1]; if (j != 0) d += P2_ALPH2 * ydata[k-P2_MESHX]; dydata[k] = d; } } return(0); } static int Jac2(long int N, long int mu, long int ml, realtype tn, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol; /* The components of f(t,y) which depend on y are i,j f , f , and f : i,j i+1,j i,j+1 f = -2 y + alpha1 * y + alpha2 * y i,j i,j i-1,j i,j-1 f = -2 y + alpha1 * y + alpha2 * y i+1,j i+1,j i,j i+1,j-1 f = -2 y + alpha1 * y + alpha2 * y i,j+1 i,j+1 i-1,j+1 i,j */ for (j=0; j < P2_MESHY; j++) { for (i=0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; kthCol = BAND_COL(J,k); BAND_COL_ELEM(kthCol,k,k) = -TWO; if (i != P2_MESHX-1) BAND_COL_ELEM(kthCol,k+1,k) = P2_ALPH1; if (j != P2_MESHY-1) BAND_COL_ELEM(kthCol,k+P2_MESHX,k) = P2_ALPH2; } } return(0); } static realtype MaxError(N_Vector y, realtype t) { long int i, j, k; realtype *ydata, er, ex=ZERO, yt, maxError=ZERO, ifact_inv, jfact_inv=ONE; if (t == ZERO) return(ZERO); ydata = NV_DATA_S(y); if (t <= THIRTY) ex = EXP(-TWO*t); for (j = 0; j < P2_MESHY; j++) { ifact_inv = ONE; for (i = 0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; yt = RPowerI(t,i+j) * ex * ifact_inv * jfact_inv; er = ABS(ydata[k] - yt); if (er > maxError) maxError = er; ifact_inv /= (i+1); } jfact_inv /= (j+1); } return(maxError); } static int PrepareNextRun(void *cvode_mem, int lmm, int miter, long int mu, long int ml) { int flag = CV_SUCCESS; printf("\n\n-------------------------------------------------------------"); printf("\n\nLinear Multistep Method : "); if (lmm == CV_ADAMS) { printf("ADAMS\n"); } else { printf("BDF\n"); } printf("Iteration : "); if (miter == FUNC) { printf("FUNCTIONAL\n"); } else { printf("NEWTON\n"); printf("Linear Solver : "); switch(miter) { case DENSE_USER : printf("Dense, User-Supplied Jacobian\n"); flag = CVDense(cvode_mem, P1_NEQ); check_flag(&flag, "CVDense", 1); if(flag != CV_SUCCESS) break; flag = CVDlsSetDenseJacFn(cvode_mem, Jac1); check_flag(&flag, "CVDlsSetDenseJacFn", 1); break; case DENSE_DQ : printf("Dense, Difference Quotient Jacobian\n"); flag = CVDlsSetDenseJacFn(cvode_mem, NULL); check_flag(&flag, "CVDlsSetDenseJacFn", 1); break; case DIAG : printf("Diagonal Jacobian\n"); flag = CVDiag(cvode_mem); check_flag(&flag, "CVDiag", 1); break; case BAND_USER : printf("Band, User-Supplied Jacobian\n"); flag = CVBand(cvode_mem, P2_NEQ, mu, ml); check_flag(&flag, "CVBand", 1); if(flag != CV_SUCCESS) break; flag = CVDlsSetBandJacFn(cvode_mem, Jac2); check_flag(&flag, "CVDlsSetBandJacFn", 1); break; case BAND_DQ : printf("Band, Difference Quotient Jacobian\n"); flag = CVDlsSetBandJacFn(cvode_mem, NULL); check_flag(&flag, "CVDlsSetBandJacFn", 1); break; } } return(flag); } static void PrintErrOutput(realtype tol_factor) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("\n\n Error exceeds %Lg * tolerance \n\n", tol_factor); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("\n\n Error exceeds %lg * tolerance \n\n", tol_factor); #else printf("\n\n Error exceeds %g * tolerance \n\n", tol_factor); #endif return; } static void PrintFinalStats(void *cvode_mem, int miter, realtype ero) { long int lenrw, leniw, nst, nfe, nsetups, nni, ncfn, netf; long int lenrwLS, leniwLS, nje, nfeLS; int flag; flag = CVodeGetWorkSpace(cvode_mem, &lenrw, &leniw); check_flag(&flag, "CVodeGetWorkSpace", 1); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); printf("\n Final statistics for this run:\n\n"); printf(" CVode real workspace length = %4ld \n", lenrw); printf(" CVode integer workspace length = %4ld \n", leniw); printf(" Number of steps = %4ld \n", nst); printf(" Number of f-s = %4ld \n", nfe); printf(" Number of setups = %4ld \n", nsetups); printf(" Number of nonlinear iterations = %4ld \n", nni); printf(" Number of nonlinear convergence failures = %4ld \n", ncfn); printf(" Number of error test failures = %4ld \n\n",netf); if (miter != FUNC) { switch(miter) { case DENSE_USER : case DENSE_DQ : flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVDlsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDlsGetWorkSpace", 1); break; case BAND_USER : case BAND_DQ : flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVDlsGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDlsGetWorkSpace", 1); break; case DIAG : nje = nsetups; flag = CVDiagGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDiagGetNumRhsEvals", 1); flag = CVDiagGetWorkSpace(cvode_mem, &lenrwLS, &leniwLS); check_flag(&flag, "CVDiagGetWorkSpace", 1); break; } printf(" Linear solver real workspace length = %4ld \n", lenrwLS); printf(" Linear solver integer workspace length = %4ld \n", leniwLS); printf(" Number of Jacobian evaluations = %4ld \n", nje); printf(" Number of f evals. in linear solver = %4ld \n\n", nfeLS); } #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" Error overrun = %.3Lf \n", ero); #else printf(" Error overrun = %.3f \n", ero); #endif } static void PrintErrInfo(int nerr) { printf("\n\n-------------------------------------------------------------"); printf("\n-------------------------------------------------------------"); printf("\n\n Number of errors encountered = %d \n", nerr); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsKrylovDemo_ls.out0000600000175000017500000002116111741421151024626 0ustar sylvestresylvestre ------- | SPGMR | ------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 3.87e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 343 order = 3 stepsize = 2.34e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 421 order = 4 stepsize = 5.26e+02 c1 (bot.left/middle/top rt.) = -4.385e-06 -1.528e-06 -4.905e-06 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 445 order = 3 stepsize = 1.98e+02 c1 (bot.left/middle/top rt.) = 4.461e-07 1.869e-07 4.842e-07 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 462 order = 5 stepsize = 2.35e+02 c1 (bot.left/middle/top rt.) = 3.204e-09 1.203e-09 3.555e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 474 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -1.066e-09 -3.409e-10 -1.206e-09 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 486 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 2.614e-09 9.722e-10 2.904e-09 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 498 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 4.649e-11 1.729e-11 5.161e-11 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 510 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -8.856e-14 -3.348e-14 -9.785e-14 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwLS = 2046 leniwLS = 10 nst = 510 nfe = 675 nfeLS = 641 nni = 671 nli = 641 nsetups = 94 netf = 36 npe = 9 nps = 1243 ncfn = 0 ncfl = 0 ====================================================================== ------- | SPBCG | ------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 190 order = 5 stepsize = 1.58e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 222 order = 5 stepsize = 3.81e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 246 order = 5 stepsize = 4.34e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 282 order = 4 stepsize = 1.71e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 317 order = 5 stepsize = 9.48e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 369 order = 4 stepsize = 5.46e+02 c1 (bot.left/middle/top rt.) = -1.286e-09 -1.138e-09 -1.297e-09 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 385 order = 4 stepsize = 3.54e+02 c1 (bot.left/middle/top rt.) = 3.396e-14 2.448e-11 -2.220e-14 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 399 order = 5 stepsize = 3.72e+02 c1 (bot.left/middle/top rt.) = 1.607e-14 -1.589e-11 2.156e-13 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 410 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -3.759e-13 -7.684e-12 -3.258e-13 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 421 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -9.205e-14 -1.287e-11 2.328e-13 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 433 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = -3.952e-21 9.479e-19 -3.924e-20 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 444 order = 5 stepsize = 6.46e+02 c1 (bot.left/middle/top rt.) = 1.131e-26 -2.041e-22 -7.893e-29 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwLS = 1800 leniwLS = 9 nst = 444 nfe = 573 nfeLS = 968 nni = 569 nli = 484 nsetups = 76 netf = 27 npe = 8 nps = 1457 ncfn = 0 ncfl = 0 ====================================================================== --------- | SPTFQMR | --------- 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 218 order = 5 stepsize = 1.44e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 250 order = 5 stepsize = 3.27e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 275 order = 5 stepsize = 3.49e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 309 order = 4 stepsize = 1.92e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 337 order = 5 stepsize = 1.24e+02 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 388 order = 4 stepsize = 5.10e+02 c1 (bot.left/middle/top rt.) = 9.865e-08 1.252e-05 1.407e-07 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 405 order = 4 stepsize = 2.84e+02 c1 (bot.left/middle/top rt.) = -1.668e-09 5.311e-07 -6.632e-09 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 419 order = 5 stepsize = 5.07e+02 c1 (bot.left/middle/top rt.) = -1.792e-09 6.186e-07 -7.318e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 431 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 1.682e-11 -9.299e-09 8.107e-11 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 441 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 1.919e-15 -3.196e-13 6.625e-15 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 450 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = 2.380e-19 -4.543e-16 1.071e-18 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 459 order = 5 stepsize = 7.73e+02 c1 (bot.left/middle/top rt.) = -8.763e-21 5.632e-16 -4.431e-21 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwLS = 2200 leniwLS = 11 nst = 459 nfe = 582 nfeLS = 1248 nni = 578 nli = 520 nsetups = 71 netf = 23 npe = 8 nps = 1910 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_FSA_dns.out0000600000175000017500000001227411741421151025017 0ustar sylvestresylvestre 3-species chemical kinetics problem Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) ======================================================================= T Q H NST y1 y2 y3 ======================================================================= 4.000e-01 3 4.881e-02 115 Solution 9.8517e-01 3.3864e-05 1.4794e-02 Sensitivity 1 -3.5595e-01 3.9025e-04 3.5556e-01 Sensitivity 2 9.5431e-08 -2.1309e-10 -9.5218e-08 Sensitivity 3 -1.5833e-11 -5.2900e-13 1.6362e-11 ----------------------------------------------------------------------- 4.000e+00 5 2.363e-01 138 Solution 9.0552e-01 2.2405e-05 9.4459e-02 Sensitivity 1 -1.8761e+00 1.7922e-04 1.8759e+00 Sensitivity 2 2.9614e-06 -5.8305e-10 -2.9608e-06 Sensitivity 3 -4.9334e-10 -2.7626e-13 4.9362e-10 ----------------------------------------------------------------------- 4.000e+01 3 1.485e+00 219 Solution 7.1583e-01 9.1856e-06 2.8416e-01 Sensitivity 1 -4.2475e+00 4.5913e-05 4.2475e+00 Sensitivity 2 1.3731e-05 -2.3573e-10 -1.3730e-05 Sensitivity 3 -2.2883e-09 -1.1380e-13 2.2884e-09 ----------------------------------------------------------------------- 4.000e+02 3 8.882e+00 331 Solution 4.5052e-01 3.2229e-06 5.4947e-01 Sensitivity 1 -5.9584e+00 3.5431e-06 5.9584e+00 Sensitivity 2 2.2738e-05 -2.2605e-11 -2.2738e-05 Sensitivity 3 -3.7896e-09 -4.9948e-14 3.7897e-09 ----------------------------------------------------------------------- 4.000e+03 2 1.090e+02 486 Solution 1.8317e-01 8.9403e-07 8.1683e-01 Sensitivity 1 -4.7500e+00 -5.9957e-06 4.7500e+00 Sensitivity 2 1.8809e-05 2.3136e-11 -1.8809e-05 Sensitivity 3 -3.1348e-09 -1.8757e-14 3.1348e-09 ----------------------------------------------------------------------- 4.000e+04 3 1.178e+03 588 Solution 3.8977e-02 1.6215e-07 9.6102e-01 Sensitivity 1 -1.5748e+00 -2.7620e-06 1.5748e+00 Sensitivity 2 6.2869e-06 1.1002e-11 -6.2869e-06 Sensitivity 3 -1.0478e-09 -4.5362e-15 1.0478e-09 ----------------------------------------------------------------------- 4.000e+05 3 1.514e+04 645 Solution 4.9387e-03 1.9852e-08 9.9506e-01 Sensitivity 1 -2.3639e-01 -4.5861e-07 2.3639e-01 Sensitivity 2 9.4525e-07 1.8334e-12 -9.4525e-07 Sensitivity 3 -1.5751e-10 -6.3629e-16 1.5751e-10 ----------------------------------------------------------------------- 4.000e+06 4 2.323e+05 696 Solution 5.1684e-04 2.0684e-09 9.9948e-01 Sensitivity 1 -2.5667e-02 -5.1064e-08 2.5667e-02 Sensitivity 2 1.0266e-07 2.0424e-13 -1.0266e-07 Sensitivity 3 -1.7111e-11 -6.8513e-17 1.7111e-11 ----------------------------------------------------------------------- 4.000e+07 4 1.776e+06 753 Solution 5.2039e-05 2.0817e-10 9.9995e-01 Sensitivity 1 -2.5991e-03 -5.1931e-09 2.5991e-03 Sensitivity 2 1.0396e-08 2.0772e-14 -1.0397e-08 Sensitivity 3 -1.7330e-12 -6.9328e-18 1.7330e-12 ----------------------------------------------------------------------- 4.000e+08 4 2.766e+07 802 Solution 5.2106e-06 2.0842e-11 9.9999e-01 Sensitivity 1 -2.6063e-04 -5.2149e-10 2.6063e-04 Sensitivity 2 1.0425e-09 2.0859e-15 -1.0425e-09 Sensitivity 3 -1.7366e-13 -6.9467e-19 1.7367e-13 ----------------------------------------------------------------------- 4.000e+09 2 4.183e+08 836 Solution 5.1881e-07 2.0752e-12 1.0000e-00 Sensitivity 1 -2.5907e-05 -5.1717e-11 2.5907e-05 Sensitivity 2 1.0363e-10 2.0687e-16 -1.0363e-10 Sensitivity 3 -1.7293e-14 -6.9174e-20 1.7293e-14 ----------------------------------------------------------------------- 4.000e+10 2 3.799e+09 859 Solution 6.5181e-08 2.6072e-13 1.0000e-00 Sensitivity 1 -2.4884e-06 -3.3032e-12 2.4884e-06 Sensitivity 2 9.9534e-12 1.3213e-17 -9.9534e-12 Sensitivity 3 -2.1727e-15 -8.6908e-21 2.1727e-15 ----------------------------------------------------------------------- Final Statistics nst = 859 nfe = 1222 netf = 29 nsetups = 142 nni = 1218 ncfn = 4 nfSe = 3666 nfeS = 0 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 nje = 24 nfeLS = 0 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dns_uw.out0000600000175000017500000000233611741421151025037 0ustar sylvestresylvestre 3-species kinetics problem At t = 2.6391e-01 y = 9.899653e-01 3.470564e-05 1.000000e-02 rootsfound[] = 0 1 At t = 4.0000e-01 y = 9.851641e-01 3.386242e-05 1.480205e-02 At t = 4.0000e+00 y = 9.055097e-01 2.240338e-05 9.446793e-02 At t = 4.0000e+01 y = 7.158010e-01 9.185084e-06 2.841898e-01 At t = 4.0000e+02 y = 4.504693e-01 3.222627e-06 5.495274e-01 At t = 4.0000e+03 y = 1.832126e-01 8.943459e-07 8.167865e-01 At t = 4.0000e+04 y = 3.897840e-02 1.621553e-07 9.610214e-01 At t = 4.0000e+05 y = 4.941626e-03 1.986351e-08 9.950584e-01 At t = 4.0000e+06 y = 5.162295e-04 2.065971e-09 9.994838e-01 At t = 2.0789e+07 y = 1.000000e-04 4.000395e-10 9.999000e-01 rootsfound[] = -1 0 At t = 4.0000e+07 y = 5.201354e-05 2.080648e-10 9.999480e-01 At t = 4.0000e+08 y = 5.215272e-06 2.086119e-11 9.999948e-01 At t = 4.0000e+09 y = 5.213021e-07 2.085210e-12 9.999995e-01 At t = 4.0000e+10 y = 4.958738e-08 1.983495e-13 1.000000e-00 Final Statistics: nst = 534 nfe = 796 nsetups = 127 nfeLS = 0 nje = 12 nni = 792 ncfn = 0 netf = 35 nge = 564 sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_kry.out0000600000175000017500000000545411741421151024327 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem t = 7.20e+03 no. steps = 219 order = 5 stepsize = 1.59e+02 c1 (bot.left/middle/top rt.) = 1.047e+04 2.964e+04 1.119e+04 c2 (bot.left/middle/top rt.) = 2.527e+11 7.154e+11 2.700e+11 t = 1.44e+04 no. steps = 251 order = 5 stepsize = 3.77e+02 c1 (bot.left/middle/top rt.) = 6.659e+06 5.316e+06 7.301e+06 c2 (bot.left/middle/top rt.) = 2.582e+11 2.057e+11 2.833e+11 t = 2.16e+04 no. steps = 277 order = 5 stepsize = 2.75e+02 c1 (bot.left/middle/top rt.) = 2.665e+07 1.036e+07 2.931e+07 c2 (bot.left/middle/top rt.) = 2.993e+11 1.028e+11 3.313e+11 t = 2.88e+04 no. steps = 301 order = 5 stepsize = 3.87e+02 c1 (bot.left/middle/top rt.) = 8.702e+06 1.292e+07 9.650e+06 c2 (bot.left/middle/top rt.) = 3.380e+11 5.029e+11 3.751e+11 t = 3.60e+04 no. steps = 343 order = 3 stepsize = 2.34e+01 c1 (bot.left/middle/top rt.) = 1.404e+04 2.029e+04 1.561e+04 c2 (bot.left/middle/top rt.) = 3.387e+11 4.894e+11 3.765e+11 t = 4.32e+04 no. steps = 421 order = 4 stepsize = 5.26e+02 c1 (bot.left/middle/top rt.) = -4.385e-06 -1.528e-06 -4.905e-06 c2 (bot.left/middle/top rt.) = 3.382e+11 1.355e+11 3.804e+11 t = 5.04e+04 no. steps = 445 order = 3 stepsize = 1.98e+02 c1 (bot.left/middle/top rt.) = 4.461e-07 1.869e-07 4.842e-07 c2 (bot.left/middle/top rt.) = 3.358e+11 4.930e+11 3.864e+11 t = 5.76e+04 no. steps = 462 order = 5 stepsize = 2.35e+02 c1 (bot.left/middle/top rt.) = 3.204e-09 1.203e-09 3.555e-09 c2 (bot.left/middle/top rt.) = 3.320e+11 9.650e+11 3.909e+11 t = 6.48e+04 no. steps = 474 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -1.066e-09 -3.409e-10 -1.206e-09 c2 (bot.left/middle/top rt.) = 3.313e+11 8.922e+11 3.963e+11 t = 7.20e+04 no. steps = 486 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 2.614e-09 9.722e-10 2.904e-09 c2 (bot.left/middle/top rt.) = 3.330e+11 6.186e+11 4.039e+11 t = 7.92e+04 no. steps = 498 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = 4.649e-11 1.729e-11 5.161e-11 c2 (bot.left/middle/top rt.) = 3.334e+11 6.669e+11 4.120e+11 t = 8.64e+04 no. steps = 510 order = 5 stepsize = 6.02e+02 c1 (bot.left/middle/top rt.) = -8.856e-14 -3.348e-14 -9.785e-14 c2 (bot.left/middle/top rt.) = 3.352e+11 9.107e+11 4.163e+11 Final Statistics.. lenrw = 2096 leniw = 62 lenrwLS = 2046 leniwLS = 10 nst = 510 nfe = 675 nfeLS = 641 nni = 671 nli = 641 nsetups = 94 netf = 36 npe = 9 nps = 1243 ncfn = 0 ncfl = 0 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_FSA_dns.c0000600000175000017500000004370211741421151024432 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:58:00 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODES. The problem is from chemical * kinetics, and consists of the following three rate equations: * dy1/dt = -p1*y1 + p2*y2*y3 * dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2 * dy3/dt = p3*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions y1 = 1.0, y2 = y3 = 0. The reaction rates are: p1=0.04, * p2=1e4, and p3=3e7. The problem is stiff. * This program solves the problem with the BDF method, Newton * iteration with the CVODES dense linear solver, and a * user-supplied Jacobian routine. * It uses a scalar relative tolerance and a vector absolute * tolerance. * Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * * Optionally, CVODES can compute sensitivities with respect to the * problem parameters p1, p2, and p3. * The sensitivity right hand side is given analytically through the * user routine fS (of type SensRhs1Fn). * Any of three sensitivity methods (SIMULTANEOUS, STAGGERED, and * STAGGERED1) can be used and sensitivities may be included in the * error test or not (error control set on TRUE or FALSE, * respectively). * * Execution: * * If no sensitivities are desired: * % cvsRoberts_FSA_dns -nosensi * If sensitivities are to be computed: * % cvsRoberts_FSA_dns -sensi sensi_meth err_con * where sensi_meth is one of {sim, stg, stg1} and err_con is one of * {t, f}. * ----------------------------------------------------------------- */ #include #include #include #include /* prototypes for CVODES fcts. and consts. */ #include /* prototype for CVDENSE fcts. and constants */ #include /* defs. of serial NVECTOR fcts. and macros */ #include /* def. of type realtype */ #include /* definition of ABS */ /* Accessor macros */ #define Ith(v,i) NV_Ith_S(v,i-1) /* i-th vector component i=1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* (i,j)-th matrix component i,j=1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1e-14) #define ATOL3 RCONST(1e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ #define NP 3 /* number of problem parameters */ #define NS 3 /* number of sensitivities computed */ #define ZERO RCONST(0.0) /* Type : UserData */ typedef struct { realtype p[3]; /* problem parameters */ } *UserData; /* Prototypes of functions by CVODES */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int fS(int Ns, realtype t, N_Vector y, N_Vector ydot, int iS, N_Vector yS, N_Vector ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); static int ewt(N_Vector y, N_Vector w, void *user_data); /* Prototypes of private functions */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con); static void WrongArgs(char *name); static void PrintOutput(void *cvode_mem, realtype t, N_Vector u); static void PrintOutputS(N_Vector *uS); static void PrintFinalStats(void *cvode_mem, booleantype sensi); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { void *cvode_mem; UserData data; realtype t, tout; N_Vector y; int iout, flag; realtype pbar[NS]; int is; N_Vector *yS; booleantype sensi, err_con; int sensi_meth; cvode_mem = NULL; data = NULL; y = NULL; yS = NULL; /* Process arguments */ ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con); /* User data structure */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2)) return(1); data->p[0] = RCONST(0.04); data->p[1] = RCONST(1.0e4); data->p[2] = RCONST(3.0e7); /* Initial conditions */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Create CVODES object */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Allocate space for CVODES */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Use private function to compute error weights */ flag = CVodeWFtolerances(cvode_mem, ewt); if (check_flag(&flag, "CVodeSetEwtFn", 1)) return(1); /* Attach user data */ flag = CVodeSetUserData(cvode_mem, data); if (check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Attach linear solver */ flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); printf("\n3-species chemical kinetics problem\n"); /* Sensitivity-related settings */ if (sensi) { pbar[0] = data->p[0]; pbar[1] = data->p[1]; pbar[2] = data->p[2]; yS = N_VCloneVectorArray_Serial(NS, y); if (check_flag((void *)yS, "N_VCloneVectorArray_Serial", 0)) return(1); for (is=0;isp[0]; p2 = data->p[1]; p3 = data->p[2]; yd1 = Ith(ydot,1) = -p1*y1 + p2*y2*y3; yd3 = Ith(ydot,3) = p3*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * Jacobian routine. Compute J(t,y). */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; UserData data; realtype p1, p2, p3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; IJth(J,1,1) = -p1; IJth(J,1,2) = p2*y3; IJth(J,1,3) = p2*y2; IJth(J,2,1) = p1; IJth(J,2,2) = -p2*y3-2*p3*y2; IJth(J,2,3) = -p2*y2; IJth(J,3,2) = 2*p3*y2; return(0); } /* * fS routine. Compute sensitivity r.h.s. */ static int fS(int Ns, realtype t, N_Vector y, N_Vector ydot, int iS, N_Vector yS, N_Vector ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2) { UserData data; realtype p1, p2, p3; realtype y1, y2, y3; realtype s1, s2, s3; realtype sd1, sd2, sd3; data = (UserData) user_data; p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2]; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); s1 = Ith(yS,1); s2 = Ith(yS,2); s3 = Ith(yS,3); sd1 = -p1*s1 + p2*y3*s2 + p2*y2*s3; sd3 = 2*p3*y2*s2; sd2 = -sd1-sd3; switch (iS) { case 0: sd1 += -y1; sd2 += y1; break; case 1: sd1 += y2*y3; sd2 += -y2*y3; break; case 2: sd2 += -y2*y2; sd3 += y2*y2; break; } Ith(ySdot,1) = sd1; Ith(ySdot,2) = sd2; Ith(ySdot,3) = sd3; return(0); } /* * EwtSet function. Computes the error weights at the current solution. */ static int ewt(N_Vector y, N_Vector w, void *user_data) { int i; realtype yy, ww, rtol, atol[3]; rtol = RTOL; atol[0] = ATOL1; atol[1] = ATOL2; atol[2] = ATOL3; for (i=1; i<=3; i++) { yy = Ith(y,i); ww = rtol * ABS(yy) + atol[i-1]; if (ww <= 0.0) return (-1); Ith(w,i) = 1.0/ww; } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Process and verify arguments to cvsfwddenx. */ static void ProcessArgs(int argc, char *argv[], booleantype *sensi, int *sensi_meth, booleantype *err_con) { *sensi = FALSE; *sensi_meth = -1; *err_con = FALSE; if (argc < 2) WrongArgs(argv[0]); if (strcmp(argv[1],"-nosensi") == 0) *sensi = FALSE; else if (strcmp(argv[1],"-sensi") == 0) *sensi = TRUE; else WrongArgs(argv[0]); if (*sensi) { if (argc != 4) WrongArgs(argv[0]); if (strcmp(argv[2],"sim") == 0) *sensi_meth = CV_SIMULTANEOUS; else if (strcmp(argv[2],"stg") == 0) *sensi_meth = CV_STAGGERED; else if (strcmp(argv[2],"stg1") == 0) *sensi_meth = CV_STAGGERED1; else WrongArgs(argv[0]); if (strcmp(argv[3],"t") == 0) *err_con = TRUE; else if (strcmp(argv[3],"f") == 0) *err_con = FALSE; else WrongArgs(argv[0]); } } static void WrongArgs(char *name) { printf("\nUsage: %s [-nosensi] [-sensi sensi_meth err_con]\n",name); printf(" sensi_meth = sim, stg, or stg1\n"); printf(" err_con = t or f\n"); exit(0); } /* * Print current t, step count, order, stepsize, and solution. */ static void PrintOutput(void *cvode_mem, realtype t, N_Vector u) { long int nst; int qu, flag; realtype hu, *udata; udata = NV_DATA_S(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetLastOrder(cvode_mem, &qu); check_flag(&flag, "CVodeGetLastOrder", 1); flag = CVodeGetLastStep(cvode_mem, &hu); check_flag(&flag, "CVodeGetLastStep", 1); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%8.3Le %2d %8.3Le %5ld\n", t, qu, hu, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%8.3le %2d %8.3le %5ld\n", t, qu, hu, nst); #else printf("%8.3e %2d %8.3e %5ld\n", t, qu, hu, nst); #endif printf(" Solution "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", udata[0], udata[1], udata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", udata[0], udata[1], udata[2]); #else printf("%12.4e %12.4e %12.4e \n", udata[0], udata[1], udata[2]); #endif } /* * Print sensitivities. */ static void PrintOutputS(N_Vector *uS) { realtype *sdata; sdata = NV_DATA_S(uS[0]); printf(" Sensitivity 1 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(uS[1]); printf(" Sensitivity 2 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif sdata = NV_DATA_S(uS[2]); printf(" Sensitivity 3 "); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%12.4Le %12.4Le %12.4Le \n", sdata[0], sdata[1], sdata[2]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%12.4le %12.4le %12.4le \n", sdata[0], sdata[1], sdata[2]); #else printf("%12.4e %12.4e %12.4e \n", sdata[0], sdata[1], sdata[2]); #endif } /* * Print some final statistics from the CVODES memory. */ static void PrintFinalStats(void *cvode_mem, booleantype sensi) { long int nst; long int nfe, nsetups, nni, ncfn, netf; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; long int nje, nfeLS; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); if (sensi) { flag = CVodeGetSensNumRhsEvals(cvode_mem, &nfSe); check_flag(&flag, "CVodeGetSensNumRhsEvals", 1); flag = CVodeGetNumRhsEvalsSens(cvode_mem, &nfeS); check_flag(&flag, "CVodeGetNumRhsEvalsSens", 1); flag = CVodeGetSensNumLinSolvSetups(cvode_mem, &nsetupsS); check_flag(&flag, "CVodeGetSensNumLinSolvSetups", 1); flag = CVodeGetSensNumErrTestFails(cvode_mem, &netfS); check_flag(&flag, "CVodeGetSensNumErrTestFails", 1); flag = CVodeGetSensNumNonlinSolvIters(cvode_mem, &nniS); check_flag(&flag, "CVodeGetSensNumNonlinSolvIters", 1); flag = CVodeGetSensNumNonlinSolvConvFails(cvode_mem, &ncfnS); check_flag(&flag, "CVodeGetSensNumNonlinSolvConvFails", 1); } flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); printf("\nFinal Statistics\n\n"); printf("nst = %5ld\n\n", nst); printf("nfe = %5ld\n", nfe); printf("netf = %5ld nsetups = %5ld\n", netf, nsetups); printf("nni = %5ld ncfn = %5ld\n", nni, ncfn); if(sensi) { printf("\n"); printf("nfSe = %5ld nfeS = %5ld\n", nfSe, nfeS); printf("netfs = %5ld nsetupsS = %5ld\n", netfS, nsetupsS); printf("nniS = %5ld ncfnS = %5ld\n", nniS, ncfnS); } printf("\n"); printf("nje = %5ld nfeLS = %5ld\n", nje, nfeLS); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsFoodWeb_ASAi_kry.c0000600000175000017500000011460511741421151024525 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2011/11/23 23:53:02 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * This program solves a stiff ODE system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector * is the following: * * 1 2 ns * c = (c , c , ..., c ) * * and the PDEs are as follows: * * i i i * dc /dt = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c *(b(i) + sum a(i,j)*c ). * i j=1 * * The number of species is ns = 2*np, with the first np being prey * and the last np being predators. The coefficients a(i,j), b(i), * d(i) are: * * a(i,i) = -a (all i) * a(i,j) = -g (i <= np, j > np) * a(i,j) = e (i > np, j <= np) * b(i) = b*(1 + alpha*x*y) (i <= np) * b(i) = -b*(1 + alpha*x*y) (i > np) * d(i) = Dprey (i <= np) * d(i) = Dpred (i > np) * * The spatial domain is the unit square. The final time is 10. * The boundary conditions are: normal derivative = 0. * A polynomial in x and y is used to set the initial conditions. * * The PDEs are discretized by central differencing on an MX by MY * mesh. The resulting ODE system is stiff. * * The ODE system is solved by CVODES using Newton iteration and * the CVSPGMR linear solver (scaled preconditioned GMRES). * * The preconditioner matrix used is the product of two matrices: * (1) A matrix, only defined implicitly, based on a fixed number * of Gauss-Seidel iterations using the diffusion terms only. * (2) A block-diagonal matrix based on the partial derivatives of * the interaction terms f only, using block-grouping (computing * only a subset of the ns by ns blocks). * * Additionally, CVODES integrates backwards in time the * the semi-discrete form of the adjoint PDE: * d(lambda)/dt = - D^T ( lambda_xx + lambda_yy ) * - F_c^T lambda - g_c^T * with homogeneous Neumann boundary conditions and final * conditions are the following: * lambda(x,y,t=t_final) = 0.0 * whose solution at t = 0 represents the sensitivity of * G = int_0^t_final int_x int _y g(t,c) dx dy dt * with respect to the initial conditions of the original problem. * * In this example, * g(t,c) = c(ISPEC), with ISPEC defined below. * * During the forward run, CVODES also computes G as * G = phi(t_final) * where * d(phi)/dt = int_x int _y g(t,c) dx dy * and the 2-D integral is evaluated with Simpson's rule. * ----------------------------------------------------------------- * Reference: Peter N. Brown and Alan C. Hindmarsh, Reduced Storage * Matrix Methods in Stiff ODE Systems, J. Appl. Math. & Comp., 31 * (1989), pp. 40-91. Also available as Lawrence Livermore National * Laboratory Report UCRL-95088, Rev. 1, June 1987. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Problem Specification Constants */ #define AA ONE /* AA = a */ #define EE RCONST(1e4) /* EE = e */ #define GG RCONST(0.5e-6) /* GG = g */ #define BB ONE /* BB = b */ #define DPREY ONE #define DPRED RCONST(0.5) #define ALPH ONE #define NP 3 #define NS (2*NP) /* Method Constants */ #define MX 20 #define MY 20 #define MXNS (MX*NS) #define AX ONE #define AY ONE #define DX (AX/(realtype)(MX-1)) #define DY (AY/(realtype)(MY-1)) #define MP NS #define MQ (MX*MY) #define MXMP (MX*MP) #define NGX 2 #define NGY 2 #define NGRP (NGX*NGY) #define ITMAX 5 /* CVodeInit Constants */ #define NEQ (NS*MX*MY) #define T0 RCONST(0.0) #define RTOL RCONST(1e-5) #define ATOL RCONST(1e-5) /* Output Constants */ #define TOUT RCONST(10.0) /* Note: The value for species i at mesh point (j,k) is stored in */ /* component number (i-1) + j*NS + k*NS*MX of an N_Vector, */ /* where 1 <= i <= NS, 0 <= j < MX, 0 <= k < MY. */ /* Structure for user data */ typedef struct { realtype **P[NGRP]; long int *pivot[NGRP]; int ns, mxns, mp, mq, mx, my, ngrp, ngx, ngy, mxmp; int jgx[NGX+1], jgy[NGY+1], jigx[MX], jigy[MY]; int jxr[NGX], jyr[NGY]; realtype acoef[NS][NS], bcoef[NS], diff[NS]; realtype cox[NS], coy[NS], dx, dy, srur; realtype fsave[NEQ]; realtype fBsave[NEQ]; N_Vector rewt; void *cvode_mem; int indexB; } *WebData; /* Adjoint calculation constants */ /* G = int_t int_x int_y c(ISPEC) dy dx dt */ #define NSTEPS 300 /* check points every NSTEPS steps */ #define ISPEC 6 /* species # in objective */ /* Prototypes for user-supplied functions */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolve(realtype t, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); static int fB(realtype t, N_Vector c, N_Vector cB, N_Vector cBdot, void *user_data); static int PrecondB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int PSolveB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp); /* Prototypes for private functions */ static WebData AllocUserData(void); static void InitUserData(WebData wdata); static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]); static void CInit(N_Vector c, WebData wdata); static void PrintOutput(N_Vector c, int ns, int mxns, WebData wdata); static void FreeUserData(WebData wdata); static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata); static void WebRatesB(realtype x, realtype y, realtype t, realtype c[], realtype cB[], realtype rate[], realtype rateB[], WebData wdata); static void fblock (realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata); static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata); static realtype doubleIntgr(N_Vector c, int i, WebData wdata); static int check_flag(void *flagvalue, char *funcname, int opt); /* Small Vector Kernels */ static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n); static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n); static void v_prod(realtype u[], realtype v[], realtype w[], int n); static void v_zero(realtype u[], int n); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { realtype abstol=ATOL, reltol=RTOL, t; N_Vector c; WebData wdata; void *cvode_mem; int flag, ncheck; int indexB; realtype reltolB=RTOL, abstolB=ATOL; N_Vector cB; c = NULL; cB = NULL; wdata = NULL; cvode_mem = NULL; /* Allocate and initialize user data */ wdata = AllocUserData(); if(check_flag((void *)wdata, "AllocUserData", 2)) return(1); InitUserData(wdata); /* Set-up forward problem */ /* Initializations */ c = N_VNew_Serial(NEQ+1); if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1); CInit(c, wdata); /* Call CVodeCreate/CVodeInit for forward run */ printf("\nCreate and allocate CVODE memory for forward run\n"); cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); wdata->cvode_mem = cvode_mem; /* Used in Precond */ flag = CVodeSetUserData(cvode_mem, wdata); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); flag = CVodeInit(cvode_mem, f, T0, c); if(check_flag(&flag, "CVodeInit", 1)) return(1); flag = CVodeSStolerances(cvode_mem, reltol, abstol); if(check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Call CVSpgmr for forward run */ flag = CVSpgmr(cvode_mem, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmr", 1)) return(1); flag = CVSpilsSetPreconditioner(cvode_mem, Precond, PSolve); if(check_flag(&flag, "CVSpilsSetPreconditioner", 1)) return(1); /* Set-up adjoint calculations */ printf("\nAllocate global memory\n"); flag = CVodeAdjInit(cvode_mem, NSTEPS, CV_HERMITE); if(check_flag(&flag, "CVadjInit", 1)) return(1); /* Perform forward run */ printf("\nForward integration\n"); flag = CVodeF(cvode_mem, TOUT, c, &t, CV_NORMAL, &ncheck); if(check_flag(&flag, "CVodeF", 1)) return(1); printf("\nncheck = %d\n", ncheck); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("\n G = int_t int_x int_y c%d(t,x,y) dx dy dt = %Lf \n\n", ISPEC, NV_DATA_S(c)[NEQ]); #else printf("\n G = int_t int_x int_y c%d(t,x,y) dx dy dt = %f \n\n", ISPEC, NV_DATA_S(c)[NEQ]); #endif /* Set-up backward problem */ /* Allocate cB */ cB = N_VNew_Serial(NEQ); if(check_flag((void *)cB, "N_VNew_Serial", 0)) return(1); /* Initialize cB = 0 */ N_VConst(ZERO, cB); /* Create and allocate CVODES memory for backward run */ printf("\nCreate and allocate CVODES memory for backward run\n"); flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB); if(check_flag(&flag, "CVodeCreateB", 1)) return(1); flag = CVodeSetUserDataB(cvode_mem, indexB, wdata); if(check_flag(&flag, "CVodeSetUserDataB", 1)) return(1); flag = CVodeSetMaxNumStepsB(cvode_mem, indexB, 1000); if(check_flag(&flag, "CVodeSetMaxNumStepsB", 1)) return(1); flag = CVodeInitB(cvode_mem, indexB, fB, TOUT, cB); if(check_flag(&flag, "CVodeInitB", 1)) return(1); flag = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB); if(check_flag(&flag, "CVodeSStolerancesB", 1)) return(1); wdata->indexB = indexB; /* Call CVSpgmr */ flag = CVSpgmrB(cvode_mem, indexB, PREC_LEFT, 0); if(check_flag(&flag, "CVSpgmrB", 1)) return(1); flag = CVSpilsSetPreconditionerB(cvode_mem, indexB, PrecondB, PSolveB); if(check_flag(&flag, "CVSpilsSetPreconditionerB", 1)) return(1); /* Perform backward integration */ printf("\nBackward integration\n"); flag = CVodeB(cvode_mem, T0, CV_NORMAL); if(check_flag(&flag, "CVodeB", 1)) return(1); flag = CVodeGetB(cvode_mem, indexB, &t, cB); if(check_flag(&flag, "CVodeGetB", 1)) return(1); PrintOutput(cB, NS, MXNS, wdata); /* Free all memory */ CVodeFree(&cvode_mem); N_VDestroy_Serial(c); N_VDestroy_Serial(cB); FreeUserData(wdata); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ /* * This routine computes the right-hand side of the ODE system and * returns it in cdot. The interaction rates are computed by calls to WebRates, * and these are saved in fsave for use in preconditioning. */ static int f(realtype t, N_Vector c, N_Vector cdot, void *user_data) { int i, ic, ici, idxl, idxu, idyl, idyu, iyoff, jx, jy, ns, mxns; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, dx, dy; realtype *cdata, *cdotdata; WebData wdata; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cdotdata = NV_DATA_S(cdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRates(x, y, t, cdata+ic, fsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cdata[ici] - cdata[ici-idyl]; dcyui = cdata[ici+idyu] - cdata[ici]; /* Do differencing in x. */ dcxli = cdata[ici] - cdata[ici-idxl]; dcxui = cdata[ici+idxu] - cdata[ici]; /* Collect terms and load cdot elements. */ cdotdata[ici] = coy[i-1]*(dcyui - dcyli) + cox[i-1]*(dcxui - dcxli) + fsave[ici]; } } } /* Quadrature equation (species 1) */ cdotdata[NEQ] = doubleIntgr(c,ISPEC,wdata); return(0); } /* * This routine generates the block-diagonal part of the Jacobian * corresponding to the interaction rates, multiplies by -gamma, adds * the identity matrix, and calls denseGETRF to do the LU decomposition of * each diagonal block. The computation of the diagonal blocks uses * the preset block and grouping information. One block per group is * computed. The Jacobian elements are generated by difference * quotients using calls to the routine fblock. * * This routine can be regarded as a prototype for the general case * of a block-diagonal preconditioner. The blocks are of size mp, and * there are ngrp=ngx*ngy blocks computed in the block-grouping scheme. */ static int Precond(realtype t, N_Vector c, N_Vector fc, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int N; realtype ***P; long int **pivot, ier; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag; long int mp; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; void *cvode_mem; WebData wdata; N_Vector rewt; wdata = (WebData) user_data; cvode_mem = wdata->cvode_mem; rewt = wdata->rewt; flag = CVodeGetErrWeights(cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); cdata = NV_DATA_S(c); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fc, rewt); N = NEQ+1; r0 = RCONST(1000.0)*ABS(gamma)*uround*N*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = -gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][j][i] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* * This routine applies two inverse preconditioner matrices * to the vector r, using the interaction-only block-diagonal Jacobian * with block-grouping, denoted Jr, and Gauss-Seidel applied to the * diffusion contribution to the Jacobian, denoted Jd. * It first calls GSIter for a Gauss-Seidel approximation to * ((I - gamma*Jd)-inverse)*r, and stores the result in z. * Then it computes ((I - gamma*Jr)-inverse)*z, using LU factors of the * blocks in P, and pivot information in pivot, and returns the result in z. */ static int PSolve(realtype t, N_Vector c, N_Vector fc, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx; long int mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations */ GSIter(gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } /* Solve for the quadrature variable */ NV_DATA_S(z)[NEQ] = NV_DATA_S(r)[NEQ] + gamma*doubleIntgr(z,ISPEC,wdata); return(0); } /* * This routine computes the right-hand side of the adjoint ODE system and * returns it in cBdot. The interaction rates are computed by calls to WebRates, * and these are saved in fsave for use in preconditioning. The adjoint * interaction rates are computed by calls to WebRatesB. */ static int fB(realtype t, N_Vector c, N_Vector cB, N_Vector cBdot, void *user_data) { int i, ic, ici, idxl, idxu, idyl, idyu, iyoff, jx, jy, ns, mxns; realtype dcxli, dcxui, dcyli, dcyui, x, y, *cox, *coy, *fsave, *fBsave, dx, dy; realtype *cdata, *cBdata, *cBdotdata; WebData wdata; realtype gu[NS]; wdata = (WebData) user_data; cdata = NV_DATA_S(c); cBdata = NV_DATA_S(cB); cBdotdata = NV_DATA_S(cBdot); mxns = wdata->mxns; ns = wdata->ns; fsave = wdata->fsave; fBsave = wdata->fBsave; cox = wdata->cox; coy = wdata->coy; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; for ( i = 0; i < ns; i++ ) gu[i] = ZERO; gu[ISPEC-1] = ONE; for (jy = 0; jy < MY; jy++) { y = jy*dy; iyoff = mxns*jy; idyu = (jy == MY-1) ? -mxns : mxns; idyl = (jy == 0) ? -mxns : mxns; for (jx = 0; jx < MX; jx++) { x = jx*dx; ic = iyoff + ns*jx; /* Get interaction rates at one point (x,y). */ WebRatesB(x, y, t, cdata+ic, cBdata+ic, fsave+ic, fBsave+ic, wdata); idxu = (jx == MX-1) ? -ns : ns; idxl = (jx == 0) ? -ns : ns; for (i = 1; i <= ns; i++) { ici = ic + i-1; /* Do differencing in y. */ dcyli = cBdata[ici] - cBdata[ici-idyl]; dcyui = cBdata[ici+idyu] - cBdata[ici]; /* Do differencing in x. */ dcxli = cBdata[ici] - cBdata[ici-idxl]; dcxui = cBdata[ici+idxu] - cBdata[ici]; /* Collect terms and load cdot elements. */ cBdotdata[ici] = - coy[i-1]*(dcyui - dcyli) - cox[i-1]*(dcxui - dcxli) - fBsave[ici] - gu[i-1]; } } } return(0); } /* * Preconditioner setup function for the backward problem */ static int PrecondB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { int N; realtype ***P; long int **pivot, ier; int i, if0, if00, ig, igx, igy, j, jj, jx, jy; int *jxr, *jyr, ngrp, ngx, ngy, mxmp, flag; long int mp; realtype uround, fac, r, r0, save, srur; realtype *f1, *fsave, *cdata, *rewtdata; void *cvode_mem; WebData wdata; N_Vector rewt; wdata = (WebData) user_data; cvode_mem = CVodeGetAdjCVodeBmem(wdata->cvode_mem, wdata->indexB); if(check_flag((void *)cvode_mem, "CVadjGetCVodeBmem", 0)) return(1); rewt = wdata->rewt; flag = CVodeGetErrWeights(cvode_mem, rewt); if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1); cdata = NV_DATA_S(c); rewtdata = NV_DATA_S(rewt); uround = UNIT_ROUNDOFF; P = wdata->P; pivot = wdata->pivot; jxr = wdata->jxr; jyr = wdata->jyr; mp = wdata->mp; srur = wdata->srur; ngrp = wdata->ngrp; ngx = wdata->ngx; ngy = wdata->ngy; mxmp = wdata->mxmp; fsave = wdata->fsave; /* Make mp calls to fblock to approximate each diagonal block of Jacobian. Here, fsave contains the base value of the rate vector and r0 is a minimum increment factor for the difference quotient. */ f1 = NV_DATA_S(vtemp1); fac = N_VWrmsNorm (fcB, rewt); N = NEQ; r0 = RCONST(1000.0)*ABS(gamma)*uround*N*fac; if (r0 == ZERO) r0 = ONE; for (igy = 0; igy < ngy; igy++) { jy = jyr[igy]; if00 = jy*mxmp; for (igx = 0; igx < ngx; igx++) { jx = jxr[igx]; if0 = if00 + jx*mp; ig = igx + igy*ngx; /* Generate ig-th diagonal block */ for (j = 0; j < mp; j++) { /* Generate the jth column as a difference quotient */ jj = if0 + j; save = cdata[jj]; r = MAX(srur*ABS(save),r0/rewtdata[jj]); cdata[jj] += r; fac = gamma/r; fblock (t, cdata, jx, jy, f1, wdata); for (i = 0; i < mp; i++) { P[ig][i][j] = (f1[i] - fsave[if0+i])*fac; } cdata[jj] = save; } } } /* Add identity matrix and do LU decompositions on blocks. */ for (ig = 0; ig < ngrp; ig++) { denseAddIdentity(P[ig], mp); ier = denseGETRF(P[ig], mp, mp, pivot[ig]); if (ier != 0) return(1); } *jcurPtr = TRUE; return(0); } /* * Preconditioner solve function for the backward problem */ static int PSolveB(realtype t, N_Vector c, N_Vector cB, N_Vector fcB, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data, N_Vector vtemp) { realtype ***P; long int **pivot; int jx, jy, igx, igy, iv, ig, *jigx, *jigy, mx, my, ngx; long int mp; WebData wdata; wdata = (WebData) user_data; N_VScale(ONE, r, z); /* call GSIter for Gauss-Seidel iterations (same routine but with gamma=-gamma) */ GSIter(-gamma, z, vtemp, wdata); /* Do backsolves for inverse of block-diagonal preconditioner factor */ P = wdata->P; pivot = wdata->pivot; mx = wdata->mx; my = wdata->my; ngx = wdata->ngx; mp = wdata->mp; jigx = wdata->jigx; jigy = wdata->jigy; iv = 0; for (jy = 0; jy < my; jy++) { igy = jigy[jy]; for (jx = 0; jx < mx; jx++) { igx = jigx[jx]; ig = igx + igy*ngx; denseGETRS(P[ig], mp, pivot[ig], &(NV_DATA_S(z)[iv])); iv += mp; } } return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Allocate space for user data structure */ static WebData AllocUserData(void) { int i, ngrp = NGRP, ns = NS; WebData wdata; wdata = (WebData) malloc(sizeof *wdata); for(i=0; i < ngrp; i++) { (wdata->P)[i] = newDenseMat(ns, ns); (wdata->pivot)[i] = newLintArray(ns); } wdata->rewt = N_VNew_Serial(NEQ+1); return(wdata); } /* * Initialize user data structure */ static void InitUserData(WebData wdata) { int i, j, ns; realtype *bcoef, *diff, *cox, *coy, dx, dy; realtype (*acoef)[NS]; acoef = wdata->acoef; bcoef = wdata->bcoef; diff = wdata->diff; cox = wdata->cox; coy = wdata->coy; ns = wdata->ns = NS; for (j = 0; j < NS; j++) { for (i = 0; i < NS; i++) acoef[i][j] = ZERO; } for (j = 0; j < NP; j++) { for (i = 0; i < NP; i++) { acoef[NP+i][j] = EE; acoef[i][NP+j] = -GG; } acoef[j][j] = -AA; acoef[NP+j][NP+j] = -AA; bcoef[j] = BB; bcoef[NP+j] = -BB; diff[j] = DPREY; diff[NP+j] = DPRED; } /* Set remaining problem parameters */ wdata->mxns = MXNS; dx = wdata->dx = DX; dy = wdata->dy = DY; for (i = 0; i < ns; i++) { cox[i] = diff[i]/SQR(dx); coy[i] = diff[i]/SQR(dy); } /* Set remaining method parameters */ wdata->mp = MP; wdata->mq = MQ; wdata->mx = MX; wdata->my = MY; wdata->srur = SQRT(UNIT_ROUNDOFF); wdata->mxmp = MXMP; wdata->ngrp = NGRP; wdata->ngx = NGX; wdata->ngy = NGY; SetGroups(MX, NGX, wdata->jgx, wdata->jigx, wdata->jxr); SetGroups(MY, NGY, wdata->jgy, wdata->jigy, wdata->jyr); } /* * This routine sets arrays jg, jig, and jr describing * a uniform partition of (0,1,2,...,m-1) into ng groups. * The arrays set are: * jg = length ng+1 array of group boundaries. * Group ig has indices j = jg[ig],...,jg[ig+1]-1. * jig = length m array of group indices vs node index. * Node index j is in group jig[j]. * jr = length ng array of indices representing the groups. * The index for group ig is j = jr[ig]. */ static void SetGroups(int m, int ng, int jg[], int jig[], int jr[]) { int ig, j, len1, mper, ngm1; mper = m/ng; /* does integer division */ for (ig=0; ig < ng; ig++) jg[ig] = ig*mper; jg[ng] = m; ngm1 = ng - 1; len1 = ngm1*mper; for (j = 0; j < len1; j++) jig[j] = j/mper; for (j = len1; j < m; j++) jig[j] = ngm1; for (ig = 0; ig < ngm1; ig++) jr[ig] = ((2*ig+1)*mper-1)/2; jr[ngm1] = (ngm1*mper+m-1)/2; } /* * This routine computes and loads the vector of initial values. */ static void CInit(N_Vector c, WebData wdata) { int i, ici, ioff, iyoff, jx, jy, ns, mxns; realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata; cdata = NV_DATA_S(c); ns = wdata->ns; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; x_factor = RCONST(4.0)/SQR(AX); y_factor = RCONST(4.0)/SQR(AY); for (jy = 0; jy < MY; jy++) { y = jy*dy; argy = SQR(y_factor*y*(AY-y)); iyoff = mxns*jy; for (jx = 0; jx < MX; jx++) { x = jx*dx; argx = SQR(x_factor*x*(AX-x)); ioff = iyoff + ns*jx; for (i = 1; i <= ns; i++) { ici = ioff + i-1; cdata[ici] = RCONST(10.0) + i*argx*argy; /*if(i==1) cdata[ici] += ONE;*/ } } } /* Initialize quadrature variable to zero */ cdata[NEQ] = ZERO; } /* * This routine computes the interaction rates for the species * c_1, ... ,c_ns (stored in c[0],...,c[ns-1]), at one spatial point * and at time t. */ static void WebRates(realtype x, realtype y, realtype t, realtype c[], realtype rate[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; for (i = 0; i < ns; i++) rate[i] = ZERO; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += c[j] * acoef[i][j]; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = c[i]*(bcoef[i]*fac + rate[i]); } /* * This routine computes the interaction rates for the backward problem */ static void WebRatesB(realtype x, realtype y, realtype t, realtype c[], realtype cB[], realtype rate[], realtype rateB[], WebData wdata) { int i, j, ns; realtype fac, *bcoef; realtype (*acoef)[NS]; ns = wdata->ns; acoef = wdata->acoef; bcoef = wdata->bcoef; fac = ONE + ALPH*x*y; for (i = 0; i < ns; i++) rate[i] = bcoef[i]*fac; for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rate[i] += acoef[i][j]*c[j]; for (i = 0; i < ns; i++) { rateB[i] = cB[i]*rate[i]; rate[i] = c[i]*rate[i]; } for (j = 0; j < ns; j++) for (i = 0; i < ns; i++) rateB[i] += acoef[j][i]*c[j]*cB[j]; } /* * This routine computes one block of the interaction terms of the * system, namely block (jx,jy), for use in preconditioning. * Here jx and jy count from 0. */ static void fblock(realtype t, realtype cdata[], int jx, int jy, realtype cdotdata[], WebData wdata) { int iblok, ic; realtype x, y; iblok = jx + jy*(wdata->mx); y = jy*(wdata->dy); x = jx*(wdata->dx); ic = (wdata->ns)*(iblok); WebRates(x, y, t, cdata+ic, cdotdata, wdata); } /* * This routine performs ITMAX=5 Gauss-Seidel iterations to compute an * approximation to (P-inverse)*z, where P = I - gamma*Jd, and * Jd represents the diffusion contributions to the Jacobian. * The answer is stored in z on return, and x is a temporary vector. * The dimensions below assume a global constant NS >= ns. * Some inner loops of length ns are implemented with the small * vector kernels v_sum_prods, v_prod, v_inc_by_prod. */ static void GSIter(realtype gamma, N_Vector z, N_Vector x, WebData wdata) { int i, ic, iter, iyoff, jx, jy, ns, mxns, mx, my, x_loc, y_loc; realtype beta[NS], beta2[NS], cof1[NS], gam[NS], gam2[NS]; realtype temp, *cox, *coy, *xd, *zd; xd = NV_DATA_S(x); zd = NV_DATA_S(z); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; cox = wdata->cox; coy = wdata->coy; /* Write matrix as P = D - L - U. Load local arrays beta, beta2, gam, gam2, and cof1. */ for (i = 0; i < ns; i++) { temp = ONE/(ONE + RCONST(2.0)*gamma*(cox[i] + coy[i])); beta[i] = gamma*cox[i]*temp; beta2[i] = RCONST(2.0)*beta[i]; gam[i] = gamma*coy[i]*temp; gam2[i] = RCONST(2.0)*gam[i]; cof1[i] = temp; } /* Begin iteration loop. Load vector x with (D-inverse)*z for first iteration. */ for (jy = 0; jy < my; jy++) { iyoff = mxns*jy; for (jx = 0; jx < mx; jx++) { ic = iyoff + ns*jx; v_prod(xd+ic, cof1, zd+ic, ns); /* x[ic+i] = cof1[i]z[ic+i] */ } } N_VConst(ZERO, z); /* Looping point for iterations. */ for (iter=1; iter <= ITMAX; iter++) { /* Calculate (D-inverse)*U*x if not the first iteration. */ if (iter > 1) { for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam2[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam2, xd+ic+mxns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] = gam2[i]x[ic+mxns+i] */ v_prod(xd+ic, gam2, xd+ic+mxns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] = beta2[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta2, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] = beta[i]x[ic+ns+i] + gam[i]x[ic+mxns+i] */ v_sum_prods(xd+ic, beta, xd+ic+ns, gam, xd+ic+mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] = gam[i]x[ic+mxns+i] */ v_prod(xd+ic, gam, xd+ic+mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] = beta2[i]x[ic+ns+i] */ v_prod(xd+ic, beta2, xd+ic+ns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] = beta[i]x[ic+ns+i] */ v_prod(xd+ic, beta, xd+ic+ns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] = ZERO */ v_zero(xd+ic, ns); break; } } } } /* end if (iter > 1) */ /* Overwrite x with [(I - (D-inverse)*L)-inverse]*x. */ for (jy=0; jy < my; jy++) { iyoff = mxns*jy; for (jx=0; jx < mx; jx++) { /* order of loops matters */ ic = iyoff + ns*jx; x_loc = (jx == 0) ? 0 : ((jx == mx-1) ? 2 : 1); y_loc = (jy == 0) ? 0 : ((jy == my-1) ? 2 : 1); switch (3*y_loc+x_loc) { case 0 : /* jx == 0, jy == 0 */ break; case 1 : /* 1 <= jx <= mx-2, jy == 0 */ /* x[ic+i] += beta[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); break; case 2 : /* jx == mx-1, jy == 0 */ /* x[ic+i] += beta2[i]x[ic-ns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); break; case 3 : /* jx == 0, 1 <= jy <= my-2 */ /* x[ic+i] += gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 4 : /* 1 <= jx <= mx-2, 1 <= jy <= my-2 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 5 : /* jx == mx-1, 1 <= jy <= my-2 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam, xd+ic-mxns, ns); break; case 6 : /* jx == 0, jy == my-1 */ /* x[ic+i] += gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 7 : /* 1 <= jx <= mx-2, jy == my-1 */ /* x[ic+i] += beta[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; case 8 : /* jx == mx-1, jy == my-1 */ /* x[ic+i] += beta2[i]x[ic-ns+i] + gam2[i]x[ic-mxns+i] */ v_inc_by_prod(xd+ic, beta2, xd+ic-ns, ns); v_inc_by_prod(xd+ic, gam2, xd+ic-mxns, ns); break; } } } /* Add increment x to z : z <- z+x */ N_VLinearSum(ONE, z, ONE, x, z); } } static void v_inc_by_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] += v[i]*w[i]; } static void v_sum_prods(realtype u[], realtype p[], realtype q[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = p[i]*q[i] + v[i]*w[i]; } static void v_prod(realtype u[], realtype v[], realtype w[], int n) { int i; for (i=0; i < n; i++) u[i] = v[i]*w[i]; } static void v_zero(realtype u[], int n) { int i; for (i=0; i < n; i++) u[i] = ZERO; } /* * Print maximum sensitivity of G for each species */ static void PrintOutput(N_Vector cB, int ns, int mxns, WebData wdata) { int i, jx, jy; realtype *cdata, cij, cmax, x, y; x = y = ZERO; cdata = NV_DATA_S(cB); for (i=1; i <= ns; i++) { cmax = ZERO; for (jy=MY-1; jy >= 0; jy--) { for (jx=0; jx < MX; jx++) { cij = cdata[(i-1) + jx*ns + jy*mxns]; if (ABS(cij) > cmax) { cmax = cij; x = jx * wdata->dx; y = jy * wdata->dy; } } } printf("\nMaximum sensitivity with respect to I.C. of species %d\n", i); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" lambda max = %Le\n",cmax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" lambda max = %le\n",cmax); #else printf(" lambda max = %e\n",cmax); #endif printf("at\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" x = %Le\n y = %Le\n", x, y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" x = %le\n y = %le\n", x, y); #else printf(" x = %e\n y = %e\n", x, y); #endif } } /* * Compute double space integral */ static realtype doubleIntgr(N_Vector c, int i, WebData wdata) { realtype *cdata; int ns, mx, my, mxns; realtype dx, dy; realtype intgr_xy, intgr_x; int jx, jy; cdata = NV_DATA_S(c); ns = wdata->ns; mx = wdata->mx; my = wdata->my; mxns = wdata->mxns; dx = wdata->dx; dy = wdata->dy; jy = 0; intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy = intgr_x; for (jy = 1; jy < my-1; jy++) { intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy += RCONST(2.0)*intgr_x; } jy = my-1; intgr_x = cdata[(i-1)+jy*mxns]; for (jx = 1; jx < mx-1; jx++) { intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns]; } intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns]; intgr_x *= RCONST(0.5)*dx; intgr_xy += intgr_x; intgr_xy *= RCONST(0.5)*dy; return(intgr_xy); } /* * Free space allocated for the user data structure */ static void FreeUserData(WebData wdata) { int i, ngrp; ngrp = wdata->ngrp; for(i=0; i < ngrp; i++) { destroyMat((wdata->P)[i]); destroyArray((wdata->pivot)[i]); } N_VDestroy_Serial(wdata->rewt); free(wdata); } /* * Check function return value. * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_FSA_non.out0000600000175000017500000000627611741421151024715 0ustar sylvestresylvestre 1-D advection-diffusion equation, mesh size = 10 Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) ============================================================ T Q H NST Max norm ============================================================ 5.000e-01 4 7.656e-03 115 Solution 3.0529e+00 Sensitivity 1 3.8668e+00 Sensitivity 2 6.2020e-01 ------------------------------------------------------------ 1.000e+00 4 9.525e-03 182 Solution 8.7533e-01 Sensitivity 1 2.1743e+00 Sensitivity 2 1.8909e-01 ------------------------------------------------------------ 1.500e+00 3 1.040e-02 255 Solution 2.4949e-01 Sensitivity 1 9.1825e-01 Sensitivity 2 7.3922e-02 ------------------------------------------------------------ 2.000e+00 2 1.271e-02 330 Solution 7.1097e-02 Sensitivity 1 3.4667e-01 Sensitivity 2 2.8228e-02 ------------------------------------------------------------ 2.500e+00 2 1.629e-02 402 Solution 2.0260e-02 Sensitivity 1 1.2301e-01 Sensitivity 2 1.0085e-02 ------------------------------------------------------------ 3.000e+00 2 3.820e-03 473 Solution 5.7734e-03 Sensitivity 1 4.1956e-02 Sensitivity 2 3.4556e-03 ------------------------------------------------------------ 3.500e+00 2 8.988e-03 540 Solution 1.6451e-03 Sensitivity 1 1.3922e-02 Sensitivity 2 1.1669e-03 ------------------------------------------------------------ 4.000e+00 2 1.199e-02 617 Solution 4.6945e-04 Sensitivity 1 4.5300e-03 Sensitivity 2 3.8674e-04 ------------------------------------------------------------ 4.500e+00 3 4.744e-03 680 Solution 1.3422e-04 Sensitivity 1 1.4548e-03 Sensitivity 2 1.2589e-04 ------------------------------------------------------------ 5.000e+00 1 4.010e-03 757 Solution 3.8656e-05 Sensitivity 1 4.6451e-04 Sensitivity 2 4.0616e-05 ------------------------------------------------------------ Final Statistics nst = 757 nfe = 1373 netf = 1 nsetups = 0 nni = 1369 ncfn = 117 nfSe = 2746 nfeS = 5492 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 sundials-2.5.0/examples/cvodes/serial/cvsRoberts_dns_uw.c0000600000175000017500000002641011741421151024451 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:58:00 $ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem, with the coding * needed for its solution by CVODE. The problem is from * chemical kinetics, and consists of the following three rate * equations: * dy1/dt = -.04*y1 + 1.e4*y2*y3 * dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*(y2)^2 * dy3/dt = 3.e7*(y2)^2 * on the interval from t = 0.0 to t = 4.e10, with initial * conditions: y1 = 1.0, y2 = y3 = 0. The problem is stiff. * While integrating the system, we also use the rootfinding * feature to find the points at which y1 = 1e-4 or at which * y3 = 0.01. This program solves the problem with the BDF method, * Newton iteration with the CVDENSE dense linear solver, and a * user-supplied Jacobian routine. * It uses a user-supplied function to compute the error weights * required for the WRMS norm calculations. * Output is printed in decades from t = .4 to t = 4.e10. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include /* Header files with a description of contents used here */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVDense */ #include /* serial N_Vector types, functions, and macros */ #include /* definitions DlsMat and DENSE_ELEM */ #include /* definition of type realtype */ #include /* definition of ABS */ /* User-defined vector and matrix accessor macros: Ith, IJth */ /* These macros are defined in order to write code which exactly matches the mathematical problem description given above. Ith(v,i) references the ith component of the vector v, where i is in the range [1..NEQ] and NEQ is defined below. The Ith macro is defined using the N_VIth macro in nvector.h. N_VIth numbers the components of a vector starting from 0. IJth(A,i,j) references the (i,j)th element of the dense matrix A, where i and j are in the range [1..NEQ]. The IJth macro is defined using the DENSE_ELEM macro in dense.h. DENSE_ELEM numbers rows and columns of a dense matrix starting from 0. */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Ith numbers components 1..NEQ */ #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) /* IJth numbers rows,cols 1..NEQ */ /* Problem Constants */ #define NEQ 3 /* number of equations */ #define Y1 RCONST(1.0) /* initial y components */ #define Y2 RCONST(0.0) #define Y3 RCONST(0.0) #define RTOL RCONST(1.0e-4) /* scalar relative tolerance */ #define ATOL1 RCONST(1.0e-8) /* vector absolute tolerance components */ #define ATOL2 RCONST(1.0e-14) #define ATOL3 RCONST(1.0e-6) #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.4) /* first output time */ #define TMULT RCONST(10.0) /* output time factor */ #define NOUT 12 /* number of output times */ /* Functions Called by the Solver */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int g(realtype t, N_Vector y, realtype *gout, void *user_data); static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); static int ewt(N_Vector y, N_Vector w, void *user_data); /* Private functions to output results */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3); static void PrintRootInfo(int root_f1, int root_f2); /* Private function to print final statistics */ static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* *------------------------------- * Main Program *------------------------------- */ int main() { realtype t, tout; N_Vector y; void *cvode_mem; int flag, flagr, iout; int rootsfound[2]; y = NULL; cvode_mem = NULL; /* Create serial vector of length NEQ for I.C. */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); /* Initialize y */ Ith(y,1) = Y1; Ith(y,2) = Y2; Ith(y,3) = Y3; /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in y'=f(t,y), the inital time T0, and * the initial dependent variable vector y. */ flag = CVodeInit(cvode_mem, f, T0, y); if (check_flag(&flag, "CVodeInit", 1)) return(1); /* Use private function to compute error weights */ flag = CVodeWFtolerances(cvode_mem, ewt); if (check_flag(&flag, "CVodeSetEwtFn", 1)) return(1); /* Call CVodeRootInit to specify the root function g with 2 components */ flag = CVodeRootInit(cvode_mem, 2, g); if (check_flag(&flag, "CVodeRootInit", 1)) return(1); /* Call CVDense to specify the CVDENSE dense linear solver */ flag = CVDense(cvode_mem, NEQ); if (check_flag(&flag, "CVDense", 1)) return(1); /* Set the Jacobian routine to Jac (user-supplied) */ flag = CVDlsSetDenseJacFn(cvode_mem, Jac); if (check_flag(&flag, "CVDlsSetDenseJacFn", 1)) return(1); /* In loop, call CVode, print results, and test for error. Break out of loop when NOUT preset output times have been reached. */ printf(" \n3-species kinetics problem\n\n"); iout = 0; tout = T1; while(1) { flag = CVode(cvode_mem, tout, y, &t, CV_NORMAL); PrintOutput(t, Ith(y,1), Ith(y,2), Ith(y,3)); if (flag == CV_ROOT_RETURN) { flagr = CVodeGetRootInfo(cvode_mem, rootsfound); check_flag(&flagr, "CVodeGetRootInfo", 1); PrintRootInfo(rootsfound[0],rootsfound[1]); } if (check_flag(&flag, "CVode", 1)) break; if (flag == CV_SUCCESS) { iout++; tout *= TMULT; } if (iout == NOUT) break; } /* Print some final statistics */ PrintFinalStats(cvode_mem); /* Free y vector */ N_VDestroy_Serial(y); /* Free integrator memory */ CVodeFree(&cvode_mem); return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* * f routine. Compute function f(t,y). */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3, yd1, yd3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3; yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2; Ith(ydot,2) = -yd1 - yd3; return(0); } /* * g routine. Compute functions g_i(t,y) for i = 0,1. */ static int g(realtype t, N_Vector y, realtype *gout, void *user_data) { realtype y1, y3; y1 = Ith(y,1); y3 = Ith(y,3); gout[0] = y1 - RCONST(0.0001); gout[1] = y3 - RCONST(0.01); return(0); } /* * Jacobian routine. Compute J(t,y) = df/dy. * */ static int Jac(long int N, realtype t, N_Vector y, N_Vector fy, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); IJth(J,1,1) = RCONST(-0.04); IJth(J,1,2) = RCONST(1.0e4)*y3; IJth(J,1,3) = RCONST(1.0e4)*y2; IJth(J,2,1) = RCONST(0.04); IJth(J,2,2) = RCONST(-1.0e4)*y3-RCONST(6.0e7)*y2; IJth(J,2,3) = RCONST(-1.0e4)*y2; IJth(J,3,2) = RCONST(6.0e7)*y2; return(0); } /* * EwtSet function. Computes the error weights at the current solution. */ static int ewt(N_Vector y, N_Vector w, void *user_data) { int i; realtype yy, ww, rtol, atol[3]; rtol = RTOL; atol[0] = ATOL1; atol[1] = ATOL2; atol[2] = ATOL3; for (i=1; i<=3; i++) { yy = Ith(y,i); ww = rtol * ABS(yy) + atol[i-1]; if (ww <= 0.0) return (-1); Ith(w,i) = 1.0/ww; } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ static void PrintOutput(realtype t, realtype y1, realtype y2, realtype y3) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %0.4Le y =%14.6Le %14.6Le %14.6Le\n", t, y1, y2, y3); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %0.4le y =%14.6le %14.6le %14.6le\n", t, y1, y2, y3); #else printf("At t = %0.4e y =%14.6e %14.6e %14.6e\n", t, y1, y2, y3); #endif return; } static void PrintRootInfo(int root_f1, int root_f2) { printf(" rootsfound[] = %3d %3d\n", root_f1, root_f2); return; } /* * Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge; int flag; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); flag = CVodeGetNumGEvals(cvode_mem, &nge); check_flag(&flag, "CVodeGetNumGEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %-6ld nge = %ld\n \n", nni, ncfn, netf, nge); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsDiurnal_FSA_kry.out0000600000175000017500000002136011741421151025012 0ustar sylvestresylvestre 2-species diurnal advection-diffusion problem Sensitivity: YES ( SIMULTANEOUS + FULL ERROR CONTROL ) ======================================================================== T Q H NST Bottom left Top right ======================================================================== 7.200e+03 3 3.039e+01 552 Solution 1.0593e+04 1.1152e+04 2.5567e+11 2.6917e+11 ---------------------------------------- Sensitivity 1 -6.4963e+19 -6.8394e+19 7.2120e+19 7.6304e+19 ---------------------------------------- Sensitivity 2 -4.4900e+14 -4.9768e+14 -2.5039e+18 -2.7672e+18 ------------------------------------------------------------------------ 1.440e+04 3 2.312e+01 1032 Solution 6.9172e+06 7.2517e+06 2.6829e+11 2.8137e+11 ---------------------------------------- Sensitivity 1 -4.2432e+22 -4.4483e+22 6.2762e+22 6.6563e+22 ---------------------------------------- Sensitivity 2 -4.8955e+17 -5.3580e+17 -7.1116e+21 -7.7236e+21 ------------------------------------------------------------------------ 2.160e+04 3 4.952e+01 1884 Solution 2.7558e+07 2.9196e+07 3.1024e+11 3.3000e+11 ---------------------------------------- Sensitivity 1 -1.6903e+23 -1.7907e+23 4.0588e+23 4.4683e+23 ---------------------------------------- Sensitivity 2 -8.2851e+18 -9.3611e+18 -8.2851e+22 -9.3662e+22 ------------------------------------------------------------------------ 2.880e+04 3 7.302e+01 2213 Solution 8.9631e+06 9.8602e+06 3.4824e+11 3.8331e+11 ---------------------------------------- Sensitivity 1 -5.4975e+22 -6.0476e+22 5.8239e+23 7.0579e+23 ---------------------------------------- Sensitivity 2 -5.2367e+18 -6.4007e+18 -1.8450e+23 -2.2574e+23 ------------------------------------------------------------------------ 3.600e+04 4 3.366e+01 2302 Solution 1.4433e+04 1.6660e+04 3.4814e+11 4.0186e+11 ---------------------------------------- Sensitivity 1 -8.8547e+19 -1.0220e+20 5.6473e+23 7.6273e+23 ---------------------------------------- Sensitivity 2 -9.0220e+15 -1.2170e+16 -1.9753e+23 -2.6679e+23 ------------------------------------------------------------------------ 4.320e+04 4 4.497e+02 2522 Solution -6.3095e-09 -6.9919e-09 3.4900e+11 4.0867e+11 ---------------------------------------- Sensitivity 1 1.1669e+08 -1.4148e+08 5.7083e+23 7.9553e+23 ---------------------------------------- Sensitivity 2 1.0171e+05 1.1062e+05 -1.9969e+23 -2.7830e+23 ------------------------------------------------------------------------ 5.040e+04 4 4.497e+02 2538 Solution 2.7652e-09 2.9811e-09 3.5570e+11 4.1225e+11 ---------------------------------------- Sensitivity 1 -1.7614e+07 -1.8570e+07 5.9553e+23 8.1823e+23 ---------------------------------------- Sensitivity 2 -3.9136e+03 -4.6763e+03 -2.0833e+23 -2.8624e+23 ------------------------------------------------------------------------ 5.760e+04 3 3.862e+01 2580 Solution 4.0865e-09 1.2653e-08 3.6425e+11 4.1628e+11 ---------------------------------------- Sensitivity 1 9.5471e+08 2.9501e+09 6.2592e+23 8.4334e+23 ---------------------------------------- Sensitivity 2 -1.2170e+04 -2.7099e+04 -2.1896e+23 -2.9502e+23 ------------------------------------------------------------------------ 6.480e+04 4 1.536e+02 2636 Solution 3.6356e-08 1.1341e-07 3.6334e+11 4.2182e+11 ---------------------------------------- Sensitivity 1 -2.9344e+09 -9.1186e+09 6.2461e+23 8.7310e+23 ---------------------------------------- Sensitivity 2 -8.4752e+03 -3.0885e+04 -2.1850e+23 -3.0543e+23 ------------------------------------------------------------------------ 7.200e+04 4 1.536e+02 2683 Solution 4.3358e-09 1.5100e-08 3.6192e+11 4.3354e+11 ---------------------------------------- Sensitivity 1 -2.7350e+08 -9.6001e+08 6.2310e+23 9.2797e+23 ---------------------------------------- Sensitivity 2 3.7283e+07 1.2247e+08 -2.1798e+23 -3.2463e+23 ------------------------------------------------------------------------ 7.920e+04 4 4.008e+02 2711 Solution -2.1912e-15 -7.8117e-15 3.6148e+11 4.4474e+11 ---------------------------------------- Sensitivity 1 1.0220e+04 3.6486e+04 6.2481e+23 9.8067e+23 ---------------------------------------- Sensitivity 2 1.2136e+00 4.0255e+00 -2.1858e+23 -3.4307e+23 ------------------------------------------------------------------------ 8.640e+04 4 4.008e+02 2729 Solution 1.3608e-20 4.5805e-20 3.6318e+11 4.4524e+11 ---------------------------------------- Sensitivity 1 1.2856e-02 5.0845e-02 6.3248e+23 9.8819e+23 ---------------------------------------- Sensitivity 2 -3.1311e-05 -9.6668e-05 -2.2126e+23 -3.4570e+23 ------------------------------------------------------------------------ Final Statistics nst = 2729 nfe = 4101 netf = 203 nsetups = 542 nni = 4097 ncfn = 9 nfSe = 8202 nfeS = 16404 netfs = 0 nsetupsS = 0 nniS = 0 ncfnS = 0 nli = 8349 ncfl = 0 npe = 63 nps = 17946 sundials-2.5.0/examples/cvodes/serial/cvsFoodWeb_ASAi_kry.out0000600000175000017500000000173611741421151025112 0ustar sylvestresylvestre Create and allocate CVODE memory for forward run Allocate global memory Forward integration ncheck = 2 G = int_t int_x int_y c6(t,x,y) dx dy dt = 422295.963896 Create and allocate CVODES memory for backward run Backward integration Maximum sensitivity with respect to I.C. of species 1 lambda max = 9.569148e+02 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 2 lambda max = 9.379464e+02 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 3 lambda max = 9.200243e+02 at x = 1.000000e+00 y = 1.000000e+00 Maximum sensitivity with respect to I.C. of species 4 lambda max = -4.942530e-03 at x = 1.000000e+00 y = 0.000000e+00 Maximum sensitivity with respect to I.C. of species 5 lambda max = -4.939374e-03 at x = 1.000000e+00 y = 0.000000e+00 Maximum sensitivity with respect to I.C. of species 6 lambda max = 3.566293e-01 at x = 0.000000e+00 y = 0.000000e+00 sundials-2.5.0/examples/cvodes/serial/cvsHessian_ASA_FSA.out0000600000175000017500000000444711741421151024614 0ustar sylvestresylvestre------------------- Forward integration ------------------- ncheck = 1 y: 2.2732e-01 1.3534e-01 3.1472e-02 G: 5.3088e-01 yS1: -1.6714e-01 0.0000e+00 0.0000e+00 yS2: 2.1339e-01 0.0000e+00 -1.0885e-01 dG/dp: -1.2838e-01 1.8037e-02 Final Statistics for forward pb. -------------------------------- Number steps: 142 Function evaluations: f: 165 fQ: 147 fS: 165 fQS: 147 Error test failures: netf: 1 netfQ: 0 netfS: 0 netfQS: 1 Linear solver setups: nsetups: 27 nsetupsS: 0 Nonlinear iterations: nni: 161 nniS: 0 Convergence failures: ncfn: 0 ncfnS: 0 --------------------------------------------- Backward integration ... (2 adjoint problems) --------------------------------------------- dG/dp: -1.2838e-01 1.8036e-02 (from backward pb. 1) -1.2838e-01 1.8036e-02 (from backward pb. 2) H = d2G/dp2: (1) (2) 1.5628e-01 -7.8678e-02 -7.8678e-02 1.1093e-01 Final Statistics for backward pb. 1 ----------------------------------- Number steps: 100 Function evaluations: f: 127 fQ: 108 Error test failures: netf: 1 netfQ: 4 Linear solver setups: nsetups: 22 Nonlinear iterations: nni: 123 Convergence failures: ncfn: 0 Final Statistics for backward pb. 2 ----------------------------------- Number steps: 85 Function evaluations: f: 109 fQ: 92 Error test failures: netf: 1 netfQ: 3 Linear solver setups: nsetups: 18 Nonlinear iterations: nni: 105 Convergence failures: ncfn: 0 ----------------------- Finite Difference tests ----------------------- del_p = 0.01 p1+ y: 2.2566e-01 1.3534e-01 3.1472e-02 G: 5.2960e-01 p1- y: 2.2900e-01 1.3534e-01 3.1472e-02 G: 5.3217e-01 p2+ y: 2.2943e-01 1.3534e-01 3.0399e-02 G: 5.3106e-01 p2- y: 2.2516e-01 1.3534e-01 3.2577e-02 G: 5.3070e-01 dG/dp: -1.2760e-01 1.8475e-02 (fwd FD) -1.2916e-01 1.7581e-02 (bck FD) -1.2838e-01 1.8028e-02 (cntr FD) H(1,1): 1.5590e-01 H(2,2): 8.9446e-02 sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_bndL.c0000600000175000017500000003213611741421151023716 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem: * * The following is a simple example problem with a banded Jacobian, * with the program for its solution by CVODE. * The problem is the semi-discrete form of the advection-diffusion * equation in 2-D: * du/dt = d^2 u / dx^2 + .5 du/dx + d^2 u / dy^2 * on the rectangle 0 <= x <= 2, 0 <= y <= 1, and the time * interval 0 <= t <= 1. Homogeneous Dirichlet boundary conditions * are posed, and the initial condition is * u(x,y,t=0) = x(2-x)y(1-y)exp(5xy). * The PDE is discretized on a uniform MX+2 by MY+2 grid with * central differencing, and with boundary values eliminated, * leaving an ODE system of size NEQ = MX*MY. * This program solves the problem with the BDF method, Newton * iteration with the LAPACK band linear solver, and a user-supplied * Jacobian routine. * It uses scalar relative and absolute tolerances. * Output is printed at t = .1, .2, ..., 1. * Run statistics (optional outputs) are printed at the end. * ----------------------------------------------------------------- */ #include #include #include /* Header files with a description of contents used */ #include /* prototypes for CVODE fcts. and consts. */ #include /* prototype for CVLapackBand */ #include /* serial N_Vector types, fcts., and macros */ #include /* definition of ABS and EXP */ /* Problem Constants */ #define XMAX RCONST(2.0) /* domain boundaries */ #define YMAX RCONST(1.0) #define MX 10 /* mesh dimensions */ #define MY 5 #define NEQ MX*MY /* number of equations */ #define ATOL RCONST(1.0e-5) /* scalar absolute tolerance */ #define T0 RCONST(0.0) /* initial time */ #define T1 RCONST(0.1) /* first output time */ #define DTOUT RCONST(0.1) /* output time increment */ #define NOUT 10 /* number of output times */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define FIVE RCONST(5.0) /* User-defined vector access macro IJth */ /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= MX, 1 <= j <= MY. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*MY]) /* Type : UserData (contains grid constants) */ typedef struct { realtype dx, dy, hdcoef, hacoef, vdcoef; } *UserData; /* Private Helper Functions */ static void SetIC(N_Vector u, UserData data); static void PrintHeader(realtype reltol, realtype abstol, realtype umax); static void PrintOutput(realtype t, realtype umax, long int nst); static void PrintFinalStats(void *cvode_mem); /* Private function to check function return values */ static int check_flag(void *flagvalue, char *funcname, int opt); /* Functions Called by the Solver */ static int f(realtype t, N_Vector u, N_Vector udot, void *user_data); static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* *------------------------------- * Main Program *------------------------------- */ int main(void) { realtype dx, dy, reltol, abstol, t, tout, umax; N_Vector u; UserData data; void *cvode_mem; int iout, flag; long int nst; u = NULL; data = NULL; cvode_mem = NULL; /* Create a serial vector */ u = N_VNew_Serial(NEQ); /* Allocate u vector */ if(check_flag((void*)u, "N_VNew_Serial", 0)) return(1); reltol = ZERO; /* Set the tolerances */ abstol = ATOL; data = (UserData) malloc(sizeof *data); /* Allocate data memory */ if(check_flag((void *)data, "malloc", 2)) return(1); dx = data->dx = XMAX/(MX+1); /* Set grid coefficients in data */ dy = data->dy = YMAX/(MY+1); data->hdcoef = ONE/(dx*dx); data->hacoef = HALF/(TWO*dx); data->vdcoef = ONE/(dy*dy); SetIC(u, data); /* Initialize u vector */ /* Call CVodeCreate to create the solver memory and specify the * Backward Differentiation Formula and the use of a Newton iteration */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); if(check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1); /* Call CVodeInit to initialize the integrator memory and specify the * user's right hand side function in u'=f(t,u), the inital time T0, and * the initial dependent variable vector u. */ flag = CVodeInit(cvode_mem, f, T0, u); if(check_flag(&flag, "CVodeInit", 1)) return(1); /* Call CVodeSStolerances to specify the scalar relative tolerance * and scalar absolute tolerance */ flag = CVodeSStolerances(cvode_mem, reltol, abstol); if (check_flag(&flag, "CVodeSStolerances", 1)) return(1); /* Set the pointer to user-defined data */ flag = CVodeSetUserData(cvode_mem, data); if(check_flag(&flag, "CVodeSetUserData", 1)) return(1); /* Call CVLapackBand to specify the CVBAND band linear solver */ flag = CVLapackBand(cvode_mem, NEQ, MY, MY); if(check_flag(&flag, "CVLapackBand", 1)) return(1); /* Set the user-supplied Jacobian routine Jac */ flag = CVDlsSetBandJacFn(cvode_mem, Jac); if(check_flag(&flag, "CVDlsSetBandJacFn", 1)) return(1); /* In loop over output points: call CVode, print results, test for errors */ umax = N_VMaxNorm(u); PrintHeader(reltol, abstol, umax); for(iout=1, tout=T1; iout <= NOUT; iout++, tout += DTOUT) { flag = CVode(cvode_mem, tout, u, &t, CV_NORMAL); if(check_flag(&flag, "CVode", 1)) break; umax = N_VMaxNorm(u); flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); PrintOutput(t, umax, nst); } PrintFinalStats(cvode_mem); /* Print some final statistics */ N_VDestroy_Serial(u); /* Free the u vector */ CVodeFree(&cvode_mem); /* Free the integrator memory */ free(data); /* Free the user data */ return(0); } /* *------------------------------- * Functions called by the solver *------------------------------- */ /* f routine. Compute f(t,u). */ static int f(realtype t, N_Vector u,N_Vector udot, void *user_data) { realtype uij, udn, uup, ult, urt, hordc, horac, verdc, hdiff, hadv, vdiff; realtype *udata, *dudata; int i, j; UserData data; udata = NV_DATA_S(u); dudata = NV_DATA_S(udot); /* Extract needed constants from data */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* Loop over all grid points. */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == MY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == MX) ? ZERO : IJth(udata, i+1, j); /* Set diffusion and advection terms and load into udot */ hdiff = hordc*(ult - TWO*uij + urt); hadv = horac*(urt - ult); vdiff = verdc*(uup - TWO*uij + udn); IJth(dudata, i, j) = hdiff + hadv + vdiff; } } return(0); } /* Jacobian routine. Compute J(t,u). */ static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* * The components of f = udot that depend on u(i,j) are * f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with * df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) * df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) * df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) * df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) * df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* set non-zero Jacobian entries */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); } /* *------------------------------- * Private helper functions *------------------------------- */ /* Set initial conditions in u vector */ static void SetIC(N_Vector u, UserData data) { int i, j; realtype x, y, dx, dy; realtype *udata; /* Extract needed constants from data */ dx = data->dx; dy = data->dy; /* Set pointer to data array in vector u. */ udata = NV_DATA_S(u); /* Load initial profile into u vector */ for (j=1; j <= MY; j++) { y = j*dy; for (i=1; i <= MX; i++) { x = i*dx; IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*EXP(FIVE*x*y); } } } /* Print first lines of output (problem description) */ static void PrintHeader(realtype reltol, realtype abstol, realtype umax) { printf("\n2-D Advection-Diffusion Equation\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Total system size = %d\n", NEQ); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: reltol = %Lg abstol = %Lg\n\n", reltol, abstol); printf("At t = %Lg max.norm(u) =%14.6Le \n", T0, umax); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: reltol = %lg abstol = %lg\n\n", reltol, abstol); printf("At t = %lg max.norm(u) =%14.6le \n", T0, umax); #else printf("Tolerance parameters: reltol = %g abstol = %g\n\n", reltol, abstol); printf("At t = %g max.norm(u) =%14.6e \n", T0, umax); #endif return; } /* Print current value */ static void PrintOutput(realtype t, realtype umax, long int nst) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At t = %4.2Lf max.norm(u) =%14.6Le nst = %4ld\n", t, umax, nst); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At t = %4.2f max.norm(u) =%14.6le nst = %4ld\n", t, umax, nst); #else printf("At t = %4.2f max.norm(u) =%14.6e nst = %4ld\n", t, umax, nst); #endif return; } /* Get and print some final statistics */ static void PrintFinalStats(void *cvode_mem) { int flag; long int nst, nfe, nsetups, netf, nni, ncfn, nje, nfeLS; flag = CVodeGetNumSteps(cvode_mem, &nst); check_flag(&flag, "CVodeGetNumSteps", 1); flag = CVodeGetNumRhsEvals(cvode_mem, &nfe); check_flag(&flag, "CVodeGetNumRhsEvals", 1); flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups); check_flag(&flag, "CVodeGetNumLinSolvSetups", 1); flag = CVodeGetNumErrTestFails(cvode_mem, &netf); check_flag(&flag, "CVodeGetNumErrTestFails", 1); flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni); check_flag(&flag, "CVodeGetNumNonlinSolvIters", 1); flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn); check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1); flag = CVDlsGetNumJacEvals(cvode_mem, &nje); check_flag(&flag, "CVDlsGetNumJacEvals", 1); flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS); check_flag(&flag, "CVDlsGetNumRhsEvals", 1); printf("\nFinal Statistics:\n"); printf("nst = %-6ld nfe = %-6ld nsetups = %-6ld nfeLS = %-6ld nje = %ld\n", nst, nfe, nsetups, nfeLS, nje); printf("nni = %-6ld ncfn = %-6ld netf = %ld\n \n", nni, ncfn, netf); return; } /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if returned NULL pointer opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); }} /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/cvodes/serial/cvsHessian_ASA_FSA.c0000600000175000017500000004647711741421151024240 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 22:57:59 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Copyright (c) 2002, The Regents of the University of California. * Produced at the Lawrence Livermore National Laboratory. * All rights reserved. * For details, see the LICENSE file. * ----------------------------------------------------------------- * * Hessian through adjoint sensitivity example problem. * * [ - p1 * y1^2 - y3 ] [ 1 ] * y' = [ - y2 ] y(0) = [ 1 ] * [ -p2^2 * y2 * y3 ] [ 1 ] * * p1 = 1.0 * p2 = 2.0 * * 2 * / * G(p) = | 0.5 * ( y1^2 + y2^2 + y3^2 ) dt * / * 0 * * Compute the gradient (ASA) and Hessian (FSA over ASA) of G(p). * * See D.B. Ozyurt and P.I. Barton, SISC 26(5) 1725-1743, 2005. * * ----------------------------------------------------------------- */ #include #include #include #include #include #include #define Ith(v,i) NV_Ith_S(v,i-1) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) typedef struct { realtype p1, p2; } *UserData; static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data); static int fQ(realtype t, N_Vector y, N_Vector qdot, void *user_data); static int fS(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); static int fQS(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *user_data, N_Vector tmp, N_Vector tmpQ); static int fB1(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB); static int fQB1(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB); static int fB2(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB); static int fQB2(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB); void PrintFwdStats(void *cvode_mem); void PrintBckStats(void *cvode_mem, int idx); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { UserData data; void *cvode_mem; long int Neq, Np2; int Np; realtype t0, tf; realtype reltol; realtype abstol, abstolQ, abstolB, abstolQB; N_Vector y, yQ; N_Vector *yS, *yQS; N_Vector yB1, yB2; N_Vector yQB1, yQB2; int steps, ncheck; int indexB1, indexB2; int flag; realtype time; realtype dp; realtype G, Gp, Gm; realtype grdG_fwd[2], grdG_bck[2], grdG_cntr[2]; realtype H11, H22; /* User data structure */ data = (UserData) malloc(sizeof *data); data->p1 = RCONST(1.0); data->p2 = RCONST(2.0); /* Problem size, integration interval, and tolerances */ Neq = 3; Np = 2; Np2 = 2*Np; t0 = 0.0; tf = 2.0; reltol = 1.0e-8; abstol = 1.0e-8; abstolQ = 1.0e-8; abstolB = 1.0e-8; abstolQB = 1.0e-8; /* Initializations for forward problem */ y = N_VNew_Serial(Neq); N_VConst(ONE, y); yQ = N_VNew_Serial(1); N_VConst(ZERO, yQ); yS = N_VCloneVectorArray_Serial(Np, y); N_VConst(ZERO, yS[0]); N_VConst(ZERO, yS[1]); yQS = N_VCloneVectorArray_Serial(Np, yQ); N_VConst(ZERO, yQS[0]); N_VConst(ZERO, yQS[1]); /* Create and initialize forward problem */ cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); flag = CVodeInit(cvode_mem, f, t0, y); flag = CVodeSStolerances(cvode_mem, reltol, abstol); flag = CVodeSetUserData(cvode_mem, data); flag = CVDense(cvode_mem, Neq); flag = CVodeQuadInit(cvode_mem, fQ, yQ); flag = CVodeQuadSStolerances(cvode_mem, reltol, abstolQ); flag = CVodeSetQuadErrCon(cvode_mem, TRUE); flag = CVodeSensInit(cvode_mem, Np, CV_SIMULTANEOUS, fS, yS); flag = CVodeSensEEtolerances(cvode_mem); flag = CVodeSetSensErrCon(cvode_mem, TRUE); flag = CVodeQuadSensInit(cvode_mem, fQS, yQS); flag = CVodeQuadSensEEtolerances(cvode_mem); flag = CVodeSetQuadSensErrCon(cvode_mem, TRUE); /* Initialize ASA */ steps = 100; flag = CVodeAdjInit(cvode_mem, steps, CV_POLYNOMIAL); /* Forward integration */ printf("-------------------\n"); printf("Forward integration\n"); printf("-------------------\n\n"); flag = CVodeF(cvode_mem, tf, y, &time, CV_NORMAL, &ncheck); flag = CVodeGetQuad(cvode_mem, &time, yQ); G = Ith(yQ,1); flag = CVodeGetSens(cvode_mem, &time, yS); flag = CVodeGetQuadSens(cvode_mem, &time, yQS); printf("ncheck = %d\n", ncheck); printf("\n"); printf(" y: %12.4le %12.4le %12.4le", Ith(y,1), Ith(y,2), Ith(y,3)); printf(" G: %12.4le\n", Ith(yQ,1)); printf("\n"); printf(" yS1: %12.4le %12.4le %12.4le\n", Ith(yS[0],1), Ith(yS[0],2), Ith(yS[0],3)); printf(" yS2: %12.4le %12.4le %12.4le\n", Ith(yS[1],1), Ith(yS[1],2), Ith(yS[1],3)); printf("\n"); printf(" dG/dp: %12.4le %12.4le\n", Ith(yQS[0],1), Ith(yQS[1],1)); printf("\n"); printf("Final Statistics for forward pb.\n"); printf("--------------------------------\n"); PrintFwdStats(cvode_mem); /* Initializations for backward problems */ yB1 = N_VNew_Serial(2*Neq); N_VConst(ZERO, yB1); yQB1 = N_VNew_Serial(Np2); N_VConst(ZERO, yQB1); yB2 = N_VNew_Serial(2*Neq); N_VConst(ZERO, yB1); yQB2 = N_VNew_Serial(Np2); N_VConst(ZERO, yQB2); /* Create and initialize backward problems (one for each column of the Hessian) */ flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB1); flag = CVodeInitBS(cvode_mem, indexB1, fB1, tf, yB1); flag = CVodeSStolerancesB(cvode_mem, indexB1, reltol, abstolB); flag = CVodeSetUserDataB(cvode_mem, indexB1, data); flag = CVodeQuadInitBS(cvode_mem, indexB1, fQB1, yQB1); flag = CVodeQuadSStolerancesB(cvode_mem, indexB1, reltol, abstolQB); flag = CVodeSetQuadErrConB(cvode_mem, indexB1, TRUE); flag = CVDenseB(cvode_mem, indexB1, 2*Neq); flag = CVodeCreateB(cvode_mem, CV_BDF, CV_NEWTON, &indexB2); flag = CVodeInitBS(cvode_mem, indexB2, fB2, tf, yB2); flag = CVodeSStolerancesB(cvode_mem, indexB2, reltol, abstolB); flag = CVodeSetUserDataB(cvode_mem, indexB2, data); flag = CVodeQuadInitBS(cvode_mem, indexB2, fQB2, yQB2); flag = CVodeQuadSStolerancesB(cvode_mem, indexB2, reltol, abstolQB); flag = CVodeSetQuadErrConB(cvode_mem, indexB2, TRUE); flag = CVDenseB(cvode_mem, indexB2, 2*Neq); /* Backward integration */ printf("---------------------------------------------\n"); printf("Backward integration ... (2 adjoint problems)\n"); printf("---------------------------------------------\n\n"); flag = CVodeB(cvode_mem, t0, CV_NORMAL); flag = CVodeGetB(cvode_mem, indexB1, &time, yB1); flag = CVodeGetQuadB(cvode_mem, indexB1, &time, yQB1); flag = CVodeGetB(cvode_mem, indexB2, &time, yB2); flag = CVodeGetQuadB(cvode_mem, indexB2, &time, yQB2); printf(" dG/dp: %12.4le %12.4le (from backward pb. 1)\n", -Ith(yQB1,1), -Ith(yQB1,2)); printf(" %12.4le %12.4le (from backward pb. 2)\n", -Ith(yQB2,1), -Ith(yQB2,2)); printf("\n"); printf(" H = d2G/dp2:\n"); printf(" (1) (2)\n"); printf(" %12.4le %12.4le\n", -Ith(yQB1,3) , -Ith(yQB2,3)); printf(" %12.4le %12.4le\n", -Ith(yQB1,4) , -Ith(yQB2,4)); printf("\n"); printf("Final Statistics for backward pb. 1\n"); printf("-----------------------------------\n"); PrintBckStats(cvode_mem, indexB1); printf("Final Statistics for backward pb. 2\n"); printf("-----------------------------------\n"); PrintBckStats(cvode_mem, indexB2); /* Free CVODES memory */ CVodeFree(&cvode_mem); /* Finite difference tests */ dp = RCONST(1.0e-2); printf("-----------------------\n"); printf("Finite Difference tests\n"); printf("-----------------------\n\n"); printf("del_p = %g\n\n",dp); cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON); N_VConst(ONE, y); N_VConst(ZERO, yQ); flag = CVodeInit(cvode_mem, f, t0, y); flag = CVodeSStolerances(cvode_mem, reltol, abstol); flag = CVodeSetUserData(cvode_mem, data); flag = CVDense(cvode_mem, Neq); flag = CVodeQuadInit(cvode_mem, fQ, yQ); flag = CVodeQuadSStolerances(cvode_mem, reltol, abstolQ); flag = CVodeSetQuadErrCon(cvode_mem, TRUE); data->p1 += dp; flag = CVode(cvode_mem, tf, y, &time, CV_NORMAL); flag = CVodeGetQuad(cvode_mem, &time, yQ); Gp = Ith(yQ,1); printf("p1+ y: %12.4le %12.4le %12.4le", Ith(y,1), Ith(y,2), Ith(y,3)); printf(" G: %12.4le\n",Ith(yQ,1)); data->p1 -= 2.0*dp; N_VConst(ONE, y); N_VConst(ZERO, yQ); CVodeReInit(cvode_mem, t0, y); CVodeQuadReInit(cvode_mem, yQ); flag = CVode(cvode_mem, tf, y, &time, CV_NORMAL); flag = CVodeGetQuad(cvode_mem, &time, yQ); Gm = Ith(yQ,1); printf("p1- y: %12.4le %12.4le %12.4le", Ith(y,1), Ith(y,2), Ith(y,3)); printf(" G: %12.4le\n",Ith(yQ,1)); data->p1 += dp; grdG_fwd[0] = (Gp-G)/dp; grdG_bck[0] = (G-Gm)/dp; grdG_cntr[0] = (Gp-Gm)/(2.0*dp); H11 = (Gp - 2.0*G + Gm) / (dp*dp); data->p2 += dp; N_VConst(ONE, y); N_VConst(ZERO, yQ); CVodeReInit(cvode_mem, t0, y); CVodeQuadReInit(cvode_mem, yQ); flag = CVode(cvode_mem, tf, y, &time, CV_NORMAL); flag = CVodeGetQuad(cvode_mem, &time, yQ); Gp = Ith(yQ,1); printf("p2+ y: %12.4le %12.4le %12.4le", Ith(y,1), Ith(y,2), Ith(y,3)); printf(" G: %12.4le\n",Ith(yQ,1)); data->p2 -= 2.0*dp; N_VConst(ONE, y); N_VConst(ZERO, yQ); CVodeReInit(cvode_mem, t0, y); CVodeQuadReInit(cvode_mem, yQ); flag = CVode(cvode_mem, tf, y, &time, CV_NORMAL); flag = CVodeGetQuad(cvode_mem, &time, yQ); Gm = Ith(yQ,1); printf("p2- y: %12.4le %12.4le %12.4le", Ith(y,1), Ith(y,2), Ith(y,3)); printf(" G: %12.4le\n",Ith(yQ,1)); data->p2 += dp; grdG_fwd[1] = (Gp-G)/dp; grdG_bck[1] = (G-Gm)/dp; grdG_cntr[1] = (Gp-Gm)/(2.0*dp); H22 = (Gp - 2.0*G + Gm) / (dp*dp); printf("\n"); printf(" dG/dp: %12.4le %12.4le (fwd FD)\n", grdG_fwd[0], grdG_fwd[1]); printf(" %12.4le %12.4le (bck FD)\n", grdG_bck[0], grdG_bck[1]); printf(" %12.4le %12.4le (cntr FD)\n", grdG_cntr[0], grdG_cntr[1]); printf("\n"); printf(" H(1,1): %12.4le\n", H11); printf(" H(2,2): %12.4le\n", H22); /* Free memory */ CVodeFree(&cvode_mem); N_VDestroy_Serial(y); N_VDestroy_Serial(yQ); N_VDestroyVectorArray_Serial(yS, Np); N_VDestroyVectorArray_Serial(yQS, 1); N_VDestroy_Serial(yB1); N_VDestroy_Serial(yQB1); N_VDestroy_Serial(yB2); N_VDestroy_Serial(yQB2); free(data); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY CVODES *-------------------------------------------------------------------- */ static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) { realtype y1, y2, y3; UserData data; realtype p1, p2; data = (UserData) user_data; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); Ith(ydot,1) = -p1*y1*y1 - y3; Ith(ydot,2) = -y2; Ith(ydot,3) = -p2*p2*y2*y3; return(0); } static int fQ(realtype t, N_Vector y, N_Vector qdot, void *user_data) { realtype y1, y2, y3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); Ith(qdot,1) = 0.5 * ( y1*y1 + y2*y2 + y3*y3 ); return(0); } static int fS(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2) { UserData data; realtype y1, y2, y3; realtype s1, s2, s3; realtype fys1, fys2, fys3; realtype p1, p2; data = (UserData) user_data; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* 1st sensitivity RHS */ s1 = Ith(yS[0],1); s2 = Ith(yS[0],2); s3 = Ith(yS[0],3); fys1 = - 2.0*p1*y1 * s1 - s3; fys2 = - s2; fys3 = - p2*p2*y3 * s2 - p2*p2*y2 * s3; Ith(ySdot[0],1) = fys1 - y1*y1; Ith(ySdot[0],2) = fys2; Ith(ySdot[0],3) = fys3; /* 2nd sensitivity RHS */ s1 = Ith(yS[1],1); s2 = Ith(yS[1],2); s3 = Ith(yS[1],3); fys1 = - 2.0*p1*y1 * s1 - s3; fys2 = - s2; fys3 = - p2*p2*y3 * s2 - p2*p2*y2 * s3; Ith(ySdot[1],1) = fys1; Ith(ySdot[1],2) = fys2; Ith(ySdot[1],3) = fys3 - 2.0*p2*y2*y3; return(0); } static int fQS(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *user_data, N_Vector tmp, N_Vector tmpQ) { realtype y1, y2, y3; realtype s1, s2, s3; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); /* 1st sensitivity RHS */ s1 = Ith(yS[0],1); s2 = Ith(yS[0],2); s3 = Ith(yS[0],3); Ith(yQSdot[0],1) = y1*s1 + y2*s2 + y3*s3; /* 1st sensitivity RHS */ s1 = Ith(yS[1],1); s2 = Ith(yS[1],2); s3 = Ith(yS[1],3); Ith(yQSdot[1],1) = y1*s1 + y2*s2 + y3*s3; return(0); } static int fB1(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB) { UserData data; realtype p1, p2; realtype y1, y2, y3; /* solution */ realtype s1, s2, s3; /* sensitivity 1 */ realtype l1, l2, l3; /* lambda */ realtype m1, m2, m3; /* mu */ data = (UserData) user_dataB; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); s1 = Ith(yS[0],1); s2 = Ith(yS[0],2); s3 = Ith(yS[0],3); l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); m1 = Ith(yB,4); m2 = Ith(yB,5); m3 = Ith(yB,6); Ith(yBdot,1) = 2.0*p1*y1 * l1 - y1; Ith(yBdot,2) = l2 + p2*p2*y3 * l3 - y2; Ith(yBdot,3) = l1 + p2*p2*y2 * l3 - y3; Ith(yBdot,4) = 2.0*p1*y1 * m1 + l1 * 2.0*(y1 + p1*s1) - s1; Ith(yBdot,5) = m2 + p2*p2*y3 * m3 + l3 * p2*p2*s3 - s2; Ith(yBdot,6) = m1 + p2*p2*y2 * m3 + l3 * p2*p2*s2 - s3; return(0); } static int fQB1(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB) { UserData data; realtype p1, p2; realtype y1, y2, y3; /* solution */ realtype s1, s2, s3; /* sensitivity 1 */ realtype l1, l2, l3; /* lambda */ realtype m1, m2, m3; /* mu */ data = (UserData) user_dataB; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); s1 = Ith(yS[0],1); s2 = Ith(yS[0],2); s3 = Ith(yS[0],3); l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); m1 = Ith(yB,4); m2 = Ith(yB,5); m3 = Ith(yB,6); Ith(qBdot,1) = -y1*y1 * l1; Ith(qBdot,2) = -2.0*p2*y2*y3 * l3; Ith(qBdot,3) = -y1*y1 * m1 - l1 * 2.0*y1*s1; Ith(qBdot,4) = -2.0*p2*y2*y3 * m3 - l3 * 2.0*(p2*y3*s2 + p2*y2*s3); return(0); } static int fB2(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB) { UserData data; realtype p1, p2; realtype y1, y2, y3; /* solution */ realtype s1, s2, s3; /* sensitivity 2 */ realtype l1, l2, l3; /* lambda */ realtype m1, m2, m3; /* mu */ data = (UserData) user_dataB; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); s1 = Ith(yS[1],1); s2 = Ith(yS[1],2); s3 = Ith(yS[1],3); l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); m1 = Ith(yB,4); m2 = Ith(yB,5); m3 = Ith(yB,6); Ith(yBdot,1) = 2.0*p1*y1 * l1 - y1; Ith(yBdot,2) = l2 + p2*p2*y3 * l3 - y2; Ith(yBdot,3) = l1 + p2*p2*y2 * l3 - y3; Ith(yBdot,4) = 2.0*p1*y1 * m1 + l1 * 2.0*p1*s1 - s1; Ith(yBdot,5) = m2 + p2*p2*y3 * m3 + l3 * (2.0*p2*y3 + p2*p2*s3) - s2; Ith(yBdot,6) = m1 + p2*p2*y2 * m3 + l3 * (2.0*p2*y3 + p2*p2*s2) - s3; return(0); } static int fQB2(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB) { UserData data; realtype p1, p2; realtype y1, y2, y3; /* solution */ realtype s1, s2, s3; /* sensitivity 2 */ realtype l1, l2, l3; /* lambda */ realtype m1, m2, m3; /* mu */ data = (UserData) user_dataB; p1 = data->p1; p2 = data->p2; y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3); s1 = Ith(yS[1],1); s2 = Ith(yS[1],2); s3 = Ith(yS[1],3); l1 = Ith(yB,1); l2 = Ith(yB,2); l3 = Ith(yB,3); m1 = Ith(yB,4); m2 = Ith(yB,5); m3 = Ith(yB,6); Ith(qBdot,1) = -y1*y1 * l1; Ith(qBdot,2) = -2.0*p2*y2*y3 * l3; Ith(qBdot,3) = -y1*y1 * m1 - l1 * 2.0*y1*s1; Ith(qBdot,4) = -2.0*p2*y2*y3 * m3 - l3 * 2.0*(p2*y3*s2 + p2*y2*s3 + y2*y3); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ void PrintFwdStats(void *cvode_mem) { long int nst, nfe, nsetups, nni, ncfn, netf; long int nfQe, netfQ; long int nfSe, nfeS, nsetupsS, nniS, ncfnS, netfS; long int nfQSe, netfQS; int qlast, qcur; realtype h0u, hlast, hcur, tcur; int flag; flag = CVodeGetIntegratorStats(cvode_mem, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0u, &hlast, &hcur, &tcur); flag = CVodeGetNonlinSolvStats(cvode_mem, &nni, &ncfn); flag = CVodeGetQuadStats(cvode_mem, &nfQe, &netfQ); flag = CVodeGetSensStats(cvode_mem, &nfSe, &nfeS, &netfS, &nsetupsS); flag = CVodeGetSensNonlinSolvStats(cvode_mem, &nniS, &ncfnS); flag = CVodeGetQuadSensStats(cvode_mem, &nfQSe, &netfQS); printf(" Number steps: %5ld\n\n", nst); printf(" Function evaluations:\n"); printf(" f: %5ld\n fQ: %5ld\n fS: %5ld\n fQS: %5ld\n", nfe, nfQe, nfSe, nfQSe); printf(" Error test failures:\n"); printf(" netf: %5ld\n netfQ: %5ld\n netfS: %5ld\n netfQS: %5ld\n", netf, netfQ, netfS, netfQS); printf(" Linear solver setups:\n"); printf(" nsetups: %5ld\n nsetupsS: %5ld\n", nsetups, nsetupsS); printf(" Nonlinear iterations:\n"); printf(" nni: %5ld\n nniS: %5ld\n", nni, nniS); printf(" Convergence failures:\n"); printf(" ncfn: %5ld\n ncfnS: %5ld\n", ncfn, ncfnS); printf("\n"); } void PrintBckStats(void *cvode_mem, int idx) { void *cvode_mem_bck; long int nst, nfe, nsetups, nni, ncfn, netf; long int nfQe, netfQ; int qlast, qcur; realtype h0u, hlast, hcur, tcur; int flag; cvode_mem_bck = CVodeGetAdjCVodeBmem(cvode_mem, idx); flag = CVodeGetIntegratorStats(cvode_mem_bck, &nst, &nfe, &nsetups, &netf, &qlast, &qcur, &h0u, &hlast, &hcur, &tcur); flag = CVodeGetNonlinSolvStats(cvode_mem_bck, &nni, &ncfn); flag = CVodeGetQuadStats(cvode_mem_bck, &nfQe, &netfQ); printf(" Number steps: %5ld\n\n", nst); printf(" Function evaluations:\n"); printf(" f: %5ld\n fQ: %5ld\n", nfe, nfQe); printf(" Error test failures:\n"); printf(" netf: %5ld\n netfQ: %5ld\n", netf, netfQ); printf(" Linear solver setups:\n"); printf(" nsetups: %5ld\n", nsetups); printf(" Nonlinear iterations:\n"); printf(" nni: %5ld\n", nni); printf(" Convergence failures:\n"); printf(" ncfn: %5ld\n", ncfn); printf("\n"); } sundials-2.5.0/examples/cvodes/serial/cvsAdvDiff_ASAi_bnd.out0000600000175000017500000000042111741421151025014 0ustar sylvestresylvestre Create and allocate CVODES memory for forward runs Allocate global memory Forward integration ncheck = 3 Create and allocate CVODES memory for backward run Backward integration Maximum sensitivity lambda max = 1.128855e-01 at x = 1.170732e+00 y = 4.761905e-01 sundials-2.5.0/examples/cvodes/serial/README0000600000175000017500000000337611741421151021460 0ustar sylvestresylvestreList of serial CVODES examples (1) Simulation cvsAdvDiff_bnd : banded example cvsAdvDiff_bndL : banded example (Lapack) cvsDirectDemo_ls : demonstration program for direct methods cvsDiurnal_kry_bp : Krylov example with banded preconditioner cvsDiurnal_kry : Krylov example cvsKrylovDemo_ls : demonstration program with 3 Krylov solvers cvsKrylovDemo_prec : demonstration program for Krylov methods cvsRoberts_dns : dense example cvsRoberts_dnsL : dense example (Lapack) cvsRoberts_dns_uw : dense example with user ewt function (2) Forward sensitivity cvsAdvDiff_FSA_non : 1-D advection difusion PDE - Adams with Functional iteration cvsDiurnal_FSA_kry : 2-D 2-species diurnal advection-diffusion PDE - BDF with Newton GMRES cvsRoberts_FSA_dns : chemical kinetics ODEs - BDF with Newton Dense (3) Adjoint sensitivity cvsAdvDiff_ASAi_bnd : advection-diffusion - adjoint sensitivity cvsFoodWeb_ASAi_kry : food web - adjoint sensitivity for G cvsFoodWeb_ASAp_kry : food web - adjoint sensitivity for g cvsHessian_ASA_FSA : ASA example for computing Hessian cvsRoberts_ASAi_dns : chemical kinetics - adjoint sensitivity Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --with-blas-lapack-libs="-L/home/radu/apps/lib -lSimTKlapack" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 The SimTKlapack library provides ATLAS-tunned Blas and Lapack functionssundials-2.5.0/examples/templates/0000755000175000017500000000000011767174700020050 5ustar sylvestresylvestresundials-2.5.0/examples/templates/cmakelists_parallel_C_ex.in0000600000175000017500000000602311741421110025320 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.2 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # CMakeLists.txt for @SOLVER@ parallel examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user CMakeLists configuration files. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LAPACK_LIBRARIES. Otherwise, this variable should contain # an empty string or LAPACK_LIBRARIES-NOTFOUND. If this variable # contains a valid library entry, we add it to each example traget # whether they use the Lapack module or not. This is done in order # to address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # # ----------------------------------------------------------------- # Specify project name PROJECT(@SOLVER@_parallel_examples C) MARK_AS_ADVANCED(EXECUTABLE_OUTPUT_PATH LIBRARY_OUTPUT_PATH) # Set the names of the examples to be built SET(examples @EXAMPLES@) # Set name of MPI compiler to be used (CC or MPICC) SET(MPI_MPICC @MPICC@ CACHE STRING "MPICC compiler script") SET(CMAKE_C_COMPILER ${MPI_MPICC}) # Specify path to SUNDIALS header files SET(SUNDIALS_INC_DIR @includedir@ CACHE STRING "Location of SUNDIALS header files") # Add path to SUNDIALS header files INCLUDE_DIRECTORIES(${SUNDIALS_INC_DIR}) # Set search path for SUNDIALS libraries SET(SUNDIALS_LIB_DIR @libdir@) # Find the SUNDIALS solver's library FIND_LIBRARY(SUNDIALS_SOLVER_LIB @SOLVER_LIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ library") # Find the NVECTOR library FIND_LIBRARY(SUNDIALS_NVEC_LIB sundials_nvecparallel ${SUNDIALS_LIB_DIR} DOC "NVECTOR library") # Set additional libraries SET(SUNDIALS_EXTRA_LIB @LIBS@ CACHE STRING "Additional libraries") # Set Blas/Lapack libraries SET(LAPACK_LIBRARIES @BLAS_LAPACK_LIBS@ CACHE STRING "Lapack libraries") # List of all libraries SET(SUNDIALS_LIBS ${SUNDIALS_SOLVER_LIB} ${SUNDIALS_NVEC_LIB} ${SUNDIALS_EXTRA_LIB}) IF(LAPACK_LIBRARIES) SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_LIBRARIES) # Build each example one by one FOREACH(example ${examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) ENDFOREACH(example ${examples}) sundials-2.5.0/examples/templates/cmakelists_serial_F77_ex.in0000600000175000017500000000570511741421110025172 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # CMakeLists.txt for @SOLVER@ serial examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user CMakeLists configuration files. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LAPACK_LIBRARIES. Otherwise, this variable should contain # an empty string or LAPACK_LIBRARIES-NOTFOUND. If this variable # contains a valid library entry, we add it to each example traget # whether they use the Lapack module or not. This is done in order # to address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # # ----------------------------------------------------------------- # Specify project name PROJECT(F@SOLVER@_serial_examples Fortran) MARK_AS_ADVANCED(EXECUTABLE_OUTPUT_PATH LIBRARY_OUTPUT_PATH) # Set the names of the examples to be built SET(examples @EXAMPLES@ @EXAMPLES_BL@) # Set search path for SUNDIALS libraries SET(SUNDIALS_LIB_DIR @libdir@) # Find the SUNDIALS solver's library FIND_LIBRARY(SUNDIALS_SOLVER_LIB @SOLVER_LIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ library") FIND_LIBRARY(SUNDIALS_SOLVER_FLIB @SOLVER_FLIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ F77-C library") # Find the NVECTOR library FIND_LIBRARY(SUNDIALS_NVEC_LIB sundials_nvecserial ${SUNDIALS_LIB_DIR} DOC "NVECTOR library") FIND_LIBRARY(SUNDIALS_NVEC_FLIB sundials_fnvecserial ${SUNDIALS_LIB_DIR} DOC "NVECTOR F77-C library") # Set additional libraries SET(SUNDIALS_EXTRA_LIB @LIBS@ CACHE STRING "Additional libraries") # Set Blas/Lapack libraries SET(LAPACK_LIBRARIES @BLAS_LAPACK_LIBS@ CACHE STRING "Lapack libraries") # List of all libraries SET(SUNDIALS_LIBS ${SUNDIALS_SOLVER_FLIB} ${SUNDIALS_SOLVER_LIB} ${SUNDIALS_NVEC_FLIB} ${SUNDIALS_NVEC_LIB} ${SUNDIALS_EXTRA_LIB}) IF(LAPACK_LIBRARIES) SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_LIBRARIES) # Build each example one by one FOREACH(example ${examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) ENDFOREACH(example ${examples}) sundials-2.5.0/examples/templates/makefile_parallel_F77_ex.in0000600000175000017500000000545511741421110025127 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.2 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for @SOLVER@ fortran parallel examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user Makefiles. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LIBRARIES_BL. Otherwise, this variable should contain # an empty string. We include LIBRARIES_BL in the link line for # all examples, even the parallel ones which obviously cannot # use the Lapack linear solver modules simply to address the case # in which the SUNDIALS libraries are shared objects. In that case, # the solver library references Lapack symbols which must be # always resolved by linking against the Blas/Lapack libraries. # If only static SUNDIALS libraries have been built, it is not # required to link the Blas/Lapack libraries for the parallel # examples... # # ----------------------------------------------------------------- SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ FFLAGS = @FFLAGS@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ MPIF77 = @MPIF77@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_FLAGS = @MPI_FLAGS@ MPIF77_LNKR = @MPIF77_LNKR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ LIBRARIES = -l@SOLVER_FLIB@ -l@SOLVER_LIB@ -lsundials_fnvecparallel -lsundials_nvecparallel ${LIBS} LIBRARIES_BL = @BLAS_LAPACK_LIBS@ EXAMPLES = @EXAMPLES@ OBJECTS = ${EXAMPLES:=.o} # ----------------------------------------------------------------------------------------- .SUFFIXES : .o .f .f.o : ${MPIF77} ${FFLAGS} ${MPI_FLAGS} -I${MPI_INC_DIR} -c $< # ----------------------------------------------------------------------------------------- all: ${OBJECTS} @for i in ${EXAMPLES} ; do \ echo "${MPIF77_LNKR} -o $${i} $${i}.o ${MPI_FLAGS} ${F77_LDFLAGS} ${F77_LIBS} -L${libdir} ${LIBRARIES} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBRARIES_BL}" ; \ ${MPIF77_LNKR} -o $${i} $${i}.o ${MPI_FLAGS} ${F77_LDFLAGS} ${F77_LIBS} -L${libdir} ${LIBRARIES} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBRARIES_BL}; \ done clean: rm -f ${OBJECTS} rm -f ${EXAMPLES} # ----------------------------------------------------------------------------------------- sundials-2.5.0/examples/templates/cmakelists_serial_C_ex.in0000600000175000017500000000561111741421110025005 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # CMakeLists.txt for @SOLVER@ serial examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user CMakeLists configuration files. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LAPACK_LIBRARIES. Otherwise, this variable should contain # an empty string or LAPACK_LIBRARIES-NOTFOUND. If this variable # contains a valid library entry, we add it to each example traget # whether they use the Lapack module or not. This is done in order # to address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # # ----------------------------------------------------------------- # Specify project name PROJECT(@SOLVER@_serial_examples C) MARK_AS_ADVANCED(EXECUTABLE_OUTPUT_PATH LIBRARY_OUTPUT_PATH) # Set the names of the examples to be built SET(examples @EXAMPLES@ @EXAMPLES_BL@) # Specify path to SUNDIALS header files SET(SUNDIALS_INC_DIR @includedir@ CACHE STRING "Location of SUNDIALS header files") # Add path to SUNDIALS header files INCLUDE_DIRECTORIES(${SUNDIALS_INC_DIR}) # Set search path for SUNDIALS libraries SET(SUNDIALS_LIB_DIR @libdir@) # Find the SUNDIALS solver's library FIND_LIBRARY(SUNDIALS_SOLVER_LIB @SOLVER_LIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ library") # Find the NVECTOR library FIND_LIBRARY(SUNDIALS_NVEC_LIB sundials_nvecserial ${SUNDIALS_LIB_DIR} DOC "NVECTOR library") # Set additional libraries SET(SUNDIALS_EXTRA_LIB @LIBS@ CACHE STRING "Additional libraries") # Set Blas/Lapack libraries SET(LAPACK_LIBRARIES @BLAS_LAPACK_LIBS@ CACHE STRING "Lapack libraries") # List of all libraries SET(SUNDIALS_LIBS ${SUNDIALS_SOLVER_LIB} ${SUNDIALS_NVEC_LIB} ${SUNDIALS_EXTRA_LIB}) IF(LAPACK_LIBRARIES) SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_LIBRARIES) # Build each example one by one FOREACH(example ${examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) ENDFOREACH(example ${examples}) sundials-2.5.0/examples/templates/makefile_parallel_C_ex.in0000600000175000017500000000544511741421110024745 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.2 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for @SOLVER@ parallel examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user Makefiles. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LIBRARIES_BL. Otherwise, this variable should contain # an empty string. We include LIBRARIES_BL in the link line for # all examples, even the parallel ones which obviously cannot # use the Lapack linear solver modules simply to address the case # in which the SUNDIALS libraries are shared objects. In that case, # the solver library references Lapack symbols which must be # always resolved by linking against the Blas/Lapack libraries. # If only static SUNDIALS libraries have been built, it is not # required to link the Blas/Lapack libraries for the parallel # examples... # ----------------------------------------------------------------- SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ INCLUDES = -I${includedir} -I${MPI_INC_DIR} LIBRARIES = -l@SOLVER_LIB@ -lsundials_nvecparallel ${LIBS} LIBRARIES_BL = @BLAS_LAPACK_LIBS@ EXAMPLES = @EXAMPLES@ OBJECTS = ${EXAMPLES:=.o} # ----------------------------------------------------------------------------------------- .SUFFIXES : .o .c .c.o : ${MPICC} ${CPPFLAGS} ${CFLAGS} ${MPI_FLAGS} ${INCLUDES} -c $< # ----------------------------------------------------------------------------------------- all: ${OBJECTS} @for i in ${EXAMPLES} ; do \ echo "${MPICC} -o $${i} $${i}.o ${MPI_FLAGS} ${CFLAGS} ${LDFLAGS} -L${libdir} ${LIBRARIES} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBRARIES_BL}" ; \ ${MPICC} -o $${i} $${i}.o ${MPI_FLAGS} ${CFLAGS} ${LDFLAGS} -L${libdir} ${LIBRARIES} -L${MPI_LIB_DIR} ${MPI_LIBS} ${LIBRARIES_BL}; \ done clean: rm -f ${OBJECTS} rm -f ${EXAMPLES} # ----------------------------------------------------------------------------------------- sundials-2.5.0/examples/templates/cmakelists_parallel_F77_ex.in0000600000175000017500000000614011741421110025501 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.2 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # CMakeLists.txt for @SOLVER@ Fortran parallel examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user CMakeLists configuration files. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LAPACK_LIBRARIES. Otherwise, this variable should contain # an empty string or LAPACK_LIBRARIES-NOTFOUND. If this variable # contains a valid library entry, we add it to each example traget # whether they use the Lapack module or not. This is done in order # to address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # # ----------------------------------------------------------------- # Specify project name PROJECT(F@SOLVER@_parallel_examples Fortran) MARK_AS_ADVANCED(EXECUTABLE_OUTPUT_PATH LIBRARY_OUTPUT_PATH) # Set the names of the examples to be built SET(examples @EXAMPLES@) # Set name of MPI compiler to be used (F77 or MPIF77) SET(MPI_MPIF77 @MPIF77@ CACHE STRING "MPIF77 compiler script") SET(CMAKE_Fortran_COMPILER ${MPI_MPIF77}) # Set search path for SUNDIALS libraries SET(SUNDIALS_LIB_DIR @libdir@) # Find the SUNDIALS solver's library FIND_LIBRARY(SUNDIALS_SOLVER_LIB @SOLVER_LIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ library") FIND_LIBRARY(SUNDIALS_SOLVER_FLIB @SOLVER_FLIB@ ${SUNDIALS_LIB_DIR} DOC "@SOLVER@ F77-C library") # Find the NVECTOR library FIND_LIBRARY(SUNDIALS_NVEC_LIB sundials_nvecparallel ${SUNDIALS_LIB_DIR} DOC "NVECTOR library") FIND_LIBRARY(SUNDIALS_NVEC_FLIB sundials_fnvecparallel ${SUNDIALS_LIB_DIR} DOC "NVECTOR F77-C library") # Set additional libraries SET(SUNDIALS_EXTRA_LIB @LIBS@ CACHE STRING "Additional libraries") # Set Blas/Lapack libraries SET(LAPACK_LIBRARIES @BLAS_LAPACK_LIBS@ CACHE STRING "Lapack libraries") # List of all libraries SET(SUNDIALS_LIBS ${SUNDIALS_SOLVER_FLIB} ${SUNDIALS_SOLVER_LIB} ${SUNDIALS_NVEC_FLIB} ${SUNDIALS_NVEC_LIB} ${SUNDIALS_EXTRA_LIB}) IF(LAPACK_LIBRARIES) SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_LIBRARIES) # Build each example one by one FOREACH(example ${examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${LIBS}) ENDFOREACH(example ${examples}) sundials-2.5.0/examples/templates/makefile_serial_F77_ex.in0000600000175000017500000000503011741421110024577 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for @SOLVER@ Fortran serial examples # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user Makefiles. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LIBRARIES_BL. Otherwise, this variable should contain # an empty string. We include LIBRARIES_BL in the link line for # all examples, whether they use the Lapack module or not, to # address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # ----------------------------------------------------------------- SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ F77 = @F77@ FFLAGS = @FFLAGS@ F77_LNKR = @F77_LNKR@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ LIBRARIES = -l@SOLVER_FLIB@ -l@SOLVER_LIB@ -lsundials_fnvecserial -lsundials_nvecserial ${LIBS} LIBRARIES_BL = @BLAS_LAPACK_LIBS@ EXAMPLES = @EXAMPLES@ @EXAMPLES_BL@ OBJECTS = ${EXAMPLES:=.o} # ----------------------------------------------------------------------------------------- .SUFFIXES : .o .f .f.o : ${F77} ${FFLAGS} -c $< # ----------------------------------------------------------------------------------------- all: ${OBJECTS} @for i in ${EXAMPLES} ; do \ echo "${F77_LNKR} -o $${i} $${i}.o ${F77_LDFLAGS} ${F77_LIBS} -L${libdir} ${LIBRARIES} ${LIBRARIES_BL}" ; \ ${F77_LNKR} -o $${i} $${i}.o ${F77_LDFLAGS} ${F77_LIBS} -L${libdir} ${LIBRARIES} ${LIBRARIES_BL} ; \ done clean: rm -f ${OBJECTS} rm -f ${EXAMPLES} # ----------------------------------------------------------------------------------------- sundials-2.5.0/examples/templates/makefile_serial_C_ex.in0000600000175000017500000000477411741421110024434 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.3 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for @SOLVER@ serial examples. # # This file is generated from a template using various variables # set at configuration time. It can be used as a template for # other user Makefiles. # # Note: if the solver was successfully configured with Blas/Lapack # support, the Blas/Lapack libraries are specified through the # variable LIBRARIES_BL. Otherwise, this variable should contain # an empty string. We include LIBRARIES_BL in the link line for # all examples, whether they use the Lapack module or not, to # address the case in which the SUNDIALS libraries are shared # objects. In that case, the solver library references Lapack # symbols which must be always resolved by linking against the # Blas/Lapack libraries. If only static SUNDIALS libraries have # been built, it is not required to link the Blas/Lapack libraries # for examples that do not use that module... # ----------------------------------------------------------------- SHELL = @SHELL@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ INCLUDES = -I${includedir} LIBRARIES = -l@SOLVER_LIB@ -lsundials_nvecserial ${LIBS} LIBRARIES_BL = @BLAS_LAPACK_LIBS@ EXAMPLES = @EXAMPLES@ @EXAMPLES_BL@ OBJECTS = ${EXAMPLES:=.o} # ----------------------------------------------------------------------------------------- .SUFFIXES : .o .c .c.o : ${CC} ${CPPFLAGS} ${CFLAGS} ${INCLUDES} -c $< # ----------------------------------------------------------------------------------------- all: ${OBJECTS} @for i in ${EXAMPLES} ; do \ echo "${CC} -o $${i} $${i}.o ${CFLAGS} ${LDFLAGS} -L${libdir} ${LIBRARIES} ${LIBRARIES_BL}" ; \ ${CC} -o $${i} $${i}.o ${CFLAGS} ${LDFLAGS} -L${libdir} ${LIBRARIES} ${LIBRARIES_BL}; \ done clean: rm -f ${OBJECTS} rm -f ${EXAMPLES} # ----------------------------------------------------------------------------------------- sundials-2.5.0/examples/kinsol/0000755000175000017500000000000011767174700017351 5ustar sylvestresylvestresundials-2.5.0/examples/kinsol/fcmix_parallel/0000755000175000017500000000000011767174700022333 5ustar sylvestresylvestresundials-2.5.0/examples/kinsol/fcmix_parallel/CMakeLists.txt0000600000175000017500000001023111741421273025050 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FKINSOL parallel examples # Add variable kinsol_examples with the names of the parallel KINSOL examples SET(FKINSOL_examples fkinDiagon_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the Fortran compiler to the MPIF77 script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPIF77 ) # use MPI_MPIF77 as the compiler SET(CMAKE_Fortran_COMPILER ${MPI_MPIF77}) ELSE(MPI_MPIF77) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPIF77) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_static) SET(NVECP_LIB sundials_nvecparallel_static) SET(FNVECP_LIB sundials_fnvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_shared) SET(NVECP_LIB sundials_nvecparallel_shared) SET(FNVECP_LIB sundials_fnvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FKINSOL_LIB sundials_fkinsol_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FKINSOL_LIB} ${KINSOL_LIB} ${FNVECP_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each KINSOL example FOREACH(example ${FKINSOL_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPIF77) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPIF77) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FKINSOL_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "KINSOL") SET(SOLVER_LIB "sundials_kinsol") SET(SOLVER_FLIB "sundials_fkinsol") LIST2STRING(FKINSOL_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_F77_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/kinsol/fcmix_parallel/Makefile.in0000600000175000017500000000741011741421273024362 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FKINSOL parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ FFLAGS = @FFLAGS@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ MPIF77 = @MPIF77@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_FLAGS = @MPI_FLAGS@ MPIF77_LNKR = @MPIF77_LNKR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/kinsol/fcmix/libsundials_fkinsol.la \ $(top_builddir)/src/kinsol/libsundials_kinsol.la \ $(top_builddir)/src/nvec_par/libsundials_fnvecparallel.la \ $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fkinDiagon_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${MPIF77} ${MPI_FLAGS} -I${MPI_INC_DIR} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${MPIF77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${MPI_FLAGS} ${F77_LDFLAGS} ${SUNDIALS_LIBS} -L${MPI_LIB_DIR} ${MPI_LIBS} ${F77_LIBS} $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/kinsol/fcmix_parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/kinsol/fcmix_parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_parallel/README $(EXS_INSTDIR)/kinsol/fcmix_parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_parallel/$${i}.f $(EXS_INSTDIR)/kinsol/fcmix_parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_parallel/$${i}.out $(EXS_INSTDIR)/kinsol/fcmix_parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/kinsol/fcmix_parallel/Makefile rm -f $(EXS_INSTDIR)/kinsol/fcmix_parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_parallel/$${i}.f ; \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/kinsol/fcmix_parallel $(rminstalldirs) $(EXS_INSTDIR)/kinsol clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/kinsol/fcmix_parallel/fkinDiagon_kry_p.out0000600000175000017500000000136511741421273026326 0ustar sylvestresylvestreExample program fkinDiagon_kry_p: This FKINSOL example solves a 128 eqn diagonal algebraic system. Its purpose is to demonstrate the use of the Fortran interface in a parallel environment. FKINSOL return code is 0 The resultant values of uu (process 0) are: 1 1.000000 2.000000 3.000000 4.000000 5 5.000000 6.000000 7.000000 8.000000 9 9.000000 10.000000 11.000000 12.000000 13 13.000000 14.000000 15.000000 16.000000 17 17.000000 18.000000 19.000000 20.000000 21 21.000000 22.000000 23.000000 24.000000 25 25.000000 26.000000 27.000000 28.000000 29 29.000000 30.000000 31.000000 32.000000 Final statistics: nni = 7, nli = 21 nfe = 8, npe = 2 nps = 28, ncfl = 0 sundials-2.5.0/examples/kinsol/fcmix_parallel/fkinDiagon_kry_p.f0000600000175000017500000001704511741421273025746 0ustar sylvestresylvestre program fkinDiagon_kry_p c ---------------------------------------------------------------- c $Revision: 1.2 $ c $Date: 2009/09/30 23:42:12 $ c ---------------------------------------------------------------- c Programmer(s): Allan G. Taylor, Alan C. Hindmarsh and c Radu Serban @ LLNL c ---------------------------------------------------------------- c Simple diagonal test with Fortran interface, using c user-supplied preconditioner setup and solve routines (supplied c in Fortran, below). c c This example does a basic test of the solver by solving the c system: c f(u) = 0 for c f(u) = u(i)^2 - i^2 c c No scaling is done. c An approximate diagonal preconditioner is used. c c Execution command: mpirun -np 4 fkinDiagon_kry_p c ---------------------------------------------------------------- c implicit none include "mpif.h" integer ier, size, globalstrat, rank, mype, npes integer maxl, maxlrst integer*4 localsize parameter(localsize=32) integer*4 neq, nlocal, msbpre, baseadd, i, ii integer*4 iout(15) double precision rout(2) double precision pp, fnormtol, scsteptol double precision uu(localsize), scale(localsize) double precision constr(localsize) common /pcom/ pp(localsize), mype, npes, baseadd, nlocal nlocal = localsize neq = 4 * nlocal globalstrat = 0 fnormtol = 1.0d-5 scsteptol = 1.0d-4 maxl = 10 maxlrst = 2 msbpre = 5 c The user MUST call mpi_init, Fortran binding, for the fkinsol package c to work. The communicator, MPI_COMM_WORLD, is the only one common c between the Fortran and C bindings. So in the following, the communicator c MPI_COMM_WORLD is used in calls to mpi_comm_size and mpi_comm_rank c to determine the total number of processors and the rank (0 ... size-1) c number of this process. call mpi_init(ier) if (ier .ne. 0) then write(6,1210) ier 1210 format('MPI_ERROR: MPI_INIT returned IER = ', i2) stop endif call fnvinitp(mpi_comm_world, 3, nlocal, neq, ier) if (ier .ne. 0) then write(6,1220) ier 1220 format('SUNDIALS_ERROR: FNVINITP returned IER = ', i2) call mpi_finalize(ier) stop endif call mpi_comm_size(mpi_comm_world, size, ier) if (ier .ne. 0) then write(6,1222) ier 1222 format('MPI_ERROR: MPI_COMM_SIZE returned IER = ', i2) call mpi_abort(mpi_comm_world, 1, ier) stop endif if (size .ne. 4) then write(6,1230) 1230 format('MPI_ERROR: must use 4 processes') call mpi_finalize(ier) stop endif npes = size call mpi_comm_rank(mpi_comm_world, rank, ier) if (ier .ne. 0) then write(6,1224) ier 1224 format('MPI_ERROR: MPI_COMM_RANK returned IER = ', i2) call mpi_abort(mpi_comm_world, 1, ier) stop endif mype = rank baseadd = mype * nlocal do 20 ii = 1, nlocal i = ii + baseadd uu(ii) = 2.0d0 * i scale(ii) = 1.0d0 constr(ii) = 0.0d0 20 continue call fkinmalloc(iout, rout, ier) if (ier .ne. 0) then write(6,1231)ier 1231 format('SUNDIALS_ERROR: FKINMALLOC returned IER = ', i2) call mpi_abort(mpi_comm_world, 1, ier) stop endif call fkinsetiin('MAX_SETUPS', msbpre, ier) call fkinsetrin('FNORM_TOL', fnormtol, ier) call fkinsetrin('SSTEP_TOL', scsteptol, ier) call fkinsetvin('CONSTR_VEC', constr, ier) call fkinspgmr(maxl, maxlrst, ier) call fkinspilssetprec(1, ier) if (mype .eq. 0) write(6,1240) 1240 format('Example program fkinDiagon_kry_p:'// 1 ' This FKINSOL example', 2 ' solves a 128 eqn diagonal algebraic system.'/ 3 ' Its purpose is to demonstrate the use of the Fortran', 4 ' interface'/' in a parallel environment.') call fkinsol(uu, globalstrat, scale, scale, ier) if (ier .lt. 0) then write(6,1242) ier, iout(9) 1242 format('SUNDIALS_ERROR: FKINSOL returned IER = ', i2, /, 1 ' Linear Solver returned IER = ', i2) call mpi_abort(mpi_comm_world, 1, ier) stop endif if (mype .eq. 0) write(6,1245) ier 1245 format(/' FKINSOL return code is ', i4) if (mype .eq. 0) write(6,1246) 1246 format(/' The resultant values of uu (process 0) are:'/) do 30 i = 1, nlocal, 4 if(mype .eq. 0) write(6,1256) i + baseadd, uu(i), uu(i+1), 1 uu(i+2), uu(i+3) 1256 format(i4, 4(1x, f10.6)) 30 continue if (mype .eq. 0) write(6,1267) iout(3), iout(14), iout(4), 1 iout(12), iout(13), iout(15) 1267 format(/'Final statistics:'// 1 ' nni = ', i3, ', nli = ', i3, /, 2 ' nfe = ', i3, ', npe = ', i3, /, 3 ' nps = ', i3, ', ncfl = ', i3) call fkinfree c An explicit call to mpi_finalize (Fortran binding) is required by c the constructs used in fkinsol. call mpi_finalize(ier) stop end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The function defining the system f(u) = 0 must be defined by a Fortran c function with the following name and form. subroutine fkfun(uu, fval, ier) implicit none integer mype, npes, ier integer*4 baseadd, nlocal, i, localsize parameter(localsize=32) double precision pp double precision fval(*), uu(*) common /pcom/ pp(localsize), mype, npes, baseadd, nlocal do 10 i = 1, nlocal 10 fval(i) = uu(i) * uu(i) - (i + baseadd) * (i + baseadd) return end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The routine kpreco is the preconditioner setup routine. It must have c that specific name be used in order that the c code can find and link c to it. The argument list must also be as illustrated below: subroutine fkpset(udata, uscale, fdata, fscale, 1 vtemp1, vtemp2, ier) implicit none integer ier, mype, npes integer*4 localsize parameter(localsize=32) integer*4 baseadd, nlocal, i double precision pp double precision udata(*), uscale(*), fdata(*), fscale(*) double precision vtemp1(*), vtemp2(*) common /pcom/ pp(localsize), mype, npes, baseadd, nlocal do 10 i = 1, nlocal 10 pp(i) = 0.5d0 / (udata(i)+ 5.0d0) ier = 0 return end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The routine kpsol is the preconditioner solve routine. It must have c that specific name be used in order that the c code can find and link c to it. The argument list must also be as illustrated below: subroutine fkpsol(udata, uscale, fdata, fscale, 1 vv, ftem, ier) implicit none integer ier, mype, npes integer*4 baseadd, nlocal, i integer*4 localsize parameter(localsize=32) double precision udata(*), uscale(*), fdata(*), fscale(*) double precision vv(*), ftem(*) double precision pp common /pcom/ pp(localsize), mype, npes, baseadd, nlocal do 10 i = 1, nlocal 10 vv(i) = vv(i) * pp(i) ier = 0 return end sundials-2.5.0/examples/kinsol/fcmix_parallel/README0000600000175000017500000000075111741421273023176 0ustar sylvestresylvestreList of parallel KINSOL FCMIX examples fkinDiagon_kry_p: simple diagonal test with Fortran interface Sample result: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 (GCC) MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/kinsol/parallel/0000755000175000017500000000000011767174700021145 5ustar sylvestresylvestresundials-2.5.0/examples/kinsol/parallel/kinFoodWeb_kry_p.out0000600000175000017500000000142711741421273025115 0ustar sylvestresylvestre Predator-prey test problem -- KINSol (parallel version) Mesh dimensions = 20 X 20 Number of species = 6 Total system size = 2400 Subgrid dimensions = 10 X 10 Processor array is 2 X 2 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPGMR with maxl = 20, maxlrst = 2 Preconditioning uses interaction-only block-diagonal matrix Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.165 1.165 1.165 34949 34949 34949 At top right: 1.25552 1.25552 1.25552 37663.2 37663.2 37663.2 Final Statistics.. nni = 19 nli = 1140 nfe = 20 nfeSG = 1159 nps = 1159 npe = 2 ncfl = 19 sundials-2.5.0/examples/kinsol/parallel/CMakeLists.txt0000600000175000017500000000754211741421273023675 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.4 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for KINSOL parallel examples # Add variable KINSOL_examples with the names of the parallel KINSOL examples SET(KINSOL_examples kinFoodWeb_kry_bbd_p kinFoodWeb_kry_p ) # Check whether we use MPI compiler scripts. # If yes, then change the C compiler to the MPICC script. # If not, then add the MPI include directory for MPI headers. IF(MPI_MPICC) # use MPI_MPICC as the compiler SET(CMAKE_C_COMPILER ${MPI_MPICC}) ELSE(MPI_MPICC) # add MPI_INCLUDE_PATH to include directories INCLUDE_DIRECTORIES(${MPI_INCLUDE_PATH}) ENDIF(MPI_MPICC) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_static) SET(NVECP_LIB sundials_nvecparallel_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_shared) SET(NVECP_LIB sundials_nvecparallel_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${KINSOL_LIB} ${NVECP_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each KINSOL example FOREACH(example ${KINSOL_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(NOT MPI_MPICC) TARGET_LINK_LIBRARIES(${example} ${MPI_LIBRARY} ${MPI_EXTRA_LIBRARIES}) ENDIF(NOT MPI_MPICC) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/parallel) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${KINSOL_examples}) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/parallel) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "KINSOL") SET(SOLVER_LIB "sundials_kinsol") LIST2STRING(KINSOL_examples EXAMPLES) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/parallel/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/parallel/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/parallel ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_parallel_C_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/parallel/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/parallel/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/parallel RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/kinsol/parallel/Makefile.in0000600000175000017500000000706411741421273023201 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.9 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for KINSOL parallel examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ MPICC = @MPICC@ MPI_INC_DIR = @MPI_INC_DIR@ MPI_LIB_DIR = @MPI_LIB_DIR@ MPI_LIBS = @MPI_LIBS@ MPI_FLAGS = @MPI_FLAGS@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/kinsol/libsundials_kinsol.la \ $(top_builddir)/src/nvec_par/libsundials_nvecparallel.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = kinFoodWeb_kry_bbd_p \ kinFoodWeb_kry_p OBJECTS = ${EXAMPLES:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(MPICC) $(CPPFLAGS) $(MPI_FLAGS) $(SUNDIALS_INCS) -I$(MPI_INC_DIR) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(MPICC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}$(OBJ_EXT) $(MPI_FLAGS) $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) -L$(MPI_LIB_DIR) $(MPI_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done install: $(mkinstalldirs) $(EXS_INSTDIR)/kinsol/parallel $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/kinsol/parallel/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/parallel/README $(EXS_INSTDIR)/kinsol/parallel/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/parallel/$${i}.c $(EXS_INSTDIR)/kinsol/parallel/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/parallel/$${i}.out $(EXS_INSTDIR)/kinsol/parallel/ ; \ done uninstall: rm -f $(EXS_INSTDIR)/kinsol/parallel/Makefile rm -f $(EXS_INSTDIR)/kinsol/parallel/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/kinsol/parallel/$${i}.c ; \ rm -f $(EXS_INSTDIR)/kinsol/parallel/$${i}.out ; \ done $(rminstalldirs) $(EXS_INSTDIR)/kinsol/parallel $(rminstalldirs) $(EXS_INSTDIR)/kinsol clean: rm -rf .libs rm -f *.lo *.o rm -f ${OBJECTS} rm -f $(EXECS) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/kinsol/parallel/kinFoodWeb_kry_bbd_p.out0000600000175000017500000000162711741421273025726 0ustar sylvestresylvestre Predator-prey test problem-- KINSol (parallel-BBD version) Mesh dimensions = 20 X 20 Number of species = 6 Total system size = 2400 Subgrid dimensions = 10 X 10 Processor array is 2 X 2 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPGMR with maxl = 20, maxlrst = 2 Preconditioning uses band-block-diagonal matrix from KINBBDPRE Difference quotient half-bandwidths: mudq = 11, mldq = 11 Retained band block half-bandwidths: mukeep = 6, mlkeep = 6 Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.165 1.165 1.165 34949 34949 34949 At top right: 1.25552 1.25552 1.25552 37663.2 37663.2 37663.2 Final Statistics.. nni = 9 nli = 464 nfe = 10 nfeSG = 473 nps = 473 npe = 1 ncfl = 6 sundials-2.5.0/examples/kinsol/parallel/kinFoodWeb_kry_p.c0000600000175000017500000010464211741421273024533 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 23:09:24 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example (parallel): * * This example solves a nonlinear system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector * is the following: * * 1 2 ns * c = (c , c , ..., c ) (denoted by the variable cc) * * and the PDE's are as follows: * * i i * 0 = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The number np is both * the number of prey and predator species. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * b(i) = BB * (1 + alpha * x * y) (i <= np) * b(i) =-BB * (1 + alpha * x * y) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED ( i > np) * * The various scalar parameters are set using define's or in * routine InitUserData. * * The boundary conditions are: normal derivative = 0, and the * initial guess is constant in x and y, although the final * solution is not. * * The PDEs are discretized by central differencing on a MX by * MY mesh. * * The nonlinear system is solved by KINSOL using the method * specified in the local variable globalstrat. * * The preconditioner matrix is a block-diagonal matrix based on * the partial derivatives of the interaction terms f only. * ----------------------------------------------------------------- * References: * * 1. Peter N. Brown and Youcef Saad, * Hybrid Krylov Methods for Nonlinear Systems of Equations * LLNL report UCRL-97645, November 1987. * * 2. Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Lawrence Livermore National Laboratory Report UCRL-95088, * Rev. 1, June 1987, and Journal of Applied Mathematics and * Computation, Vol. 31 (May 1989), pp. 40-91. (Presents a * description of the time-dependent version of this test * problem.) * ---------------------------------------------------------------------- * Run command line: mpirun -np N -machinefile machines kinFoodWeb_kry_p * where N = NPEX * NPEY is the number of processors. * ---------------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 6 /* must equal 2*(number of prey or predators) number of prey = number of predators */ #define PI RCONST(3.1415926535898) /* pi */ #define NPEX 2 /* number of processors in the x-direction */ #define NPEY 2 /* number of processors in the y-direction */ #define MXSUB 10 /* number of x mesh points per subgrid */ #define MYSUB 10 /* number of y mesh points per subgrid */ #define MX (NPEX*MXSUB) /* number of mesh points in the x-direction */ #define MY (NPEY*MYSUB) /* number of mesh points in the y-direction */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NSMXSUB2 (NUM_SPECIES * (MXSUB+2)) #define NEQ (NUM_SPECIES*MX*MY) /* number of equations in the system */ #define AA RCONST(1.0) /* value of coefficient AA in above eqns */ #define EE RCONST(10000.) /* value of coefficient EE in above eqns */ #define GG RCONST(0.5e-6) /* value of coefficient GG in above eqns */ #define BB RCONST(1.0) /* value of coefficient BB in above eqns */ #define DPREY RCONST(1.0) /* value of coefficient dprey above */ #define DPRED RCONST(0.5) /* value of coefficient dpred above */ #define ALPHA RCONST(1.0) /* value of coefficient alpha above */ #define AX RCONST(1.0) /* total range of x variable */ #define AY RCONST(1.0) /* total range of y variable */ #define FTOL RCONST(1.e-7) /* ftol tolerance */ #define STOL RCONST(1.e-13) /* stol tolerance */ #define THOUSAND RCONST(1000.0) /* one thousand */ #define ZERO RCONST(0.0) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define PREYIN RCONST(1.0) /* initial guess for prey concentrations. */ #define PREDIN RCONST(30000.0)/* initial guess for predator concs. */ /* User-defined vector access macro: IJ_Vptr */ /* IJ_Vptr is defined in order to translate from the underlying 3D structure of the dependent variable vector to the 1D storage scheme for an N-vector. IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to indices is = 0, jx = i, jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, i*NUM_SPECIES + j*NSMXSUB)) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MXSUB][MYSUB]; long int *pivot[MXSUB][MYSUB]; realtype **acoef, *bcoef; N_Vector rates; realtype *cox, *coy; realtype ax, ay, dx, dy; realtype uround, sqruround; int mx, my, ns, np; realtype cext[NUM_SPECIES * (MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby, nsmxsub, nsmxsub2; MPI_Comm comm; } *UserData; /* Functions Called by the KINSol Solver */ static int funcprpr(N_Vector cc, N_Vector fval, void *user_data); static int Precondbd(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); static int PSolvebd(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector vtemp); /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(int my_pe, MPI_Comm comm, UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector cc, N_Vector sc); static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol); static void PrintOutput(int my_pe, MPI_Comm comm, N_Vector cc); static void PrintFinalStats(void *kmem); static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data); static realtype DotProd(int size, realtype *x1, realtype *x2); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cdata); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cext, realtype *buffer); static void BRecvWait(MPI_Request request[], int isubx, int isuby, int dsizex, realtype *cext, realtype *buffer); static void ccomm(realtype *cdata, UserData data); static void fcalcprpr(N_Vector cc, N_Vector fval,void *user_data); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { int globalstrategy; long int local_N; realtype fnormtol, scsteptol; N_Vector cc, sc, constraints; UserData data; int flag, maxl, maxlrst; int my_pe, npes, npelast = NPEX*NPEY-1; void *kmem; MPI_Comm comm; cc = sc = constraints = NULL; data = NULL; kmem = NULL; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0); npes = %d is not equal to NPEX*NPEY = %d\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Allocate memory, and set problem data, initial values, tolerances */ /* Set local vector length */ local_N = NUM_SPECIES*MXSUB*MYSUB; /* Allocate and initialize user data block */ data = AllocUserData(); if (check_flag((void *)data, "AllocUserData", 0, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, comm, data); /* Set global strategy flag */ globalstrategy = KIN_NONE; /* Allocate and initialize vectors */ cc = N_VNew_Parallel(comm, local_N, NEQ); if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); sc = N_VNew_Parallel(comm, local_N, NEQ); if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); data->rates = N_VNew_Parallel(comm, local_N, NEQ); if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, local_N, NEQ); if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); N_VConst(ZERO, constraints); SetInitialProfiles(cc, sc); fnormtol=FTOL; scsteptol=STOL; /* Call KINCreate/KINInit to initialize KINSOL: nvSpec is the nvSpec pointer used in the parallel version A pointer to KINSOL problem memory is returned and stored in kmem. */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Vector cc passed as template vector. */ flag = KINInit(kmem, funcprpr, cc); if (check_flag(&flag, "KINInit", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetNumMaxIters(kmem, 250); if (check_flag(&flag, "KINSetNumMaxIters", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetUserData(kmem, data); if (check_flag(&flag, "KINSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetConstraints(kmem, constraints); if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTop", 1, my_pe)) MPI_Abort(comm, 1); /* We no longer need the constraints vector since KINSetConstraints creates a private copy for KINSOL to use. */ N_VDestroy_Parallel(constraints); /* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner routines Precondbd and PSolvebd, and the pointer to the user data block. */ maxl = 20; maxlrst = 2; flag = KINSpgmr(kmem, maxl); if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSpilsSetMaxRestarts(kmem, maxlrst); if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSpilsSetPreconditioner(kmem, Precondbd, PSolvebd); if (check_flag(&flag, "KINSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1); /* Print out the problem size, solution parameters, initial guess. */ if (my_pe == 0) PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol); /* Call KINSol and print output concentration profile */ flag = KINSol(kmem, /* KINSol memory block */ cc, /* initial guess on input; solution vector */ globalstrategy, /* global stragegy choice */ sc, /* scaling vector for the variable cc */ sc); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) printf("\n\nComputed equilibrium species concentrations:\n"); if (my_pe == 0 || my_pe == npelast) PrintOutput(my_pe, comm, cc); /* Print final statistics and free memory */ if (my_pe == 0) PrintFinalStats(kmem); N_VDestroy_Parallel(cc); N_VDestroy_Parallel(sc); KINFree(&kmem); FreeUserData(data); MPI_Finalize(); return(0); } /* Readability definitions used in other routines below */ #define acoef (data->acoef) #define bcoef (data->bcoef) #define cox (data->cox) #define coy (data->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * System function routine. Evaluate funcprpr(cc). First call ccomm to do * communication of subgrid boundary data into cext. Then calculate funcprpr * by a call to fcalcprpr. */ static int funcprpr(N_Vector cc, N_Vector fval, void *user_data) { realtype *cdata, *fvdata; UserData data; cdata = NV_DATA_P(cc); fvdata = NV_DATA_P(fval); data = (UserData) user_data; /* Call ccomm to do inter-processor communicaiton */ ccomm (cdata, data); /* Call fcalcprpr to calculate all right-hand sides */ fcalcprpr (cc, fval, data); return(0); } /* * Preconditioner setup routine. Generate and preprocess P. */ static int Precondbd(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype r, r0, uround, sqruround, xx, yy, delx, dely, csave, fac; realtype *cxy, *scxy, **Pxy, *ratesxy, *Pxycol, perturb_rates[NUM_SPECIES]; int i, j, jx, jy, ret; UserData data; data = (UserData)user_data; delx = data->dx; dely = data->dy; uround = data->uround; sqruround = data->sqruround; fac = N_VWL2Norm(fval, fscale); r0 = THOUSAND * uround * fac * NEQ; if(r0 == ZERO) r0 = ONE; /* Loop over spatial points; get size NUM_SPECIES Jacobian block at each */ for (jy = 0; jy < MYSUB; jy++) { yy = dely*(jy + data->isuby * MYSUB); for (jx = 0; jx < MXSUB; jx++) { xx = delx*(jx + data->isubx * MXSUB); Pxy = (data->P)[jx][jy]; cxy = IJ_Vptr(cc,jx,jy); scxy= IJ_Vptr(cscale,jx,jy); ratesxy = IJ_Vptr((data->rates),jx,jy); /* Compute difference quotients of interaction rate fn. */ for (j = 0; j < NUM_SPECIES; j++) { csave = cxy[j]; /* Save the j,jx,jy element of cc */ r = MAX(sqruround*ABS(csave), r0/scxy[j]); cxy[j] += r; /* Perturb the j,jx,jy element of cc */ fac = ONE/r; WebRate(xx, yy, cxy, perturb_rates, data); /* Restore j,jx,jy element of cc */ cxy[j] = csave; /* Load the j-th column of difference quotients */ Pxycol = Pxy[j]; for (i = 0; i < NUM_SPECIES; i++) Pxycol[i] = (perturb_rates[i] - ratesxy[i]) * fac; } /* end of j loop */ /* Do LU decomposition of size NUM_SPECIES preconditioner block */ ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (data->pivot)[jx][jy]); if (ret != 0) return(1); } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * Preconditioner solve routine */ static int PSolvebd(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector vtemp) { realtype **Pxy, *vxy; long int *piv, jx, jy; UserData data; data = (UserData)user_data; for (jx = 0; jx < MXSUB; jx++) { for (jy = 0; jy < MYSUB; jy++) { /* For each (jx,jy), solve a linear system of size NUM_SPECIES. vxy is the address of the corresponding portion of the vector vv; Pxy is the address of the corresponding block of the matrix P; piv is the address of the corresponding block of the array pivot. */ vxy = IJ_Vptr(vv,jx,jy); Pxy = (data->P)[jx][jy]; piv = (data->pivot)[jx][jy]; denseGETRS(Pxy, NUM_SPECIES, piv, vxy); } /* end of jy loop */ } /* end of jx loop */ return(0); } /* * Interaction rate function routine */ static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data) { int i; realtype fac; UserData data; data = (UserData)user_data; for (i = 0; iP)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); bcoef = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); cox = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); coy = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); return(data); } /* * Load problem constants in data */ static void InitUserData(int my_pe, MPI_Comm comm, UserData data) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2; data->mx = MX; data->my = MY; data->ns = NUM_SPECIES; data->np = NUM_SPECIES/2; data->ax = AX; data->ay = AY; data->dx = (data->ax)/(MX-1); data->dy = (data->ay)/(MY-1); data->uround = UNIT_ROUNDOFF; data->sqruround = SQRT(data->uround); data->my_pe = my_pe; data->comm = comm; data->isuby = my_pe/NPEX; data->isubx = my_pe - data->isuby*NPEX; data->nsmxsub = NUM_SPECIES * MXSUB; data->nsmxsub2 = NUM_SPECIES * (MXSUB+2); /* Set up the coefficients a and b plus others found in the equations */ np = data->np; dx2=(data->dx)*(data->dx); dy2=(data->dy)*(data->dy); for (i = 0; i < np; i++) { a1= &(acoef[i][np]); a2= &(acoef[i+np][0]); a3= &(acoef[i][0]); a4= &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* and then change the diagonal elements of acoef to -AA */ acoef[i][i]=-AA; acoef[i+np][i+np] = -AA; bcoef[i] = BB; bcoef[i+np] = -BB; cox[i]=DPREY/dx2; cox[i+np]=DPRED/dx2; coy[i]=DPREY/dy2; coy[i+np]=DPRED/dy2; } } /* * Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx = 0; jx < MXSUB; jx++) { for (jy = 0; jy < MYSUB; jy++) { destroyMat((data->P)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } destroyMat(acoef); free(bcoef); free(cox); free(coy); N_VDestroy_Parallel(data->rates); free(data); } /* * Set initial conditions in cc */ static void SetInitialProfiles(N_Vector cc, N_Vector sc) { int i, jx, jy; realtype *cloc, *sloc; realtype ctemp[NUM_SPECIES], stemp[NUM_SPECIES]; /* Initialize arrays ctemp and stemp used in the loading process */ for (i = 0; i < NUM_SPECIES/2; i++) { ctemp[i] = PREYIN; stemp[i] = ONE; } for (i = NUM_SPECIES/2; i < NUM_SPECIES; i++) { ctemp[i] = PREDIN; stemp[i] = RCONST(0.00001); } /* Load initial profiles into cc and sc vector from ctemp and stemp. */ for (jy = 0; jy < MYSUB; jy++) { for (jx = 0; jx < MXSUB; jx++) { cloc = IJ_Vptr(cc,jx,jy); sloc = IJ_Vptr(sc,jx,jy); for (i = 0; i < NUM_SPECIES; i++) { cloc[i] = ctemp[i]; sloc[i] = stemp[i]; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol) { printf("\nPredator-prey test problem -- KINSol (parallel version)\n\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Number of species = %d\n", NUM_SPECIES); printf("Total system size = %d\n\n", NEQ); printf("Subgrid dimensions = %d X %d\n", MXSUB, MYSUB); printf("Processor array is %d X %d\n\n", NPEX, NPEY); printf("Flag globalstrategy = %d (0 = None, 1 = Linesearch)\n", globalstrategy); printf("Linear solver is SPGMR with maxl = %d, maxlrst = %d\n", maxl, maxlrst); printf("Preconditioning uses interaction-only block-diagonal matrix\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: fnormtol = %Lg scsteptol = %Lg\n", fnormtol, scsteptol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: fnormtol = %lg scsteptol = %lg\n", fnormtol, scsteptol); #else printf("Tolerance parameters: fnormtol = %g scsteptol = %g\n", fnormtol, scsteptol); #endif printf("\nInitial profile of concentration\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At all mesh points: %Lg %Lg %Lg %Lg %Lg %Lg\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At all mesh points: %lg %lg %lg %lg %lg %lg\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #else printf("At all mesh points: %g %g %g %g %g %g\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #endif } /* * Print sample of current cc values */ static void PrintOutput(int my_pe, MPI_Comm comm, N_Vector cc) { int is, i0, npelast; realtype *ct, tempc[NUM_SPECIES]; MPI_Status status; npelast = NPEX*NPEY - 1; ct = NV_DATA_P(cc); /* Send the cc values (for all species) at the top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NUM_SPECIES*(MXSUB*MYSUB-1); if (npelast!=0) MPI_Send(&ct[i0],NUM_SPECIES,PVEC_REAL_MPI_TYPE,0,0,comm); else /* single processor case */ for (is = 0; is < NUM_SPECIES; is++) tempc[is]=ct[i0+is]; } /* On PE 0, receive the cc values at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempc[0],NUM_SPECIES,PVEC_REAL_MPI_TYPE,npelast,0,comm,&status); printf("\nAt bottom left:"); for (is = 0; is < NUM_SPECIES; is++) { if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } printf("\n\nAt top right:"); for (is = 0; is < NUM_SPECIES; is++) { if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",tempc[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",tempc[is]); #else printf(" %g",tempc[is]); #endif } printf("\n\n"); } } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nli, npe, nps, ncfl, nfeSG; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1, 0); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1, 0); flag = KINSpilsGetNumLinIters(kmem, &nli); check_flag(&flag, "KINSpilsGetNumLinIters", 1, 0); flag = KINSpilsGetNumPrecEvals(kmem, &npe); check_flag(&flag, "KINSpilsGetNumPrecEvals", 1, 0); flag = KINSpilsGetNumPrecSolves(kmem, &nps); check_flag(&flag, "KINSpilsGetNumPrecSolves", 1, 0); flag = KINSpilsGetNumConvFails(kmem, &ncfl); check_flag(&flag, "KINSpilsGetNumConvFails", 1, 0); flag = KINSpilsGetNumFuncEvals(kmem, &nfeSG); check_flag(&flag, "KINSpilsGetNumFuncEvals", 1, 0); printf("Final Statistics.. \n"); printf("nni = %5ld nli = %5ld\n", nni, nli); printf("nfe = %5ld nfeSG = %5ld\n", nfe, nfeSG); printf("nps = %5ld npe = %5ld ncfl = %5ld\n", nps, npe, ncfl); } /* * Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cdata) { int i, ly; int offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cext, realtype *buffer) { int offsetce; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If isuby > 0, receive data for bottom x-line of cext */ if (isuby != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of cext */ if (isuby != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of cext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of cext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, int dsizex, realtype *cext, realtype *buffer) { int i, ly; int dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If isuby > 0, receive data for bottom x-line of cext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of cext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of cext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of cext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * ccomm routine. This routine performs all communication * between processors of data needed to calculate f. */ static void ccomm(realtype *cdata, UserData data) { realtype *cext, buffer[2*NUM_SPECIES*MYSUB]; MPI_Comm comm; int my_pe, isubx, isuby, nsmxsub, nsmysub; MPI_Request request[4]; /* Get comm, my_pe, subgrid indices, data sizes, extended array cext */ comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nsmxsub = data->nsmxsub; nsmysub = NUM_SPECIES*MYSUB; cext = data->cext; /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nsmxsub, cext, buffer); } /* * System function for predator-prey system - calculation part */ static void fcalcprpr(N_Vector cc, N_Vector fval, void *user_data) { realtype xx, yy, *cxy, *rxy, *fxy, dcydi, dcyui, dcxli, dcxri; realtype *cext, dely, delx, *cdata; int i, jx, jy, is, ly; int isubx, isuby, nsmxsub, nsmxsub2; int shifty, offsetc, offsetce, offsetcl, offsetcr, offsetcd, offsetcu; UserData data; data = (UserData)user_data; cdata = NV_DATA_P(cc); /* Get subgrid indices, data sizes, extended work array cext */ isubx = data->isubx; isuby = data->isuby; nsmxsub = data->nsmxsub; nsmxsub2 = data->nsmxsub2; cext = data->cext; /* Copy local segment of cc vector into the working extended array cext */ offsetc = 0; offsetce = nsmxsub2 + NUM_SPECIES; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i]; offsetc = offsetc + nsmxsub; offsetce = offsetce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext */ /* If isuby = 0, copy x-line 2 of cc to cext */ if (isuby == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of cc to cext */ if (isuby == NPEY-1) { offsetc = (MYSUB-2)*nsmxsub; offsetce = (MYSUB+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i]; } /* If isubx = 0, copy y-line 2 of cc to cext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetc = ly*nsmxsub + NUM_SPECIES; offsetce = (ly+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of cc to cext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetc = (ly+1)*nsmxsub - 2*NUM_SPECIES; offsetce = (ly+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i]; } } /* Loop over all mesh points, evaluating rate arra at each point */ delx = data->dx; dely = data->dy; shifty = (MXSUB+2)*NUM_SPECIES; for (jy = 0; jy < MYSUB; jy++) { yy = dely*(jy + isuby * MYSUB); for (jx = 0; jx < MXSUB; jx++) { xx = delx * (jx + isubx * MXSUB); cxy = IJ_Vptr(cc,jx,jy); rxy = IJ_Vptr(data->rates,jx,jy); fxy = IJ_Vptr(fval,jx,jy); WebRate(xx, yy, cxy, rxy, user_data); offsetc = (jx+1)*NUM_SPECIES + (jy+1)*NSMXSUB2; offsetcd = offsetc - shifty; offsetcu = offsetc + shifty; offsetcl = offsetc - NUM_SPECIES; offsetcr = offsetc + NUM_SPECIES; for (is = 0; is < NUM_SPECIES; is++) { /* differencing in x */ dcydi = cext[offsetc+is] - cext[offsetcd+is]; dcyui = cext[offsetcu+is] - cext[offsetc+is]; /* differencing in y */ dcxli = cext[offsetc+is] - cext[offsetcl+is]; dcxri = cext[offsetcr+is] - cext[offsetc+is]; /* compute the value at xx , yy */ fxy[is] = (coy)[is] * (dcyui - dcydi) + (cox)[is] * (dcxri - dcxli) + rxy[is]; } /* end of is loop */ } /* end of jx loop */ } /* end of jy loop */ } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/parallel/kinFoodWeb_kry_bbd_p.c0000600000175000017500000007707711741421273025355 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.4 $ * $Date: 2010/12/01 23:09:24 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example problem for KINSOL (parallel machine case) using the BBD * preconditioner. * * This example solves a nonlinear system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion on * the unit square in two dimensions. The dependent variable vector * is the following: * * 1 2 ns * c = (c , c , ..., c ) (denoted by the variable cc) * * and the PDE's are as follows: * * i i * 0 = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The number np is both the * number of prey and predator species. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * b(i) = BB * (1 + alpha * x * y) (i <= np) * b(i) =-BB * (1 + alpha * x * y) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED ( i > np) * * The various scalar parameters are set using define's or in * routine InitUserData. * * The boundary conditions are: normal derivative = 0, and the * initial guess is constant in x and y, although the final * solution is not. * * The PDEs are discretized by central differencing on a MX by * MY mesh. * * The nonlinear system is solved by KINSOL using the method * specified in the local variable globalstrat. * * The preconditioner matrix is a band-block-diagonal matrix * using the KINBBDPRE module. The half-bandwidths are as follows: * * Difference quotient half-bandwidths mldq = mudq = 2*ns - 1 * Retained banded blocks have half-bandwidths mlkeep = mukeep = ns. * * ----------------------------------------------------------------- * References: * * 1. Peter N. Brown and Youcef Saad, * Hybrid Krylov Methods for Nonlinear Systems of Equations * LLNL report UCRL-97645, November 1987. * * 2. Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Lawrence Livermore National Laboratory Report UCRL-95088, * Rev. 1, June 1987, and Journal of Applied Mathematics and * Computation, Vol. 31 (May 1989), pp. 40-91. (Presents a * description of the time-dependent version of this * test problem.) * -------------------------------------------------------------------------- * Run command line: mpirun -np N -machinefile machines kinFoodWeb_kry_bbd_p * where N = NPEX * NPEY is the number of processors. * -------------------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 6 /* must equal 2*(number of prey or predators) number of prey = number of predators */ #define PI RCONST(3.1415926535898) /* pi */ #define NPEX 2 /* number of processors in the x-direction */ #define NPEY 2 /* number of processors in the y-direction */ #define MXSUB 10 /* number of x mesh points per subgrid */ #define MYSUB 10 /* number of y mesh points per subgrid */ #define MX (NPEX*MXSUB) /* number of grid points in x-direction */ #define MY (NPEY*MYSUB) /* number of grid points in y-direction */ #define NSMXSUB (NUM_SPECIES * MXSUB) #define NSMXSUB2 (NUM_SPECIES * (MXSUB+2)) #define NEQ (NUM_SPECIES*MX*MY) /* number of equations in system */ #define AA RCONST(1.0) /* value of coefficient AA in above eqns */ #define EE RCONST(10000.) /* value of coefficient EE in above eqns */ #define GG RCONST(0.5e-6) /* value of coefficient GG in above eqns */ #define BB RCONST(1.0) /* value of coefficient BB in above eqns */ #define DPREY RCONST(1.0) /* value of coefficient dprey above */ #define DPRED RCONST(0.5) /* value of coefficient dpred above */ #define ALPHA RCONST(1.0) /* value of coefficient alpha above */ #define AX RCONST(1.0) /* total range of x variable */ #define AY RCONST(1.0) /* total range of y variable */ #define FTOL RCONST(1.e-7) /* ftol tolerance */ #define STOL RCONST(1.e-13) /* stol tolerance */ #define THOUSAND RCONST(1000.0) /* one thousand */ #define ZERO RCONST(0.0) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define PREYIN RCONST(1.0) /* initial guess for prey concentrations. */ #define PREDIN RCONST(30000.0)/* initial guess for predator concs. */ /* User-defined vector access macro: IJ_Vptr */ /* IJ_Vptr is defined in order to translate from the underlying 3D structure of the dependent variable vector to the 1D storage scheme for an N-vector. IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to indices is = 0, jx = i, jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_P(vv, i*NUM_SPECIES + j*NSMXSUB)) /* Type : UserData contains problem constants and extended array */ typedef struct { realtype **acoef, *bcoef; N_Vector rates; realtype *cox, *coy; realtype ax, ay, dx, dy; long int Nlocal; int mx, my, ns, np; realtype cext[NUM_SPECIES * (MXSUB+2)*(MYSUB+2)]; int my_pe, isubx, isuby, nsmxsub, nsmxsub2; MPI_Comm comm; } *UserData; /* Function called by the KINSol Solver */ static int func(N_Vector cc, N_Vector fval, void *user_data); static int ccomm(long int Nlocal, N_Vector cc, void *data); static int func_local(long int Nlocal, N_Vector cc, N_Vector fval, void *user_data); /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(int my_pe, long int Nlocal, MPI_Comm comm, UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector cc, N_Vector sc); static void PrintHeader(int globalstrategy, int maxl, int maxlrst, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype fnormtol, realtype scsteptol); static void PrintOutput(int my_pe, MPI_Comm comm, N_Vector cc); static void PrintFinalStats(void *kmem); static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data); static realtype DotProd(int size, realtype *x1, realtype *x2); static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cdata); static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cext, realtype *buffer); static void BRecvWait(MPI_Request request[], int isubx, int isuby, int dsizex, realtype *cext, realtype *buffer); static int check_flag(void *flagvalue, char *funcname, int opt, int id); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(int argc, char *argv[]) { MPI_Comm comm; void *kmem; UserData data; N_Vector cc, sc, constraints; int globalstrategy; long int Nlocal; realtype fnormtol, scsteptol, dq_rel_uu; int flag, maxl, maxlrst; long int mudq, mldq, mukeep, mlkeep; int my_pe, npes, npelast = NPEX*NPEY-1; data = NULL; kmem = NULL; cc = sc = constraints = NULL; /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) printf("\nMPI_ERROR(0): npes=%d is not equal to NPEX*NPEY=%d\n", npes, NPEX*NPEY); return(1); } /* Allocate memory, and set problem data, initial values, tolerances */ /* Set local length */ Nlocal = NUM_SPECIES*MXSUB*MYSUB; /* Allocate and initialize user data block */ data = AllocUserData(); if (check_flag((void *)data, "AllocUserData", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, Nlocal, comm, data); /* Choose global strategy */ globalstrategy = KIN_NONE; /* Allocate and initialize vectors */ cc = N_VNew_Parallel(comm, Nlocal, NEQ); if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); sc = N_VNew_Parallel(comm, Nlocal, NEQ); if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); data->rates = N_VNew_Parallel(comm, Nlocal, NEQ); if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); constraints = N_VNew_Parallel(comm, Nlocal, NEQ); if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1); N_VConst(ZERO, constraints); SetInitialProfiles(cc, sc); fnormtol = FTOL; scsteptol = STOL; /* Call KINCreate/KINInit to initialize KINSOL: nvSpec points to machine environment data A pointer to KINSOL problem memory is returned and stored in kmem. */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Vector cc passed as template vector. */ flag = KINInit(kmem, func, cc); if (check_flag(&flag, "KINInit", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetUserData(kmem, data); if (check_flag(&flag, "KINSetUserData", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetConstraints(kmem, constraints); if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1); /* We no longer need the constraints vector since KINSetConstraints creates a private copy for KINSOL to use. */ N_VDestroy_Parallel(constraints); flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTol", 1, my_pe)) MPI_Abort(comm, 1); /* Call KINBBDPrecInit to initialize and allocate memory for the band-block-diagonal preconditioner, and specify the local and communication functions func_local and gcomm=NULL (all communication needed for the func_local is already done in func). */ dq_rel_uu = ZERO; mudq = mldq = 2*NUM_SPECIES - 1; mukeep = mlkeep = NUM_SPECIES; /* Call KINBBDSpgmr to specify the linear solver KINSPGMR */ maxl = 20; maxlrst = 2; flag = KINSpgmr(kmem, maxl); if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Initialize BBD preconditioner */ flag = KINBBDPrecInit(kmem, Nlocal, mudq, mldq, mukeep, mlkeep, dq_rel_uu, func_local, NULL); if (check_flag(&flag, "KINBBDPrecInit", 1, my_pe)) MPI_Abort(comm, 1); flag = KINSpilsSetMaxRestarts(kmem, maxlrst); if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe)) MPI_Abort(comm, 1); /* Print out the problem size, solution parameters, initial guess. */ if (my_pe == 0) PrintHeader(globalstrategy, maxl, maxlrst, mudq, mldq, mukeep, mlkeep, fnormtol, scsteptol); /* call KINSol and print output concentration profile */ flag = KINSol(kmem, /* KINSol memory block */ cc, /* initial guesss on input; solution vector */ globalstrategy, /* global stragegy choice */ sc, /* scaling vector, for the variable cc */ sc); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) printf("\n\nComputed equilibrium species concentrations:\n"); if (my_pe == 0 || my_pe==npelast) PrintOutput(my_pe, comm, cc); /* Print final statistics and free memory */ if (my_pe == 0) PrintFinalStats(kmem); N_VDestroy_Parallel(cc); N_VDestroy_Parallel(sc); KINFree(&kmem); FreeUserData(data); MPI_Finalize(); return(0); } /* Readability definitions used in other routines below */ #define acoef (data->acoef) #define bcoef (data->bcoef) #define cox (data->cox) #define coy (data->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * ccomm routine. This routine performs all communication * between processors of data needed to calculate f. */ static int ccomm(long int Nlocal, N_Vector cc, void *userdata) { realtype *cdata, *cext, buffer[2*NUM_SPECIES*MYSUB]; UserData data; MPI_Comm comm; int my_pe, isubx, isuby, nsmxsub, nsmysub; MPI_Request request[4]; /* Get comm, my_pe, subgrid indices, data sizes, extended array cext */ data = (UserData) userdata; comm = data->comm; my_pe = data->my_pe; isubx = data->isubx; isuby = data->isuby; nsmxsub = data->nsmxsub; nsmysub = NUM_SPECIES*MYSUB; cext = data->cext; cdata = NV_DATA_P(cc); /* Start receiving boundary data from neighboring PEs */ BRecvPost(comm, request, my_pe, isubx, isuby, nsmxsub, nsmysub, cext, buffer); /* Send data from boundary of local grid to neighboring PEs */ BSend(comm, my_pe, isubx, isuby, nsmxsub, nsmysub, cdata); /* Finish receiving boundary data from neighboring PEs */ BRecvWait(request, isubx, isuby, nsmxsub, cext, buffer); return(0); } /* * System function for predator-prey system - calculation part */ static int func_local(long int Nlocal, N_Vector cc, N_Vector fval, void *user_data) { realtype xx, yy, *cxy, *rxy, *fxy, dcydi, dcyui, dcxli, dcxri; realtype *cext, dely, delx, *cdata; int i, jx, jy, is, ly; int isubx, isuby, nsmxsub, nsmxsub2; int shifty, offsetc, offsetce, offsetcl, offsetcr, offsetcd, offsetcu; UserData data; data = (UserData)user_data; cdata = NV_DATA_P(cc); /* Get subgrid indices, data sizes, extended work array cext */ isubx = data->isubx; isuby = data->isuby; nsmxsub = data->nsmxsub; nsmxsub2 = data->nsmxsub2; cext = data->cext; /* Copy local segment of cc vector into the working extended array cext */ offsetc = 0; offsetce = nsmxsub2 + NUM_SPECIES; for (ly = 0; ly < MYSUB; ly++) { for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i]; offsetc = offsetc + nsmxsub; offsetce = offsetce + nsmxsub2; } /* To facilitate homogeneous Neumann boundary conditions, when this is a boundary PE, copy data from the first interior mesh line of cc to cext */ /* If isuby = 0, copy x-line 2 of cc to cext */ if (isuby == 0) { for (i = 0; i < nsmxsub; i++) cext[NUM_SPECIES+i] = cdata[nsmxsub+i]; } /* If isuby = NPEY-1, copy x-line MYSUB-1 of cc to cext */ if (isuby == NPEY-1) { offsetc = (MYSUB-2)*nsmxsub; offsetce = (MYSUB+1)*nsmxsub2 + NUM_SPECIES; for (i = 0; i < nsmxsub; i++) cext[offsetce+i] = cdata[offsetc+i]; } /* If isubx = 0, copy y-line 2 of cc to cext */ if (isubx == 0) { for (ly = 0; ly < MYSUB; ly++) { offsetc = ly*nsmxsub + NUM_SPECIES; offsetce = (ly+1)*nsmxsub2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i]; } } /* If isubx = NPEX-1, copy y-line MXSUB-1 of cc to cext */ if (isubx == NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetc = (ly+1)*nsmxsub - 2*NUM_SPECIES; offsetce = (ly+2)*nsmxsub2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = cdata[offsetc+i]; } } /* Loop over all mesh points, evaluating rate arra at each point */ delx = data->dx; dely = data->dy; shifty = (MXSUB+2)*NUM_SPECIES; for (jy = 0; jy < MYSUB; jy++) { yy = dely*(jy + isuby * MYSUB); for (jx = 0; jx < MXSUB; jx++) { xx = delx * (jx + isubx * MXSUB); cxy = IJ_Vptr(cc,jx,jy); rxy = IJ_Vptr(data->rates,jx,jy); fxy = IJ_Vptr(fval,jx,jy); WebRate(xx, yy, cxy, rxy, user_data); offsetc = (jx+1)*NUM_SPECIES + (jy+1)*NSMXSUB2; offsetcd = offsetc - shifty; offsetcu = offsetc + shifty; offsetcl = offsetc - NUM_SPECIES; offsetcr = offsetc + NUM_SPECIES; for (is = 0; is < NUM_SPECIES; is++) { /* differencing in x */ dcydi = cext[offsetc+is] - cext[offsetcd+is]; dcyui = cext[offsetcu+is] - cext[offsetc+is]; /* differencing in y */ dcxli = cext[offsetc+is] - cext[offsetcl+is]; dcxri = cext[offsetcr+is] - cext[offsetc+is]; /* compute the value at xx , yy */ fxy[is] = (coy)[is] * (dcyui - dcydi) + (cox)[is] * (dcxri - dcxli) + rxy[is]; } /* end of is loop */ } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * System function routine. Evaluate f(cc). First call ccomm to do * communication of subgrid boundary data into cext. Then calculate f * by a call to func_local. */ static int func(N_Vector cc, N_Vector fval, void *user_data) { UserData data; data = (UserData) user_data; /* Call ccomm to do inter-processor communicaiton */ ccomm(data->Nlocal, cc, data); /* Call func_local to calculate all right-hand sides */ func_local(data->Nlocal, cc, fval, data); return(0); } /* * Interaction rate function routine */ static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data) { int i; realtype fac; UserData data; data = (UserData)user_data; for (i = 0; imx = MX; data->my = MY; data->ns = NUM_SPECIES; data->np = NUM_SPECIES/2; data->ax = AX; data->ay = AY; data->dx = (data->ax)/(MX-1); data->dy = (data->ay)/(MY-1); data->my_pe = my_pe; data->Nlocal = Nlocal; data->comm = comm; data->isuby = my_pe/NPEX; data->isubx = my_pe - data->isuby*NPEX; data->nsmxsub = NUM_SPECIES * MXSUB; data->nsmxsub2 = NUM_SPECIES * (MXSUB+2); /* Set up the coefficients a and b plus others found in the equations */ np = data->np; dx2=(data->dx)*(data->dx); dy2=(data->dy)*(data->dy); for (i = 0; i < np; i++) { a1= &(acoef[i][np]); a2= &(acoef[i+np][0]); a3= &(acoef[i][0]); a4= &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* and then change the diagonal elements of acoef to -AA */ acoef[i][i]=-AA; acoef[i+np][i+np] = -AA; bcoef[i] = BB; bcoef[i+np] = -BB; cox[i]=DPREY/dx2; cox[i+np]=DPRED/dx2; coy[i]=DPREY/dy2; coy[i+np]=DPRED/dy2; } } /* * Free data memory */ static void FreeUserData(UserData data) { destroyMat(acoef); free(bcoef); free(cox); free(coy); N_VDestroy_Parallel(data->rates); free(data); } /* * Set initial conditions in cc */ static void SetInitialProfiles(N_Vector cc, N_Vector sc) { int i, jx, jy; realtype *cloc, *sloc; realtype ctemp[NUM_SPECIES], stemp[NUM_SPECIES]; /* Initialize arrays ctemp and stemp used in the loading process */ for (i = 0; i < NUM_SPECIES/2; i++) { ctemp[i] = PREYIN; stemp[i] = ONE; } for (i = NUM_SPECIES/2; i < NUM_SPECIES; i++) { ctemp[i] = PREDIN; stemp[i] = RCONST(0.00001); } /* Load initial profiles into cc and sc vector from ctemp and stemp. */ for (jy = 0; jy < MYSUB; jy++) { for (jx=0; jx < MXSUB; jx++) { cloc = IJ_Vptr(cc,jx,jy); sloc = IJ_Vptr(sc,jx,jy); for (i = 0; i < NUM_SPECIES; i++){ cloc[i] = ctemp[i]; sloc[i] = stemp[i]; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(int globalstrategy, int maxl, int maxlrst, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype fnormtol, realtype scsteptol) { printf("\nPredator-prey test problem-- KINSol (parallel-BBD version)\n\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Number of species = %d\n", NUM_SPECIES); printf("Total system size = %d\n\n", NEQ); printf("Subgrid dimensions = %d X %d\n", MXSUB, MYSUB); printf("Processor array is %d X %d\n\n", NPEX, NPEY); printf("Flag globalstrategy = %d (0 = None, 1 = Linesearch)\n", globalstrategy); printf("Linear solver is SPGMR with maxl = %d, maxlrst = %d\n", maxl, maxlrst); printf("Preconditioning uses band-block-diagonal matrix from KINBBDPRE\n"); printf(" Difference quotient half-bandwidths: mudq = %d, mldq = %d\n", mudq, mldq); printf(" Retained band block half-bandwidths: mukeep = %d, mlkeep = %d\n", mukeep, mlkeep); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: fnormtol = %Lg scsteptol = %Lg\n", fnormtol, scsteptol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: fnormtol = %lg scsteptol = %lg\n", fnormtol, scsteptol); #else printf("Tolerance parameters: fnormtol = %g scsteptol = %g\n", fnormtol, scsteptol); #endif printf("\nInitial profile of concentration\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At all mesh points: %Lg %Lg %Lg %Lg %Lg %Lg\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At all mesh points: %lg %lg %lg %lg %lg %lg\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #else printf("At all mesh points: %g %g %g %g %g %g\n", PREYIN,PREYIN,PREYIN, PREDIN,PREDIN,PREDIN); #endif } /* * Print sample of current cc values */ static void PrintOutput(int my_pe, MPI_Comm comm, N_Vector cc) { int is, i0, npelast; realtype *ct, tempc[NUM_SPECIES]; MPI_Status status; npelast = NPEX*NPEY - 1; ct = NV_DATA_P(cc); /* Send the cc values (for all species) at the top right mesh point to PE 0 */ if (my_pe == npelast) { i0 = NUM_SPECIES*(MXSUB*MYSUB-1); if (npelast!=0) MPI_Send(&ct[i0],NUM_SPECIES,PVEC_REAL_MPI_TYPE,0,0,comm); else /* single processor case */ for (is = 0; is < NUM_SPECIES; is++) tempc[is]=ct[i0+is]; } /* On PE 0, receive the cc values at top right, then print performance data and sampled solution values */ if (my_pe == 0) { if (npelast != 0) MPI_Recv(&tempc[0],NUM_SPECIES,PVEC_REAL_MPI_TYPE,npelast,0,comm,&status); printf("\nAt bottom left:"); for (is = 0; is < NUM_SPECIES; is++){ if ((is%6)*6== is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } printf("\n\nAt top right:"); for (is = 0; is < NUM_SPECIES; is++) { if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",tempc[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",tempc[is]); #else printf(" %g",tempc[is]); #endif } printf("\n\n"); } } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nli, npe, nps, ncfl, nfeSG; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1, 0); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1, 0); flag = KINSpilsGetNumLinIters(kmem, &nli); check_flag(&flag, "KINSpilsGetNumLinIters", 1, 0); flag = KINSpilsGetNumPrecEvals(kmem, &npe); check_flag(&flag, "KINSpilsGetNumPrecEvals", 1, 0); flag = KINSpilsGetNumPrecSolves(kmem, &nps); check_flag(&flag, "KINSpilsGetNumPrecSolves", 1, 0); flag = KINSpilsGetNumConvFails(kmem, &ncfl); check_flag(&flag, "KINSpilsGetNumConvFails", 1, 0); flag = KINSpilsGetNumFuncEvals(kmem, &nfeSG); check_flag(&flag, "KINSpilsGetNumFuncEvals", 1, 0); printf("Final Statistics.. \n"); printf("nni = %5ld nli = %5ld\n", nni, nli); printf("nfe = %5ld nfeSG = %5ld\n", nfe, nfeSG); printf("nps = %5ld npe = %5ld ncfl = %5ld\n", nps, npe, ncfl); } /* * Routine to send boundary data to neighboring PEs */ static void BSend(MPI_Comm comm, int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cdata) { int i, ly; int offsetc, offsetbuf; realtype bufleft[NUM_SPECIES*MYSUB], bufright[NUM_SPECIES*MYSUB]; /* If isuby > 0, send data from bottom x-line of u */ if (isuby != 0) MPI_Send(&cdata[0], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm); /* If isuby < NPEY-1, send data from top x-line of u */ if (isuby != NPEY-1) { offsetc = (MYSUB-1)*dsizex; MPI_Send(&cdata[offsetc], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm); } /* If isubx > 0, send data from left y-line of u (via bufleft) */ if (isubx != 0) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = ly*dsizex; for (i = 0; i < NUM_SPECIES; i++) bufleft[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm); } /* If isubx < NPEX-1, send data from right y-line of u (via bufright) */ if (isubx != NPEX-1) { for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetc = offsetbuf*MXSUB + (MXSUB-1)*NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) bufright[offsetbuf+i] = cdata[offsetc+i]; } MPI_Send(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm); } } /* * Routine to start receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvPost(MPI_Comm comm, MPI_Request request[], int my_pe, int isubx, int isuby, int dsizex, int dsizey, realtype *cext, realtype *buffer) { int offsetce; /* Have bufleft and bufright use the same buffer */ realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; /* If isuby > 0, receive data for bottom x-line of cext */ if (isuby != 0) MPI_Irecv(&cext[NUM_SPECIES], dsizex, PVEC_REAL_MPI_TYPE, my_pe-NPEX, 0, comm, &request[0]); /* If isuby < NPEY-1, receive data for top x-line of cext */ if (isuby != NPEY-1) { offsetce = NUM_SPECIES*(1 + (MYSUB+1)*(MXSUB+2)); MPI_Irecv(&cext[offsetce], dsizex, PVEC_REAL_MPI_TYPE, my_pe+NPEX, 0, comm, &request[1]); } /* If isubx > 0, receive data for left y-line of cext (via bufleft) */ if (isubx != 0) { MPI_Irecv(&bufleft[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe-1, 0, comm, &request[2]); } /* If isubx < NPEX-1, receive data for right y-line of cext (via bufright) */ if (isubx != NPEX-1) { MPI_Irecv(&bufright[0], dsizey, PVEC_REAL_MPI_TYPE, my_pe+1, 0, comm, &request[3]); } } /* * Routine to finish receiving boundary data from neighboring PEs. * Notes: * 1) buffer should be able to hold 2*NUM_SPECIES*MYSUB realtype entries, * should be passed to both the BRecvPost and BRecvWait functions, and * should not be manipulated between the two calls. * 2) request should have 4 entries, and should be passed in both calls also. */ static void BRecvWait(MPI_Request request[], int isubx, int isuby, int dsizex, realtype *cext, realtype *buffer) { int i, ly; int dsizex2, offsetce, offsetbuf; realtype *bufleft = buffer, *bufright = buffer+NUM_SPECIES*MYSUB; MPI_Status status; dsizex2 = dsizex + 2*NUM_SPECIES; /* If isuby > 0, receive data for bottom x-line of cext */ if (isuby != 0) MPI_Wait(&request[0],&status); /* If isuby < NPEY-1, receive data for top x-line of cext */ if (isuby != NPEY-1) MPI_Wait(&request[1],&status); /* If isubx > 0, receive data for left y-line of cext (via bufleft) */ if (isubx != 0) { MPI_Wait(&request[2],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+1)*dsizex2; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufleft[offsetbuf+i]; } } /* If isubx < NPEX-1, receive data for right y-line of cext (via bufright) */ if (isubx != NPEX-1) { MPI_Wait(&request[3],&status); /* Copy the buffer to cext */ for (ly = 0; ly < MYSUB; ly++) { offsetbuf = ly*NUM_SPECIES; offsetce = (ly+2)*dsizex2 - NUM_SPECIES; for (i = 0; i < NUM_SPECIES; i++) cext[offsetce+i] = bufright[offsetbuf+i]; } } } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt, int id) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR(%d): %s() failed with flag = %d\n\n", id, funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR(%d): %s() failed - returned NULL pointer\n\n", id, funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/parallel/README0000600000175000017500000000105711741421273022010 0ustar sylvestresylvestreList of parallel KINSOL examples kinFoodWeb_kry_bbd_p: 2-D food web system, BBD preconditioner kinFoodWeb_kry_p: 2-D food web system, block-diagonal preconditioner Sample results: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 (GCC) MPI Implementation: Open MPI v1.1 sundials-2.5.0/examples/kinsol/serial/0000755000175000017500000000000011767174700020630 5ustar sylvestresylvestresundials-2.5.0/examples/kinsol/serial/kinLaplace_bnd.c0000600000175000017500000002455511741421273023655 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.1 $ * $Date: 2007/10/25 20:03:41 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * This example solves a 2D elliptic PDE * * d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0 * * subject to homogeneous Dirichelt boundary conditions. * The PDE is discretized on a uniform NX+2 by NY+2 grid with * central differencing, and with boundary values eliminated, * leaving an system of size NEQ = NX*NY. * The nonlinear system is solved by KINSOL using the BAND linear * solver. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define NX 31 /* no. of points in x direction */ #define NY 31 /* no. of points in y direction */ #define NEQ NX*NY /* problem dimension */ #define SKIP 3 /* no. of points skipped for printing */ #define FTOL RCONST(1.e-12) /* function tolerance */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* IJth is defined in order to isolate the translation from the mathematical 2-dimensional structure of the dependent variable vector to the underlying 1-dimensional storage. IJth(vdata,i,j) references the element in the vdata array for u at mesh point (i,j), where 1 <= i <= NX, 1 <= j <= NY. The vdata array is obtained via the macro call vdata = NV_DATA_S(v), where v is an N_Vector. The variables are ordered by the y index j, then by the x index i. */ #define IJth(vdata,i,j) (vdata[(j-1) + (i-1)*NY]) /* Private functions */ static int func(N_Vector u, N_Vector f, void *user_data); static void PrintOutput(N_Vector u); static void PrintFinalStats(void *kmem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { realtype fnormtol, fnorm; N_Vector y, scale; int mset, msubset, flag; void *kmem; y = scale = NULL; kmem = NULL; /* ------------------------- * Print problem description * ------------------------- */ printf("\n2D elliptic PDE on unit square\n"); printf(" d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0\n"); printf(" + homogeneous Dirichlet boundary conditions\n\n"); printf("Solution method: Modified Newton with band linear solver\n"); printf("Problem size: %2ld x %2ld = %4ld\n", (long int) NX, (long int) NY, (long int) NEQ); /* -------------------------------------- * Create vectors for solution and scales * -------------------------------------- */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); scale = N_VNew_Serial(NEQ); if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1); /* ----------------------------------------- * Initialize and allocate memory for KINSOL * ----------------------------------------- */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); /* y is used as a template */ flag = KINInit(kmem, func, y); if (check_flag(&flag, "KINInit", 1)) return(1); /* ------------------- * Set optional inputs * ------------------- */ /* Specify stopping tolerance based on residual */ fnormtol = FTOL; flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); /* ------------------------- * Attach band linear solver * ------------------------- */ flag = KINBand(kmem, NEQ, NY, NY); if (check_flag(&flag, "KINBand", 1)) return(1); /* ------------------------------ * Parameters for Modified Newton * ------------------------------ */ /* Force a Jacobian re-evaluation every mset iterations */ mset = 100; flag = KINSetMaxSetupCalls(kmem, mset); if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1); /* Every msubset iterations, test if a Jacobian evaluation is necessary */ msubset = 1; flag = KINSetMaxSubSetupCalls(kmem, msubset); if (check_flag(&flag, "KINSetMaxSubSetupCalls", 1)) return(1); /* ------------- * Initial guess * ------------- */ N_VConst_Serial(ZERO, y); /* ---------------------------- * Call KINSol to solve problem * ---------------------------- */ /* No scaling used */ N_VConst_Serial(ONE,scale); /* Call main solver */ flag = KINSol(kmem, /* KINSol memory block */ y, /* initial guess on input; solution vector */ KIN_LINESEARCH, /* global stragegy choice */ scale, /* scaling vector, for the variable cc */ scale); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); /* ------------------------------------ * Print solution and solver statistics * ------------------------------------ */ /* Get scaled norm of the system function */ flag = KINGetFuncNorm(kmem, &fnorm); if (check_flag(&flag, "KINGetfuncNorm", 1)) return(1); printf("\nComputed solution (||F|| = %g):\n\n",fnorm); PrintOutput(y); PrintFinalStats(kmem); /* ----------- * Free memory * ----------- */ N_VDestroy_Serial(y); N_VDestroy_Serial(scale); KINFree(&kmem); return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * System function */ static int func(N_Vector u, N_Vector f, void *user_data) { realtype dx, dy, hdiff, vdiff; realtype hdc, vdc; realtype uij, udn, uup, ult, urt; realtype *udata, *fdata; realtype x,y; int i, j; dx = ONE/(NX+1); dy = ONE/(NY+1); hdc = ONE/(dx*dx); vdc = ONE/(dy*dy); udata = NV_DATA_S(u); fdata = NV_DATA_S(f); for (j=1; j <= NY; j++) { y = j*dy; for (i=1; i <= NX; i++) { x = i*dx; /* Extract u at x_i, y_j and four neighboring points */ uij = IJth(udata, i, j); udn = (j == 1) ? ZERO : IJth(udata, i, j-1); uup = (j == NY) ? ZERO : IJth(udata, i, j+1); ult = (i == 1) ? ZERO : IJth(udata, i-1, j); urt = (i == NX) ? ZERO : IJth(udata, i+1, j); /* Evaluate diffusion components */ hdiff = hdc*(ult - TWO*uij + urt); vdiff = vdc*(uup - TWO*uij + udn); /* Set residual at x_i, y_j */ IJth(fdata, i, j) = hdiff + vdiff + uij - uij*uij*uij + 2.0; } } return(0); } /* * Print solution at selected points */ static void PrintOutput(N_Vector u) { int i, j; realtype dx, dy, x, y; realtype *udata; dx = ONE/(NX+1); dy = ONE/(NY+1); udata = NV_DATA_S(u); printf(" "); for (i=1; i<=NX; i+= SKIP) { x = i*dx; #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", x); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5lf ", x); #else printf("%-8.5f ", x); #endif } printf("\n\n"); for (j=1; j<=NY; j+= SKIP) { y = j*dy; #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", y); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5lf ", y); #else printf("%-8.5f ", y); #endif for (i=1; i<=NX; i+= SKIP) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf("%-8.5Lf ", IJth(udata,i,j)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("%-8.5lf ", IJth(udata,i,j)); #else printf("%-8.5f ", IJth(udata,i,j)); #endif } printf("\n"); } } /* * Print final statistics */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nje, nfeD; long int lenrw, leniw, lenrwB, leniwB; long int nbcfails, nbacktr; int flag; /* Main solver statistics */ flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1); /* Linesearch statistics */ flag = KINGetNumBetaCondFails(kmem, &nbcfails); check_flag(&flag, "KINGetNumBetacondFails", 1); flag = KINGetNumBacktrackOps(kmem, &nbacktr); check_flag(&flag, "KINGetNumBacktrackOps", 1); /* Main solver workspace size */ flag = KINGetWorkSpace(kmem, &lenrw, &leniw); check_flag(&flag, "KINGetWorkSpace", 1); /* Band linear solver statistics */ flag = KINDlsGetNumJacEvals(kmem, &nje); check_flag(&flag, "KINDlsGetNumJacEvals", 1); flag = KINDlsGetNumFuncEvals(kmem, &nfeD); check_flag(&flag, "KINDlsGetNumFuncEvals", 1); /* Band linear solver workspace size */ flag = KINDlsGetWorkSpace(kmem, &lenrwB, &leniwB); check_flag(&flag, "KINDlsGetWorkSpace", 1); printf("\nFinal Statistics.. \n\n"); printf("nni = %6ld nfe = %6ld \n", nni, nfe); printf("nbcfails = %6ld nbacktr = %6ld \n", nbcfails, nbacktr); printf("nje = %6ld nfeB = %6ld \n", nje, nfeD); printf("\n"); printf("lenrw = %6ld leniw = %6ld \n", lenrw, leniw); printf("lenrwB = %6ld leniwB = %6ld \n", lenrwB, leniwB); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/serial/CMakeLists.txt0000600000175000017500000001015511741421273023352 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for KINSOL serial examples # Add variable KINSOL_examples with the names of the serial KINSOL examples SET(KINSOL_examples kinFerTron_dns kinFoodWeb_kry kinKrylovDemo_ls kinLaplace_bnd kinRoboKin_dns ) # Add variable KINSOL_examples_BL with the names of the serial KINSOL examples # that use Lapack SET(KINSOL_examples_BL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_static) SET(NVECS_LIB sundials_nvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_shared) SET(NVECS_LIB sundials_nvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${KINSOL_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each KINSOL example FOREACH(example ${KINSOL_examples}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${KINSOL_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${KINSOL_examples_BL}) ADD_EXECUTABLE(${example} ${example}.c) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.c ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${KINSOL_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "KINSOL") SET(SOLVER_LIB "sundials_kinsol") LIST2STRING(KINSOL_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(KINSOL_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_C_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/kinsol/serial/Makefile.in0000600000175000017500000001054211741421273022657 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.11 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for KINSOL serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CC = @CC@ CFLAGS = @CFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_INCS = -I$(top_srcdir)/include -I$(top_builddir)/include SUNDIALS_LIBS = $(top_builddir)/src/kinsol/libsundials_kinsol.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = kinFerTron_dns \ kinFoodWeb_kry \ kinKrylovDemo_ls \ kinLaplace_bnd \ kinRoboKin_dns EXAMPLES_BL = OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(LIBTOOL) --mode=compile $(CC) $(CPPFLAGS) $(SUNDIALS_INCS) $(CFLAGS) -c $(srcdir)/$${i}.c -o $${i}${OBJ_EXT} ; \ $(LIBTOOL) --mode=link $(CC) -o $(builddir)/$${i}$(EXE_EXT) $(builddir)/$${i}${OBJ_EXT} $(CFLAGS) $(LDFLAGS) $(SUNDIALS_LIBS) $(LIBS) $(BLAS_LAPACK_LIBS) ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/kinsol/serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/kinsol/serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/serial/README $(EXS_INSTDIR)/kinsol/serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/serial/$${i}.c $(EXS_INSTDIR)/kinsol/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/serial/$${i}.out $(EXS_INSTDIR)/kinsol/serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/serial/$${i}.c $(EXS_INSTDIR)/kinsol/serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/serial/$${i}.out $(EXS_INSTDIR)/kinsol/serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/kinsol/serial/Makefile rm -f $(EXS_INSTDIR)/kinsol/serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/kinsol/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/kinsol/serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/kinsol/serial/$${i}.c ; \ rm -f $(EXS_INSTDIR)/kinsol/serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/kinsol/serial $(rminstalldirs) $(EXS_INSTDIR)/kinsol clean: rm -rf .libs rm -f *.lo rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/kinsol/serial/kinFerTron_dns.c0000600000175000017500000002765611741421273023721 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2008/12/17 19:38:48 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * Example (serial): * * This example solves a nonlinear system from. * * Source: "Handbook of Test Problems in Local and Global Optimization", * C.A. Floudas, P.M. Pardalos et al. * Kluwer Academic Publishers, 1999. * Test problem 4 from Section 14.1, Chapter 14: Ferraris and Tronconi * * This problem involves a blend of trigonometric and exponential terms. * 0.5 sin(x1 x2) - 0.25 x2/pi - 0.5 x1 = 0 * (1-0.25/pi) ( exp(2 x1)-e ) + e x2 / pi - 2 e x1 = 0 * such that * 0.25 <= x1 <=1.0 * 1.5 <= x2 <= 2 pi * * The treatment of the bound constraints on x1 and x2 is done using * the additional variables * l1 = x1 - x1_min >= 0 * L1 = x1 - x1_max <= 0 * l2 = x2 - x2_min >= 0 * L2 = x2 - x2_max >= 0 * * and using the constraint feature in KINSOL to impose * l1 >= 0 l2 >= 0 * L1 <= 0 L2 <= 0 * * The Ferraris-Tronconi test problem has two known solutions. * The nonlinear system is solved by KINSOL using different * combinations of globalization and Jacobian update strategies * and with different initial guesses (leading to one or the other * of the known solutions). * * * Constraints are imposed to make all components of the solution * positive. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define NVAR 2 #define NEQ 3*NVAR #define FTOL RCONST(1.e-5) /* function tolerance */ #define STOL RCONST(1.e-5) /* step tolerance */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define PT5 RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) #define TWO RCONST(2.0) #define PI RCONST(3.1415926) #define E RCONST(2.7182818) typedef struct { realtype lb[NVAR]; realtype ub[NVAR]; } *UserData; /* Accessor macro */ #define Ith(v,i) NV_Ith_S(v,i-1) /* Functions Called by the KINSOL Solver */ static int func(N_Vector u, N_Vector f, void *user_data); /* Private Helper Functions */ static void SetInitialGuess1(N_Vector u, UserData data); static void SetInitialGuess2(N_Vector u, UserData data); static int SolveIt(void *kmem, N_Vector u, N_Vector s, int glstr, int mset); static void PrintHeader(int globalstrategy, realtype fnormtol, realtype scsteptol); static void PrintOutput(N_Vector u); static void PrintFinalStats(void *kmem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { UserData data; realtype fnormtol, scsteptol; N_Vector u1, u2, u, s, c; int glstr, mset, flag; void *kmem; u1 = u2 = u = NULL; s = c = NULL; kmem = NULL; data = NULL; glstr = KIN_NONE; /* User data */ data = (UserData)malloc(sizeof *data); data->lb[0] = PT25; data->ub[0] = ONE; data->lb[1] = ONEPT5; data->ub[1] = TWO*PI; /* Create serial vectors of length NEQ */ u1 = N_VNew_Serial(NEQ); if (check_flag((void *)u1, "N_VNew_Serial", 0)) return(1); u2 = N_VNew_Serial(NEQ); if (check_flag((void *)u2, "N_VNew_Serial", 0)) return(1); u = N_VNew_Serial(NEQ); if (check_flag((void *)u, "N_VNew_Serial", 0)) return(1); s = N_VNew_Serial(NEQ); if (check_flag((void *)s, "N_VNew_Serial", 0)) return(1); c = N_VNew_Serial(NEQ); if (check_flag((void *)c, "N_VNew_Serial", 0)) return(1); SetInitialGuess1(u1,data); SetInitialGuess2(u2,data); N_VConst_Serial(ONE,s); /* no scaling */ Ith(c,1) = ZERO; /* no constraint on x1 */ Ith(c,2) = ZERO; /* no constraint on x2 */ Ith(c,3) = ONE; /* l1 = x1 - x1_min >= 0 */ Ith(c,4) = -ONE; /* L1 = x1 - x1_max <= 0 */ Ith(c,5) = ONE; /* l2 = x2 - x2_min >= 0 */ Ith(c,6) = -ONE; /* L2 = x2 - x22_min <= 0 */ fnormtol=FTOL; scsteptol=STOL; kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); flag = KINSetUserData(kmem, data); if (check_flag(&flag, "KINSetUserData", 1)) return(1); flag = KINSetConstraints(kmem, c); if (check_flag(&flag, "KINSetConstraints", 1)) return(1); flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1); flag = KINInit(kmem, func, u); if (check_flag(&flag, "KINInit", 1)) return(1); /* Call KINDense to specify the linear solver */ flag = KINDense(kmem, NEQ); if (check_flag(&flag, "KINDense", 1)) return(1); /* Print out the problem size, solution parameters, initial guess. */ PrintHeader(glstr, fnormtol, scsteptol); /* --------------------------- */ printf("\n------------------------------------------\n"); printf("\nInitial guess on lower bounds\n"); printf(" [x1,x2] = "); PrintOutput(u1); N_VScale_Serial(ONE,u1,u); glstr = KIN_NONE; mset = 1; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u1,u); glstr = KIN_LINESEARCH; mset = 1; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u1,u); glstr = KIN_NONE; mset = 0; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u1,u); glstr = KIN_LINESEARCH; mset = 0; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ printf("\n------------------------------------------\n"); printf("\nInitial guess in middle of feasible region\n"); printf(" [x1,x2] = "); PrintOutput(u2); N_VScale_Serial(ONE,u2,u); glstr = KIN_NONE; mset = 1; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u2,u); glstr = KIN_LINESEARCH; mset = 1; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u2,u); glstr = KIN_NONE; mset = 0; SolveIt(kmem, u, s, glstr, mset); /* --------------------------- */ N_VScale_Serial(ONE,u2,u); glstr = KIN_LINESEARCH; mset = 0; SolveIt(kmem, u, s, glstr, mset); /* Free memory */ N_VDestroy_Serial(u); N_VDestroy_Serial(s); N_VDestroy_Serial(c); KINFree(&kmem); free(data); return(0); } static int SolveIt(void *kmem, N_Vector u, N_Vector s, int glstr, int mset) { int flag; printf("\n"); if (mset==1) printf("Exact Newton"); else printf("Modified Newton"); if (glstr == KIN_NONE) printf("\n"); else printf(" with line search\n"); flag = KINSetMaxSetupCalls(kmem, mset); if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1); flag = KINSol(kmem, u, glstr, s, s); if (check_flag(&flag, "KINSol", 1)) return(1); printf("Solution:\n [x1,x2] = "); PrintOutput(u); PrintFinalStats(kmem); return(0); } /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * System function for predator-prey system */ static int func(N_Vector u, N_Vector f, void *user_data) { realtype *udata, *fdata; realtype x1, l1, L1, x2, l2, L2; realtype *lb, *ub; UserData data; data = (UserData)user_data; lb = data->lb; ub = data->ub; udata = NV_DATA_S(u); fdata = NV_DATA_S(f); x1 = udata[0]; x2 = udata[1]; l1 = udata[2]; L1 = udata[3]; l2 = udata[4]; L2 = udata[5]; fdata[0] = PT5 * sin(x1*x2) - PT25 * x2 / PI - PT5 * x1; fdata[1] = (ONE - PT25/PI)*(EXP(TWO*x1)-E) + E*x2/PI - TWO*E*x1; fdata[2] = l1 - x1 + lb[0]; fdata[3] = L1 - x1 + ub[0]; fdata[4] = l2 - x2 + lb[1]; fdata[5] = L2 - x2 + ub[1]; return(0); } /* *-------------------------------------------------------------------- * PRIVATE FUNCTIONS *-------------------------------------------------------------------- */ /* * Initial guesses */ static void SetInitialGuess1(N_Vector u, UserData data) { realtype x1, x2; realtype *udata; realtype *lb, *ub; udata = NV_DATA_S(u); lb = data->lb; ub = data->ub; /* There are two known solutions for this problem */ /* this init. guess should take us to (0.29945; 2.83693) */ x1 = lb[0]; x2 = lb[1]; udata[0] = x1; udata[1] = x2; udata[2] = x1 - lb[0]; udata[3] = x1 - ub[0]; udata[4] = x2 - lb[1]; udata[5] = x2 - ub[1]; } static void SetInitialGuess2(N_Vector u, UserData data) { realtype x1, x2; realtype *udata; realtype *lb, *ub; udata = NV_DATA_S(u); lb = data->lb; ub = data->ub; /* There are two known solutions for this problem */ /* this init. guess should take us to (0.5; 3.1415926) */ x1 = PT5 * (lb[0] + ub[0]); x2 = PT5 * (lb[1] + ub[1]); udata[0] = x1; udata[1] = x2; udata[2] = x1 - lb[0]; udata[3] = x1 - ub[0]; udata[4] = x2 - lb[1]; udata[5] = x2 - ub[1]; } /* * Print first lines of output (problem description) */ static void PrintHeader(int globalstrategy, realtype fnormtol, realtype scsteptol) { printf("\nFerraris and Tronconi test problem\n"); printf("Tolerance parameters:\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" fnormtol = %10.6Lg\n scsteptol = %10.6Lg\n", fnormtol, scsteptol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" fnormtol = %10.6lg\n scsteptol = %10.6lg\n", fnormtol, scsteptol); #else printf(" fnormtol = %10.6g\n scsteptol = %10.6g\n", fnormtol, scsteptol); #endif } /* * Print solution */ static void PrintOutput(N_Vector u) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %8.6Lg %8.6Lg\n", Ith(u,1), Ith(u,2)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %8.6lg %8.6lg\n", Ith(u,1), Ith(u,2)); #else printf(" %8.6g %8.6g\n", Ith(u,1), Ith(u,2)); #endif } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nje, nfeD; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1); flag = KINDlsGetNumJacEvals(kmem, &nje); check_flag(&flag, "KINDlsGetNumJacEvals", 1); flag = KINDlsGetNumFuncEvals(kmem, &nfeD); check_flag(&flag, "KINDlsGetNumFuncEvals", 1); printf("Final Statistics:\n"); printf(" nni = %5ld nfe = %5ld \n", nni, nfe); printf(" nje = %5ld nfeD = %5ld \n", nje, nfeD); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/serial/kinFerTron_dns.out0000600000175000017500000000273711741421273024277 0ustar sylvestresylvestre Ferraris and Tronconi test problem Tolerance parameters: fnormtol = 1e-05 scsteptol = 1e-05 ------------------------------------------ Initial guess on lower bounds [x1,x2] = 0.25 1.5 Exact Newton Solution: [x1,x2] = 0.299449 2.83693 Final Statistics: nni = 3 nfe = 4 nje = 3 nfeD = 18 Exact Newton with line search Solution: [x1,x2] = 0.299449 2.83693 Final Statistics: nni = 3 nfe = 4 nje = 3 nfeD = 18 Modified Newton Solution: [x1,x2] = 0.299449 2.83693 Final Statistics: nni = 11 nfe = 12 nje = 2 nfeD = 12 Modified Newton with line search Solution: [x1,x2] = 0.299449 2.83693 Final Statistics: nni = 11 nfe = 12 nje = 2 nfeD = 12 ------------------------------------------ Initial guess in middle of feasible region [x1,x2] = 0.625 3.89159 Exact Newton Solution: [x1,x2] = 0.5 3.14159 Final Statistics: nni = 5 nfe = 6 nje = 5 nfeD = 30 Exact Newton with line search Solution: [x1,x2] = 0.5 3.14159 Final Statistics: nni = 5 nfe = 6 nje = 5 nfeD = 30 Modified Newton Solution: [x1,x2] = 0.500003 3.1416 Final Statistics: nni = 12 nfe = 13 nje = 2 nfeD = 12 Modified Newton with line search Solution: [x1,x2] = 0.500003 3.1416 Final Statistics: nni = 12 nfe = 13 nje = 2 nfeD = 12 sundials-2.5.0/examples/kinsol/serial/kinRoboKin_dns.out0000600000175000017500000000171011741421273024251 0ustar sylvestresylvestre Robot Kinematics Example 8 variables; -1 <= x_i <= 1 KINSOL problem size: 8 + 2*8 = 24 Initial guess: l=x+1 x u=1-x ---------------------------------- 1 0.707107 1 1 0.707107 1 1 0.707107 1 1 0.707107 1 1 0.707107 1 1 0.707107 1 1 0.707107 1 1 0.707107 1 Computed solution: l=x+1 x u=1-x ---------------------------------- 1.67155 0.671554 0.328446 1.74096 0.740955 0.259045 1.95189 0.951893 0.0481072 0.693569 -0.306431 1.30643 1.96381 0.963811 0.0361892 0.733413 -0.266587 1.26659 1.40464 0.404641 0.595359 1.91448 0.914475 0.0855246 Final Statistics.. nni = 6 nfe = 7 nje = 6 nfeD = 0 sundials-2.5.0/examples/kinsol/serial/kinFoodWeb_kry.out0000600000175000017500000000143111741421273024254 0ustar sylvestresylvestre Predator-prey test problem -- KINSol (serial version) Mesh dimensions = 8 X 8 Number of species = 6 Total system size = 384 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPGMR with maxl = 15, maxlrst = 2 Preconditioning uses interaction-only block-diagonal matrix Positivity constraints imposed on all components Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.16428 1.16428 1.16428 34927.5 34927.5 34927.5 At top right: 1.25797 1.25797 1.25797 37736.7 37736.7 37736.7 Final Statistics.. nni = 10 nli = 378 nfe = 11 nfeSG = 388 nps = 388 npe = 1 ncfl = 7 sundials-2.5.0/examples/kinsol/serial/kinLaplace_bnd.out0000600000175000017500000000343111741421273024230 0ustar sylvestresylvestre 2D elliptic PDE on unit square d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0 + homogeneous Dirichlet boundary conditions Solution method: Modified Newton with band linear solver Problem size: 31 x 31 = 961 Computed solution (||F|| = 1.37621e-12): 0.03125 0.12500 0.21875 0.31250 0.40625 0.50000 0.59375 0.68750 0.78125 0.87500 0.96875 0.03125 0.00405 0.01165 0.01617 0.01896 0.02051 0.02100 0.02051 0.01896 0.01617 0.01165 0.00405 0.12500 0.01165 0.03772 0.05461 0.06530 0.07126 0.07318 0.07126 0.06530 0.05461 0.03772 0.01165 0.21875 0.01617 0.05461 0.08098 0.09813 0.10780 0.11093 0.10780 0.09813 0.08098 0.05461 0.01617 0.31250 0.01896 0.06530 0.09813 0.11989 0.13229 0.13631 0.13229 0.11989 0.09813 0.06530 0.01896 0.40625 0.02051 0.07126 0.10780 0.13229 0.14632 0.15089 0.14632 0.13229 0.10780 0.07126 0.02051 0.50000 0.02100 0.07318 0.11093 0.13631 0.15089 0.15564 0.15089 0.13631 0.11093 0.07318 0.02100 0.59375 0.02051 0.07126 0.10780 0.13229 0.14632 0.15089 0.14632 0.13229 0.10780 0.07126 0.02051 0.68750 0.01896 0.06530 0.09813 0.11989 0.13229 0.13631 0.13229 0.11989 0.09813 0.06530 0.01896 0.78125 0.01617 0.05461 0.08098 0.09813 0.10780 0.11093 0.10780 0.09813 0.08098 0.05461 0.01617 0.87500 0.01165 0.03772 0.05461 0.06530 0.07126 0.07318 0.07126 0.06530 0.05461 0.03772 0.01165 0.96875 0.00405 0.01165 0.01617 0.01896 0.02051 0.02100 0.02051 0.01896 0.01617 0.01165 0.00405 Final Statistics.. nni = 7 nfe = 8 nbcfails = 0 nbacktr = 0 nje = 1 nfeB = 63 lenrw = 4822 leniw = 27 lenrwB = 150877 leniwB = 961 sundials-2.5.0/examples/kinsol/serial/kinKrylovDemo_ls.c0000600000175000017500000006264411741421273024263 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:08:49 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * * This example loops through the available iterative linear solvers: * SPGMR, SPBCG and SPTFQMR. * * Example (serial): * * This example solves a nonlinear system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion * on the unit square in two dimensions. The dependent variable * vector is the following: * * 1 2 ns * c = (c , c , ..., c ) (denoted by the variable cc) * * and the PDE's are as follows: * * i i * 0 = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The number np is both the * number of prey and predator species. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * b(i) = BB * (1 + alpha * x * y) (i <= np) * b(i) =-BB * (1 + alpha * x * y) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED ( i > np) * * The various scalar parameters are set using define's or in * routine InitUserData. * * The boundary conditions are: normal derivative = 0, and the * initial guess is constant in x and y, but the final solution * is not. * * The PDEs are discretized by central differencing on an MX by * MY mesh. * * The nonlinear system is solved by KINSOL using the method * specified in local variable globalstrat. * * The preconditioner matrix is a block-diagonal matrix based on * the partial derivatives of the interaction terms f only. * * Constraints are imposed to make all components of the solution * positive. * ----------------------------------------------------------------- * References: * * 1. Peter N. Brown and Youcef Saad, * Hybrid Krylov Methods for Nonlinear Systems of Equations * LLNL report UCRL-97645, November 1987. * * 2. Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Lawrence Livermore National Laboratory Report UCRL-95088, * Rev. 1, June 1987, and Journal of Applied Mathematics and * Computation, Vol. 31 (May 1989), pp. 40-91. (Presents a * description of the time-dependent version of this test * problem.) * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 6 /* must equal 2*(number of prey or predators) number of prey = number of predators */ #define PI RCONST(3.1415926535898) /* pi */ #define MX 5 /* MX = number of x mesh points */ #define MY 5 /* MY = number of y mesh points */ #define NSMX (NUM_SPECIES * MX) #define NEQ (NSMX * MY) /* number of equations in the system */ #define AA RCONST(1.0) /* value of coefficient AA in above eqns */ #define EE RCONST(10000.) /* value of coefficient EE in above eqns */ #define GG RCONST(0.5e-6) /* value of coefficient GG in above eqns */ #define BB RCONST(1.0) /* value of coefficient BB in above eqns */ #define DPREY RCONST(1.0) /* value of coefficient dprey above */ #define DPRED RCONST(0.5) /* value of coefficient dpred above */ #define ALPHA RCONST(1.0) /* value of coefficient alpha above */ #define AX RCONST(1.0) /* total range of x variable */ #define AY RCONST(1.0) /* total range of y variable */ #define FTOL RCONST(1.e-7) /* ftol tolerance */ #define STOL RCONST(1.e-13) /* stol tolerance */ #define THOUSAND RCONST(1000.0) /* one thousand */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define TWO RCONST(2.0) /* 2. */ #define PREYIN RCONST(1.0) /* initial guess for prey concentrations. */ #define PREDIN RCONST(30000.0)/* initial guess for predator concs. */ /* Linear Solver Loop Constants */ #define USE_SPGMR 0 #define USE_SPBCG 1 #define USE_SPTFQMR 2 /* User-defined vector access macro: IJ_Vptr */ /* IJ_Vptr is defined in order to translate from the underlying 3D structure of the dependent variable vector to the 1D storage scheme for an N-vector. IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to indices is = 0, jx = i, jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_S(vv, i*NUM_SPECIES + j*NSMX)) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY]; long int *pivot[MX][MY]; realtype **acoef, *bcoef; N_Vector rates; realtype *cox, *coy; realtype ax, ay, dx, dy; realtype uround, sqruround; int mx, my, ns, np; } *UserData; /* Functions Called by the KINSOL Solver */ static int func(N_Vector cc, N_Vector fval, void *user_data); static int PrecSetupBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); static int PrecSolveBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector ftem); /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector cc, N_Vector sc); static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol, int linsolver); static void PrintOutput(N_Vector cc); static void PrintFinalStats(void *kmem, int linsolver); static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data); static realtype DotProd(int size, realtype *x1, realtype *x2); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { int globalstrategy, linsolver; realtype fnormtol, scsteptol; N_Vector cc, sc, constraints; UserData data; int flag, maxl, maxlrst; void *kmem; cc = sc = constraints = NULL; kmem = NULL; data = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ globalstrategy = KIN_NONE; data = AllocUserData(); if (check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); /* Create serial vectors of length NEQ */ cc = N_VNew_Serial(NEQ); if (check_flag((void *)cc, "N_VNew_Serial", 0)) return(1); sc = N_VNew_Serial(NEQ); if (check_flag((void *)sc, "N_VNew_Serial", 0)) return(1); data->rates = N_VNew_Serial(NEQ); if (check_flag((void *)data->rates, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); N_VConst(TWO, constraints); SetInitialProfiles(cc, sc); fnormtol=FTOL; scsteptol=STOL; /* Call KINCreate/KINInit to initialize KINSOL: nvSpec is the nvSpec pointer used in the serial version A pointer to KINSOL problem memory is returned and stored in kmem. */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); /* Vector cc passed as template vector. */ flag = KINInit(kmem, func, cc); if (check_flag(&flag, "KINInit", 1)) return(1); flag = KINSetUserData(kmem, data); if (check_flag(&flag, "KINSetUserData", 1)) return(1); flag = KINSetConstraints(kmem, constraints); if (check_flag(&flag, "KINSetConstraints", 1)) return(1); flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1); /* We no longer need the constraints vector since KINSetConstraints creates a private copy for KINSOL to use. */ N_VDestroy_Serial(constraints); /* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ for (linsolver = 0; linsolver < 3; ++linsolver) { /* Re-initialize user data */ if (linsolver != 0) SetInitialProfiles(cc, sc); /* Attach a linear solver module */ switch(linsolver) { /* (a) SPGMR */ case(USE_SPGMR): /* Print header */ printf(" -------"); printf(" \n| SPGMR |\n"); printf(" -------\n"); /* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner routines PrecSetupBD and PrecSolveBD, and the pointer to the user block data. */ maxl = 15; maxlrst = 2; flag = KINSpgmr(kmem, maxl); if (check_flag(&flag, "KINSpgmr", 1)) return(1); flag = KINSpilsSetMaxRestarts(kmem, maxlrst); if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1)) return(1); break; /* (b) SPBCG */ case(USE_SPBCG): /* Print header */ printf(" -------"); printf(" \n| SPBCG |\n"); printf(" -------\n"); /* Call KINSpbcg to specify the linear solver KINSPBCG with preconditioner routines PrecSetupBD and PrecSolveBD, and the pointer to the user block data. */ maxl = 15; flag = KINSpbcg(kmem, maxl); if (check_flag(&flag, "KINSpbcg", 1)) return(1); break; /* (c) SPTFQMR */ case(USE_SPTFQMR): /* Print header */ printf(" ---------"); printf(" \n| SPTFQMR |\n"); printf(" ---------\n"); /* Call KINSptfqmr to specify the linear solver KINSPTFQMR with preconditioner routines PrecSetupBD and PrecSolveBD, and the pointer to the user block data. */ maxl = 25; flag = KINSptfqmr(kmem, maxl); if (check_flag(&flag, "KINSptfqmr", 1)) return(1); break; } /* Set preconditioner functions */ flag = KINSpilsSetPreconditioner(kmem, PrecSetupBD, PrecSolveBD); if (check_flag(&flag, "KINSpilsSetPreconditioner", 1)) return(1); /* Print out the problem size, solution parameters, initial guess. */ PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol, linsolver); /* Call KINSol and print output concentration profile */ flag = KINSol(kmem, /* KINSol memory block */ cc, /* initial guess on input; solution vector */ globalstrategy, /* global stragegy choice */ sc, /* scaling vector, for the variable cc */ sc); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); printf("\n\nComputed equilibrium species concentrations:\n"); PrintOutput(cc); /* Print final statistics and free memory */ PrintFinalStats(kmem, linsolver); } /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */ N_VDestroy_Serial(cc); N_VDestroy_Serial(sc); KINFree(&kmem); FreeUserData(data); return(0); } /* Readability definitions used in other routines below */ #define acoef (data->acoef) #define bcoef (data->bcoef) #define cox (data->cox) #define coy (data->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * System function for predator-prey system */ static int func(N_Vector cc, N_Vector fval, void *user_data) { realtype xx, yy, delx, dely, *cxy, *rxy, *fxy, dcyli, dcyui, dcxli, dcxri; int jx, jy, is, idyu, idyl, idxr, idxl; UserData data; data = (UserData)user_data; delx = data->dx; dely = data->dy; /* Loop over all mesh points, evaluating rate array at each point*/ for (jy = 0; jy < MY; jy++) { yy = dely*jy; /* Set lower/upper index shifts, special at boundaries. */ idyl = (jy != 0 ) ? NSMX : -NSMX; idyu = (jy != MY-1) ? NSMX : -NSMX; for (jx = 0; jx < MX; jx++) { xx = delx*jx; /* Set left/right index shifts, special at boundaries. */ idxl = (jx != 0 ) ? NUM_SPECIES : -NUM_SPECIES; idxr = (jx != MX-1) ? NUM_SPECIES : -NUM_SPECIES; cxy = IJ_Vptr(cc,jx,jy); rxy = IJ_Vptr(data->rates,jx,jy); fxy = IJ_Vptr(fval,jx,jy); /* Get species interaction rate array at (xx,yy) */ WebRate(xx, yy, cxy, rxy, user_data); for(is = 0; is < NUM_SPECIES; is++) { /* Differencing in x direction */ dcyli = *(cxy+is) - *(cxy - idyl + is) ; dcyui = *(cxy + idyu + is) - *(cxy+is); /* Differencing in y direction */ dcxli = *(cxy+is) - *(cxy - idxl + is); dcxri = *(cxy + idxr +is) - *(cxy+is); /* Compute the total rate value at (xx,yy) */ fxy[is] = (coy)[is] * (dcyui - dcyli) + (cox)[is] * (dcxri - dcxli) + rxy[is]; } /* end of is loop */ } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * Preconditioner setup routine. Generate and preprocess P. */ static int PrecSetupBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype r, r0, uround, sqruround, xx, yy, delx, dely, csave, fac; realtype *cxy, *scxy, **Pxy, *ratesxy, *Pxycol, perturb_rates[NUM_SPECIES]; int i, j, jx, jy, ret; UserData data; data = (UserData) user_data; delx = data->dx; dely = data->dy; uround = data->uround; sqruround = data->sqruround; fac = N_VWL2Norm(fval, fscale); r0 = THOUSAND * uround * fac * NEQ; if(r0 == ZERO) r0 = ONE; /* Loop over spatial points; get size NUM_SPECIES Jacobian block at each */ for (jy = 0; jy < MY; jy++) { yy = jy*dely; for (jx = 0; jx < MX; jx++) { xx = jx*delx; Pxy = (data->P)[jx][jy]; cxy = IJ_Vptr(cc,jx,jy); scxy= IJ_Vptr(cscale,jx,jy); ratesxy = IJ_Vptr((data->rates),jx,jy); /* Compute difference quotients of interaction rate fn. */ for (j = 0; j < NUM_SPECIES; j++) { csave = cxy[j]; /* Save the j,jx,jy element of cc */ r = MAX(sqruround*ABS(csave), r0/scxy[j]); cxy[j] += r; /* Perturb the j,jx,jy element of cc */ fac = ONE/r; WebRate(xx, yy, cxy, perturb_rates, data); /* Restore j,jx,jy element of cc */ cxy[j] = csave; /* Load the j-th column of difference quotients */ Pxycol = Pxy[j]; for (i = 0; i < NUM_SPECIES; i++) Pxycol[i] = (perturb_rates[i] - ratesxy[i]) * fac; } /* end of j loop */ /* Do LU decomposition of size NUM_SPECIES preconditioner block */ ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (data->pivot)[jx][jy]); if (ret != 0) return(1); } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * Preconditioner solve routine */ static int PrecSolveBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector ftem) { realtype **Pxy, *vxy; long int *piv, jx, jy; UserData data; data = (UserData)user_data; for (jx=0; jxP)[jx][jy]; piv = (data->pivot)[jx][jy]; denseGETRS(Pxy, NUM_SPECIES, piv, vxy); } /* end of jy loop */ } /* end of jx loop */ return(0); } /* * Interaction rate function routine */ static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data) { int i; realtype fac; UserData data; data = (UserData)user_data; for (i = 0; iP)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); bcoef = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); cox = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); coy = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); return(data); } /* * Load problem constants in data */ static void InitUserData(UserData data) { int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2; data->mx = MX; data->my = MY; data->ns = NUM_SPECIES; data->np = NUM_SPECIES/2; data->ax = AX; data->ay = AY; data->dx = (data->ax)/(MX-1); data->dy = (data->ay)/(MY-1); data->uround = UNIT_ROUNDOFF; data->sqruround = SQRT(data->uround); /* Set up the coefficients a and b plus others found in the equations */ np = data->np; dx2=(data->dx)*(data->dx); dy2=(data->dy)*(data->dy); for (i = 0; i < np; i++) { a1= &(acoef[i][np]); a2= &(acoef[i+np][0]); a3= &(acoef[i][0]); a4= &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* and then change the diagonal elements of acoef to -AA */ acoef[i][i]=-AA; acoef[i+np][i+np] = -AA; bcoef[i] = BB; bcoef[i+np] = -BB; cox[i]=DPREY/dx2; cox[i+np]=DPRED/dx2; coy[i]=DPREY/dy2; coy[i+np]=DPRED/dy2; } } /* * Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } destroyMat(acoef); free(bcoef); free(cox); free(coy); N_VDestroy_Serial(data->rates); free(data); } /* * Set initial conditions in cc */ static void SetInitialProfiles(N_Vector cc, N_Vector sc) { int i, jx, jy; realtype *cloc, *sloc; realtype ctemp[NUM_SPECIES], stemp[NUM_SPECIES]; /* Initialize arrays ctemp and stemp used in the loading process */ for (i = 0; i < NUM_SPECIES/2; i++) { ctemp[i] = PREYIN; stemp[i] = ONE; } for (i = NUM_SPECIES/2; i < NUM_SPECIES; i++) { ctemp[i] = PREDIN; stemp[i] = RCONST(0.00001); } /* Load initial profiles into cc and sc vector from ctemp and stemp. */ for (jy = 0; jy < MY; jy++) { for (jx = 0; jx < MX; jx++) { cloc = IJ_Vptr(cc,jx,jy); sloc = IJ_Vptr(sc,jx,jy); for (i = 0; i < NUM_SPECIES; i++) { cloc[i] = ctemp[i]; sloc[i] = stemp[i]; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol, int linsolver) { printf("\nPredator-prey test problem -- KINSol (serial version)\n\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Number of species = %d\n", NUM_SPECIES); printf("Total system size = %d\n\n", NEQ); printf("Flag globalstrategy = %d (0 = None, 1 = Linesearch)\n", globalstrategy); switch(linsolver) { case(USE_SPGMR): printf("Linear solver is SPGMR with maxl = %d, maxlrst = %d\n", maxl, maxlrst); break; case(USE_SPBCG): printf("Linear solver is SPBCG with maxl = %d\n", maxl); break; case(USE_SPTFQMR): printf("Linear solver is SPTFQMR with maxl = %d\n", maxl); break; } printf("Preconditioning uses interaction-only block-diagonal matrix\n"); printf("Positivity constraints imposed on all components \n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: fnormtol = %Lg scsteptol = %Lg\n", fnormtol, scsteptol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: fnormtol = %lg scsteptol = %lg\n", fnormtol, scsteptol); #else printf("Tolerance parameters: fnormtol = %g scsteptol = %g\n", fnormtol, scsteptol); #endif printf("\nInitial profile of concentration\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At all mesh points: %Lg %Lg %Lg %Lg %Lg %Lg\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At all mesh points: %lg %lg %lg %lg %lg %lg\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #else printf("At all mesh points: %g %g %g %g %g %g\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #endif } /* * Print sampled values of current cc */ static void PrintOutput(N_Vector cc) { int is, jx, jy; realtype *ct; jy = 0; jx = 0; ct = IJ_Vptr(cc,jx,jy); printf("\nAt bottom left:"); /* Print out lines with up to 6 values per line */ for (is = 0; is < NUM_SPECIES; is++){ if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } jy = MY-1; jx = MX-1; ct = IJ_Vptr(cc,jx,jy); printf("\n\nAt top right:"); /* Print out lines with up to 6 values per line */ for (is = 0; is < NUM_SPECIES; is++) { if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } printf("\n\n"); } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *kmem, int linsolver) { long int nni, nfe, nli, npe, nps, ncfl, nfeSG; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1); flag = KINSpilsGetNumLinIters(kmem, &nli); check_flag(&flag, "KINSpilsGetNumLinIters", 1); flag = KINSpilsGetNumPrecEvals(kmem, &npe); check_flag(&flag, "KINSpilsGetNumPrecEvals", 1); flag = KINSpilsGetNumPrecSolves(kmem, &nps); check_flag(&flag, "KINSpilsGetNumPrecSolves", 1); flag = KINSpilsGetNumConvFails(kmem, &ncfl); check_flag(&flag, "KINSpilsGetNumConvFails", 1); flag = KINSpilsGetNumFuncEvals(kmem, &nfeSG); check_flag(&flag, "KINSpilsGetNumFuncEvals", 1); printf("Final Statistics.. \n"); printf("nni = %5ld nli = %5ld\n", nni, nli); printf("nfe = %5ld nfeSG = %5ld\n", nfe, nfeSG); printf("nps = %5ld npe = %5ld ncfl = %5ld\n", nps, npe, ncfl); if (linsolver < 2) printf("\n=========================================================\n\n"); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/serial/kinKrylovDemo_ls.out0000600000175000017500000000475511741421273024647 0ustar sylvestresylvestre ------- | SPGMR | ------- Predator-prey test problem -- KINSol (serial version) Mesh dimensions = 5 X 5 Number of species = 6 Total system size = 150 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPGMR with maxl = 15, maxlrst = 2 Preconditioning uses interaction-only block-diagonal matrix Positivity constraints imposed on all components Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.16253 1.16253 1.16253 34875 34875 34875 At top right: 1.2637 1.2637 1.2637 37908.7 37908.7 37908.7 Final Statistics.. nni = 5 nli = 90 nfe = 6 nfeSG = 95 nps = 95 npe = 1 ncfl = 0 ========================================================= ------- | SPBCG | ------- Predator-prey test problem -- KINSol (serial version) Mesh dimensions = 5 X 5 Number of species = 6 Total system size = 150 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPBCG with maxl = 15 Preconditioning uses interaction-only block-diagonal matrix Positivity constraints imposed on all components Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.16253 1.16253 1.16253 34875 34875 34875 At top right: 1.2637 1.2637 1.2637 37908.7 37908.7 37908.7 Final Statistics.. nni = 7 nli = 82 nfe = 8 nfeSG = 171 nps = 171 npe = 1 ncfl = 4 ========================================================= --------- | SPTFQMR | --------- Predator-prey test problem -- KINSol (serial version) Mesh dimensions = 5 X 5 Number of species = 6 Total system size = 150 Flag globalstrategy = 0 (0 = None, 1 = Linesearch) Linear solver is SPTFQMR with maxl = 25 Preconditioning uses interaction-only block-diagonal matrix Positivity constraints imposed on all components Tolerance parameters: fnormtol = 1e-07 scsteptol = 1e-13 Initial profile of concentration At all mesh points: 1 1 1 30000 30000 30000 Computed equilibrium species concentrations: At bottom left: 1.16253 1.16253 1.16253 34875 34875 34875 At top right: 1.2637 1.2637 1.2637 37908.7 37908.7 37908.7 Final Statistics.. nni = 8 nli = 166 nfe = 9 nfeSG = 676 nps = 676 npe = 1 ncfl = 6 sundials-2.5.0/examples/kinsol/serial/kinFoodWeb_kry.c0000600000175000017500000005625511741421273023705 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.3 $ * $Date: 2010/12/01 23:08:49 $ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * Example (serial): * * This example solves a nonlinear system that arises from a system * of partial differential equations. The PDE system is a food web * population model, with predator-prey interaction and diffusion * on the unit square in two dimensions. The dependent variable * vector is the following: * * 1 2 ns * c = (c , c , ..., c ) (denoted by the variable cc) * * and the PDE's are as follows: * * i i * 0 = d(i)*(c + c ) + f (x,y,c) (i=1,...,ns) * xx yy i * * where * * i ns j * f (x,y,c) = c * (b(i) + sum a(i,j)*c ) * i j=1 * * The number of species is ns = 2 * np, with the first np being * prey and the last np being predators. The number np is both the * number of prey and predator species. The coefficients a(i,j), * b(i), d(i) are: * * a(i,i) = -AA (all i) * a(i,j) = -GG (i <= np , j > np) * a(i,j) = EE (i > np, j <= np) * b(i) = BB * (1 + alpha * x * y) (i <= np) * b(i) =-BB * (1 + alpha * x * y) (i > np) * d(i) = DPREY (i <= np) * d(i) = DPRED ( i > np) * * The various scalar parameters are set using define's or in * routine InitUserData. * * The boundary conditions are: normal derivative = 0, and the * initial guess is constant in x and y, but the final solution * is not. * * The PDEs are discretized by central differencing on an MX by * MY mesh. * * The nonlinear system is solved by KINSOL using the method * specified in local variable globalstrat. * * The preconditioner matrix is a block-diagonal matrix based on * the partial derivatives of the interaction terms f only. * * Constraints are imposed to make all components of the solution * positive. * ----------------------------------------------------------------- * References: * * 1. Peter N. Brown and Youcef Saad, * Hybrid Krylov Methods for Nonlinear Systems of Equations * LLNL report UCRL-97645, November 1987. * * 2. Peter N. Brown and Alan C. Hindmarsh, * Reduced Storage Matrix Methods in Stiff ODE systems, * Lawrence Livermore National Laboratory Report UCRL-95088, * Rev. 1, June 1987, and Journal of Applied Mathematics and * Computation, Vol. 31 (May 1989), pp. 40-91. (Presents a * description of the time-dependent version of this test * problem.) * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include #include /* Problem Constants */ #define NUM_SPECIES 6 /* must equal 2*(number of prey or predators) number of prey = number of predators */ #define PI RCONST(3.1415926535898) /* pi */ #define MX 8 /* MX = number of x mesh points */ #define MY 8 /* MY = number of y mesh points */ #define NSMX (NUM_SPECIES * MX) #define NEQ (NSMX * MY) /* number of equations in the system */ #define AA RCONST(1.0) /* value of coefficient AA in above eqns */ #define EE RCONST(10000.) /* value of coefficient EE in above eqns */ #define GG RCONST(0.5e-6) /* value of coefficient GG in above eqns */ #define BB RCONST(1.0) /* value of coefficient BB in above eqns */ #define DPREY RCONST(1.0) /* value of coefficient dprey above */ #define DPRED RCONST(0.5) /* value of coefficient dpred above */ #define ALPHA RCONST(1.0) /* value of coefficient alpha above */ #define AX RCONST(1.0) /* total range of x variable */ #define AY RCONST(1.0) /* total range of y variable */ #define FTOL RCONST(1.e-7) /* ftol tolerance */ #define STOL RCONST(1.e-13) /* stol tolerance */ #define THOUSAND RCONST(1000.0) /* one thousand */ #define ZERO RCONST(0.) /* 0. */ #define ONE RCONST(1.0) /* 1. */ #define TWO RCONST(2.0) /* 2. */ #define PREYIN RCONST(1.0) /* initial guess for prey concentrations. */ #define PREDIN RCONST(30000.0)/* initial guess for predator concs. */ /* User-defined vector access macro: IJ_Vptr */ /* IJ_Vptr is defined in order to translate from the underlying 3D structure of the dependent variable vector to the 1D storage scheme for an N-vector. IJ_Vptr(vv,i,j) returns a pointer to the location in vv corresponding to indices is = 0, jx = i, jy = j. */ #define IJ_Vptr(vv,i,j) (&NV_Ith_S(vv, i*NUM_SPECIES + j*NSMX)) /* Type : UserData contains preconditioner blocks, pivot arrays, and problem constants */ typedef struct { realtype **P[MX][MY]; long int *pivot[MX][MY]; realtype **acoef, *bcoef; N_Vector rates; realtype *cox, *coy; realtype ax, ay, dx, dy; realtype uround, sqruround; long int mx, my, ns, np; } *UserData; /* Functions Called by the KINSOL Solver */ static int func(N_Vector cc, N_Vector fval, void *user_data); static int PrecSetupBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2); static int PrecSolveBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector ftem); /* Private Helper Functions */ static UserData AllocUserData(void); static void InitUserData(UserData data); static void FreeUserData(UserData data); static void SetInitialProfiles(N_Vector cc, N_Vector sc); static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol); static void PrintOutput(N_Vector cc); static void PrintFinalStats(void *kmem); static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data); static realtype DotProd(long int size, realtype *x1, realtype *x2); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main(void) { int globalstrategy; realtype fnormtol, scsteptol; N_Vector cc, sc, constraints; UserData data; int flag, maxl, maxlrst; void *kmem; cc = sc = constraints = NULL; kmem = NULL; data = NULL; /* Allocate memory, and set problem data, initial values, tolerances */ globalstrategy = KIN_NONE; data = AllocUserData(); if (check_flag((void *)data, "AllocUserData", 2)) return(1); InitUserData(data); /* Create serial vectors of length NEQ */ cc = N_VNew_Serial(NEQ); if (check_flag((void *)cc, "N_VNew_Serial", 0)) return(1); sc = N_VNew_Serial(NEQ); if (check_flag((void *)sc, "N_VNew_Serial", 0)) return(1); data->rates = N_VNew_Serial(NEQ); if (check_flag((void *)data->rates, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); N_VConst(TWO, constraints); SetInitialProfiles(cc, sc); fnormtol=FTOL; scsteptol=STOL; /* Call KINCreate/KINInit to initialize KINSOL. A pointer to KINSOL problem memory is returned and stored in kmem. */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); /* Vector cc passed as template vector. */ flag = KINInit(kmem, func, cc); if (check_flag(&flag, "KINInit", 1)) return(1); flag = KINSetUserData(kmem, data); if (check_flag(&flag, "KINSetUserData", 1)) return(1); flag = KINSetConstraints(kmem, constraints); if (check_flag(&flag, "KINSetConstraints", 1)) return(1); flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1); /* We no longer need the constraints vector since KINSetConstraints creates a private copy for KINSOL to use. */ N_VDestroy_Serial(constraints); /* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner routines PrecSetupBD and PrecSolveBD. */ maxl = 15; maxlrst = 2; flag = KINSpgmr(kmem, maxl); if (check_flag(&flag, "KINSpgmr", 1)) return(1); flag = KINSpilsSetMaxRestarts(kmem, maxlrst); if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1)) return(1); flag = KINSpilsSetPreconditioner(kmem, PrecSetupBD, PrecSolveBD); if (check_flag(&flag, "KINSpilsSetPreconditioner", 1)) return(1); /* Print out the problem size, solution parameters, initial guess. */ PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol); /* Call KINSol and print output concentration profile */ flag = KINSol(kmem, /* KINSol memory block */ cc, /* initial guess on input; solution vector */ globalstrategy, /* global stragegy choice */ sc, /* scaling vector, for the variable cc */ sc); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); printf("\n\nComputed equilibrium species concentrations:\n"); PrintOutput(cc); /* Print final statistics and free memory */ PrintFinalStats(kmem); N_VDestroy_Serial(cc); N_VDestroy_Serial(sc); KINFree(&kmem); FreeUserData(data); return(0); } /* Readability definitions used in other routines below */ #define acoef (data->acoef) #define bcoef (data->bcoef) #define cox (data->cox) #define coy (data->coy) /* *-------------------------------------------------------------------- * FUNCTIONS CALLED BY KINSOL *-------------------------------------------------------------------- */ /* * System function for predator-prey system */ static int func(N_Vector cc, N_Vector fval, void *user_data) { realtype xx, yy, delx, dely, *cxy, *rxy, *fxy, dcyli, dcyui, dcxli, dcxri; long int jx, jy, is, idyu, idyl, idxr, idxl; UserData data; data = (UserData)user_data; delx = data->dx; dely = data->dy; /* Loop over all mesh points, evaluating rate array at each point*/ for (jy = 0; jy < MY; jy++) { yy = dely*jy; /* Set lower/upper index shifts, special at boundaries. */ idyl = (jy != 0 ) ? NSMX : -NSMX; idyu = (jy != MY-1) ? NSMX : -NSMX; for (jx = 0; jx < MX; jx++) { xx = delx*jx; /* Set left/right index shifts, special at boundaries. */ idxl = (jx != 0 ) ? NUM_SPECIES : -NUM_SPECIES; idxr = (jx != MX-1) ? NUM_SPECIES : -NUM_SPECIES; cxy = IJ_Vptr(cc,jx,jy); rxy = IJ_Vptr(data->rates,jx,jy); fxy = IJ_Vptr(fval,jx,jy); /* Get species interaction rate array at (xx,yy) */ WebRate(xx, yy, cxy, rxy, user_data); for(is = 0; is < NUM_SPECIES; is++) { /* Differencing in x direction */ dcyli = *(cxy+is) - *(cxy - idyl + is) ; dcyui = *(cxy + idyu + is) - *(cxy+is); /* Differencing in y direction */ dcxli = *(cxy+is) - *(cxy - idxl + is); dcxri = *(cxy + idxr +is) - *(cxy+is); /* Compute the total rate value at (xx,yy) */ fxy[is] = (coy)[is] * (dcyui - dcyli) + (cox)[is] * (dcxri - dcxli) + rxy[is]; } /* end of is loop */ } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * Preconditioner setup routine. Generate and preprocess P. */ static int PrecSetupBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype r, r0, uround, sqruround, xx, yy, delx, dely, csave, fac; realtype *cxy, *scxy, **Pxy, *ratesxy, *Pxycol, perturb_rates[NUM_SPECIES]; long int i, j, jx, jy, ret; UserData data; data = (UserData) user_data; delx = data->dx; dely = data->dy; uround = data->uround; sqruround = data->sqruround; fac = N_VWL2Norm(fval, fscale); r0 = THOUSAND * uround * fac * NEQ; if(r0 == ZERO) r0 = ONE; /* Loop over spatial points; get size NUM_SPECIES Jacobian block at each */ for (jy = 0; jy < MY; jy++) { yy = jy*dely; for (jx = 0; jx < MX; jx++) { xx = jx*delx; Pxy = (data->P)[jx][jy]; cxy = IJ_Vptr(cc,jx,jy); scxy= IJ_Vptr(cscale,jx,jy); ratesxy = IJ_Vptr((data->rates),jx,jy); /* Compute difference quotients of interaction rate fn. */ for (j = 0; j < NUM_SPECIES; j++) { csave = cxy[j]; /* Save the j,jx,jy element of cc */ r = MAX(sqruround*ABS(csave), r0/scxy[j]); cxy[j] += r; /* Perturb the j,jx,jy element of cc */ fac = ONE/r; WebRate(xx, yy, cxy, perturb_rates, data); /* Restore j,jx,jy element of cc */ cxy[j] = csave; /* Load the j-th column of difference quotients */ Pxycol = Pxy[j]; for (i = 0; i < NUM_SPECIES; i++) Pxycol[i] = (perturb_rates[i] - ratesxy[i]) * fac; } /* end of j loop */ /* Do LU decomposition of size NUM_SPECIES preconditioner block */ ret = denseGETRF(Pxy, NUM_SPECIES, NUM_SPECIES, (data->pivot)[jx][jy]); if (ret != 0) return(1); } /* end of jx loop */ } /* end of jy loop */ return(0); } /* * Preconditioner solve routine */ static int PrecSolveBD(N_Vector cc, N_Vector cscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data, N_Vector ftem) { realtype **Pxy, *vxy; long int *piv, jx, jy; UserData data; data = (UserData)user_data; for (jx=0; jxP)[jx][jy]; piv = (data->pivot)[jx][jy]; denseGETRS(Pxy, NUM_SPECIES, piv, vxy); } /* end of jy loop */ } /* end of jx loop */ return(0); } /* * Interaction rate function routine */ static void WebRate(realtype xx, realtype yy, realtype *cxy, realtype *ratesxy, void *user_data) { long int i; realtype fac; UserData data; data = (UserData)user_data; for (i = 0; iP)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES); (data->pivot)[jx][jy] = newLintArray(NUM_SPECIES); } } acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES); bcoef = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); cox = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); coy = (realtype *)malloc(NUM_SPECIES * sizeof(realtype)); return(data); } /* * Load problem constants in data */ static void InitUserData(UserData data) { long int i, j, np; realtype *a1,*a2, *a3, *a4, dx2, dy2; data->mx = MX; data->my = MY; data->ns = NUM_SPECIES; data->np = NUM_SPECIES/2; data->ax = AX; data->ay = AY; data->dx = (data->ax)/(MX-1); data->dy = (data->ay)/(MY-1); data->uround = UNIT_ROUNDOFF; data->sqruround = SQRT(data->uround); /* Set up the coefficients a and b plus others found in the equations */ np = data->np; dx2=(data->dx)*(data->dx); dy2=(data->dy)*(data->dy); for (i = 0; i < np; i++) { a1= &(acoef[i][np]); a2= &(acoef[i+np][0]); a3= &(acoef[i][0]); a4= &(acoef[i+np][np]); /* Fill in the portion of acoef in the four quadrants, row by row */ for (j = 0; j < np; j++) { *a1++ = -GG; *a2++ = EE; *a3++ = ZERO; *a4++ = ZERO; } /* and then change the diagonal elements of acoef to -AA */ acoef[i][i]=-AA; acoef[i+np][i+np] = -AA; bcoef[i] = BB; bcoef[i+np] = -BB; cox[i]=DPREY/dx2; cox[i+np]=DPRED/dx2; coy[i]=DPREY/dy2; coy[i+np]=DPRED/dy2; } } /* * Free data memory */ static void FreeUserData(UserData data) { int jx, jy; for (jx=0; jx < MX; jx++) { for (jy=0; jy < MY; jy++) { destroyMat((data->P)[jx][jy]); destroyArray((data->pivot)[jx][jy]); } } destroyMat(acoef); free(bcoef); free(cox); free(coy); N_VDestroy_Serial(data->rates); free(data); } /* * Set initial conditions in cc */ static void SetInitialProfiles(N_Vector cc, N_Vector sc) { int i, jx, jy; realtype *cloc, *sloc; realtype ctemp[NUM_SPECIES], stemp[NUM_SPECIES]; /* Initialize arrays ctemp and stemp used in the loading process */ for (i = 0; i < NUM_SPECIES/2; i++) { ctemp[i] = PREYIN; stemp[i] = ONE; } for (i = NUM_SPECIES/2; i < NUM_SPECIES; i++) { ctemp[i] = PREDIN; stemp[i] = RCONST(0.00001); } /* Load initial profiles into cc and sc vector from ctemp and stemp. */ for (jy = 0; jy < MY; jy++) { for (jx = 0; jx < MX; jx++) { cloc = IJ_Vptr(cc,jx,jy); sloc = IJ_Vptr(sc,jx,jy); for (i = 0; i < NUM_SPECIES; i++) { cloc[i] = ctemp[i]; sloc[i] = stemp[i]; } } } } /* * Print first lines of output (problem description) */ static void PrintHeader(int globalstrategy, int maxl, int maxlrst, realtype fnormtol, realtype scsteptol) { printf("\nPredator-prey test problem -- KINSol (serial version)\n\n"); printf("Mesh dimensions = %d X %d\n", MX, MY); printf("Number of species = %d\n", NUM_SPECIES); printf("Total system size = %d\n\n", NEQ); printf("Flag globalstrategy = %d (0 = None, 1 = Linesearch)\n", globalstrategy); printf("Linear solver is SPGMR with maxl = %d, maxlrst = %d\n", maxl, maxlrst); printf("Preconditioning uses interaction-only block-diagonal matrix\n"); printf("Positivity constraints imposed on all components \n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("Tolerance parameters: fnormtol = %Lg scsteptol = %Lg\n", fnormtol, scsteptol); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("Tolerance parameters: fnormtol = %lg scsteptol = %lg\n", fnormtol, scsteptol); #else printf("Tolerance parameters: fnormtol = %g scsteptol = %g\n", fnormtol, scsteptol); #endif printf("\nInitial profile of concentration\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf("At all mesh points: %Lg %Lg %Lg %Lg %Lg %Lg\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf("At all mesh points: %lg %lg %lg %lg %lg %lg\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #else printf("At all mesh points: %g %g %g %g %g %g\n", PREYIN, PREYIN, PREYIN, PREDIN, PREDIN, PREDIN); #endif } /* * Print sampled values of current cc */ static void PrintOutput(N_Vector cc) { int is, jx, jy; realtype *ct; jy = 0; jx = 0; ct = IJ_Vptr(cc,jx,jy); printf("\nAt bottom left:"); /* Print out lines with up to 6 values per line */ for (is = 0; is < NUM_SPECIES; is++){ if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } jy = MY-1; jx = MX-1; ct = IJ_Vptr(cc,jx,jy); printf("\n\nAt top right:"); /* Print out lines with up to 6 values per line */ for (is = 0; is < NUM_SPECIES; is++) { if ((is%6)*6 == is) printf("\n"); #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %Lg",ct[is]); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %lg",ct[is]); #else printf(" %g",ct[is]); #endif } printf("\n\n"); } /* * Print final statistics contained in iopt */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nli, npe, nps, ncfl, nfeSG; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1); flag = KINSpilsGetNumLinIters(kmem, &nli); check_flag(&flag, "KINSpilsGetNumLinIters", 1); flag = KINSpilsGetNumPrecEvals(kmem, &npe); check_flag(&flag, "KINSpilsGetNumPrecEvals", 1); flag = KINSpilsGetNumPrecSolves(kmem, &nps); check_flag(&flag, "KINSpilsGetNumPrecSolves", 1); flag = KINSpilsGetNumConvFails(kmem, &ncfl); check_flag(&flag, "KINSpilsGetNumConvFails", 1); flag = KINSpilsGetNumFuncEvals(kmem, &nfeSG); check_flag(&flag, "KINSpilsGetNumFuncEvals", 1); printf("Final Statistics.. \n"); printf("nni = %5ld nli = %5ld\n", nni, nli); printf("nfe = %5ld nfeSG = %5ld\n", nfe, nfeSG); printf("nps = %5ld npe = %5ld ncfl = %5ld\n", nps, npe, ncfl); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/serial/kinRoboKin_dns.c0000600000175000017500000002517611741421273023700 0ustar sylvestresylvestre/* * ----------------------------------------------------------------- * $Revision: 1.2 $ * $Date: 2010/12/01 23:08:49 $ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * This example solves a nonlinear system from robot kinematics. * * Source: "Handbook of Test Problems in Local and Global Optimization", * C.A. Floudas, P.M. Pardalos et al. * Kluwer Academic Publishers, 1999. * Test problem 6 from Section 14.1, Chapter 14 * * The nonlinear system is solved by KINSOL using the DENSE linear * solver. * * Constraints are imposed to make all components of the solution * be within [-1,1]. * ----------------------------------------------------------------- */ #include #include #include #include #include #include #include #include /* Problem Constants */ #define NVAR 8 /* variables */ #define NEQ 3*NVAR /* equations + bounds */ #define FTOL RCONST(1.e-5) /* function tolerance */ #define STOL RCONST(1.e-5) /* step tolerance */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define Ith(v,i) NV_Ith_S(v,i-1) #define IJth(A,i,j) DENSE_ELEM(A,i-1,j-1) static int func(N_Vector y, N_Vector f, void *user_data); static int jac(long int N, N_Vector y, N_Vector f, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2); static void PrintOutput(N_Vector y); static void PrintFinalStats(void *kmem); static int check_flag(void *flagvalue, char *funcname, int opt); /* *-------------------------------------------------------------------- * MAIN PROGRAM *-------------------------------------------------------------------- */ int main() { realtype fnormtol, scsteptol; N_Vector y, scale, constraints; int mset, flag, i; void *kmem; y = scale = constraints = NULL; kmem = NULL; printf("\nRobot Kinematics Example\n"); printf("8 variables; -1 <= x_i <= 1\n"); printf("KINSOL problem size: 8 + 2*8 = 24 \n\n"); /* Create vectors for solution, scales, and constraints */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); scale = N_VNew_Serial(NEQ); if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1); constraints = N_VNew_Serial(NEQ); if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1); /* Initialize and allocate memory for KINSOL */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); flag = KINInit(kmem, func, y); /* y passed as a template */ if (check_flag(&flag, "KINInit", 1)) return(1); /* Set optional inputs */ N_VConst_Serial(ZERO,constraints); for (i = NVAR+1; i <= NEQ; i++) Ith(constraints, i) = ONE; flag = KINSetConstraints(kmem, constraints); if (check_flag(&flag, "KINSetConstraints", 1)) return(1); fnormtol = FTOL; flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); scsteptol = STOL; flag = KINSetScaledStepTol(kmem, scsteptol); if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1); /* Attach dense linear solver */ flag = KINDense(kmem, NEQ); if (check_flag(&flag, "KINDense", 1)) return(1); flag = KINDlsSetDenseJacFn(kmem, jac); if (check_flag(&flag, "KINDlsSetDenseJacFn", 1)) return(1); /* Indicate exact Newton */ mset = 1; flag = KINSetMaxSetupCalls(kmem, mset); if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1); /* Initial guess */ N_VConst_Serial(ONE, y); for(i = 1; i <= NVAR; i++) Ith(y,i) = SQRT(TWO)/TWO; printf("Initial guess:\n"); PrintOutput(y); /* Call KINSol to solve problem */ N_VConst_Serial(ONE,scale); flag = KINSol(kmem, /* KINSol memory block */ y, /* initial guess on input; solution vector */ KIN_LINESEARCH, /* global stragegy choice */ scale, /* scaling vector, for the variable cc */ scale); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); printf("\nComputed solution:\n"); PrintOutput(y); /* Print final statistics and free memory */ PrintFinalStats(kmem); N_VDestroy_Serial(y); N_VDestroy_Serial(scale); N_VDestroy_Serial(constraints); KINFree(&kmem); return(0); } /* * System function */ static int func(N_Vector y, N_Vector f, void *user_data) { realtype *yd, *fd; realtype x1, x2, x3, x4, x5, x6, x7, x8; realtype l1, l2, l3, l4, l5, l6, l7, l8; realtype u1, u2, u3, u4, u5, u6, u7, u8; realtype eq1, eq2, eq3, eq4, eq5, eq6, eq7, eq8; realtype lb1, lb2, lb3, lb4, lb5, lb6, lb7, lb8; realtype ub1, ub2, ub3, ub4, ub5, ub6, ub7, ub8; yd = NV_DATA_S(y); fd = NV_DATA_S(f); x1 = yd[0]; l1 = yd[ 8]; u1 = yd[16]; x2 = yd[1]; l2 = yd[ 9]; u2 = yd[17]; x3 = yd[2]; l3 = yd[10]; u3 = yd[18]; x4 = yd[3]; l4 = yd[11]; u4 = yd[19]; x5 = yd[4]; l5 = yd[12]; u5 = yd[20]; x6 = yd[5]; l6 = yd[13]; u6 = yd[21]; x7 = yd[6]; l7 = yd[14]; u7 = yd[22]; x8 = yd[7]; l8 = yd[15]; u8 = yd[23]; /* Nonlinear equations */ eq1 = - 0.1238*x1 + x7 - 0.001637*x2 - 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571; eq2 = 0.2638*x1 - x7 - 0.07745*x2 - 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022; eq3 = 0.3578*x1 + 0.004731*x2 + x6*x8; eq4 = - 0.7623*x1 + 0.2238*x2 + 0.3461; eq5 = x1*x1 + x2*x2 - 1; eq6 = x3*x3 + x4*x4 - 1; eq7 = x5*x5 + x6*x6 - 1; eq8 = x7*x7 + x8*x8 - 1; /* Lower bounds ( l_i = 1 + x_i >= 0)*/ lb1 = l1 - 1.0 - x1; lb2 = l2 - 1.0 - x2; lb3 = l3 - 1.0 - x3; lb4 = l4 - 1.0 - x4; lb5 = l5 - 1.0 - x5; lb6 = l6 - 1.0 - x6; lb7 = l7 - 1.0 - x7; lb8 = l8 - 1.0 - x8; /* Upper bounds ( u_i = 1 - x_i >= 0)*/ ub1 = u1 - 1.0 + x1; ub2 = u2 - 1.0 + x2; ub3 = u3 - 1.0 + x3; ub4 = u4 - 1.0 + x4; ub5 = u5 - 1.0 + x5; ub6 = u6 - 1.0 + x6; ub7 = u7 - 1.0 + x7; ub8 = u8 - 1.0 + x8; fd[0] = eq1; fd[ 8] = lb1; fd[16] = ub1; fd[1] = eq2; fd[ 9] = lb2; fd[17] = ub2; fd[2] = eq3; fd[10] = lb3; fd[18] = ub3; fd[3] = eq4; fd[11] = lb4; fd[19] = ub4; fd[4] = eq5; fd[12] = lb5; fd[20] = ub5; fd[5] = eq6; fd[13] = lb6; fd[21] = ub6; fd[6] = eq7; fd[14] = lb7; fd[22] = ub7; fd[7] = eq8; fd[15] = lb8; fd[23] = ub8; return(0); } /* * System Jacobian */ static int jac(long int N, N_Vector y, N_Vector f, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2) { int i; realtype *yd; realtype x1, x2, x3, x4, x5, x6, x7, x8; yd = NV_DATA_S(y); x1 = yd[0]; x2 = yd[1]; x3 = yd[2]; x4 = yd[3]; x5 = yd[4]; x6 = yd[5]; x7 = yd[6]; x8 = yd[7]; /* Nonlinear equations */ /* - 0.1238*x1 + x7 - 0.001637*x2 - 0.9338*x4 + 0.004731*x1*x3 - 0.3578*x2*x3 - 0.3571 */ IJth(J,1,1) = - 0.1238 + 0.004731*x3; IJth(J,1,2) = - 0.001637 - 0.3578*x3; IJth(J,1,3) = 0.004731*x1 - 0.3578*x2; IJth(J,1,4) = - 0.9338; IJth(J,1,7) = 1.0; /* 0.2638*x1 - x7 - 0.07745*x2 - 0.6734*x4 + 0.2238*x1*x3 + 0.7623*x2*x3 - 0.6022 */ IJth(J,2,1) = 0.2638 + 0.2238*x3; IJth(J,2,2) = - 0.07745 + 0.7623*x3; IJth(J,2,3) = 0.2238*x1 + 0.7623*x2; IJth(J,2,4) = - 0.6734; IJth(J,2,7) = -1.0; /* 0.3578*x1 + 0.004731*x2 + x6*x8 */ IJth(J,3,1) = 0.3578; IJth(J,3,2) = 0.004731; IJth(J,3,6) = x8; IJth(J,3,8) = x6; /* - 0.7623*x1 + 0.2238*x2 + 0.3461 */ IJth(J,4,1) = - 0.7623; IJth(J,4,2) = 0.2238; /* x1*x1 + x2*x2 - 1 */ IJth(J,5,1) = 2.0*x1; IJth(J,5,2) = 2.0*x2; /* x3*x3 + x4*x4 - 1 */ IJth(J,6,3) = 2.0*x3; IJth(J,6,4) = 2.0*x4; /* x5*x5 + x6*x6 - 1 */ IJth(J,7,5) = 2.0*x5; IJth(J,7,6) = 2.0*x6; /* x7*x7 + x8*x8 - 1 */ IJth(J,8,7) = 2.0*x7; IJth(J,8,8) = 2.0*x8; /* Lower bounds ( l_i = 1 + x_i >= 0) l_i - 1.0 - x_i */ for(i=1;i<=8;i++) { IJth(J,8+i,i) = -1.0; IJth(J,8+i,8+i) = 1.0; } /* Upper bounds ( u_i = 1 - x_i >= 0) u_i - 1.0 + x_i */ for(i=1;i<=8;i++) { IJth(J,16+i,i) = 1.0; IJth(J,16+i,16+i) = 1.0; } return(0); } /* * Print solution */ static void PrintOutput(N_Vector y) { int i; printf(" l=x+1 x u=1-x\n"); printf(" ----------------------------------\n"); for(i=1; i<=NVAR; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) printf(" %10.6Lg %10.6Lg %10.6Lg\n", Ith(y,i+NVAR), Ith(y,i), Ith(y,i+2*NVAR)); #elif defined(SUNDIALS_DOUBLE_PRECISION) printf(" %10.6lg %10.6lg %10.6lg\n", Ith(y,i+NVAR), Ith(y,i), Ith(y,i+2*NVAR)); #else printf(" %10.6g %10.6g %10.6g\n", Ith(y,i+NVAR), Ith(y,i), Ith(y,i+2*NVAR)); #endif } } /* * Print final statistics */ static void PrintFinalStats(void *kmem) { long int nni, nfe, nje, nfeD; int flag; flag = KINGetNumNonlinSolvIters(kmem, &nni); check_flag(&flag, "KINGetNumNonlinSolvIters", 1); flag = KINGetNumFuncEvals(kmem, &nfe); check_flag(&flag, "KINGetNumFuncEvals", 1); flag = KINDlsGetNumJacEvals(kmem, &nje); check_flag(&flag, "KINDlsGetNumJacEvals", 1); flag = KINDlsGetNumFuncEvals(kmem, &nfeD); check_flag(&flag, "KINDlsGetNumFuncEvals", 1); printf("\nFinal Statistics.. \n"); printf("nni = %5ld nfe = %5ld \n", nni, nfe); printf("nje = %5ld nfeD = %5ld \n", nje, nfeD); } /* * Check function return value... * opt == 0 means SUNDIALS function allocates memory so check if * returned NULL pointer * opt == 1 means SUNDIALS function returns a flag so check if * flag >= 0 * opt == 2 means function allocates memory so check if returned * NULL pointer */ static int check_flag(void *flagvalue, char *funcname, int opt) { int *errflag; /* Check if SUNDIALS function returned NULL pointer - no memory allocated */ if (opt == 0 && flagvalue == NULL) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } /* Check if flag < 0 */ else if (opt == 1) { errflag = (int *) flagvalue; if (*errflag < 0) { fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n", funcname, *errflag); return(1); } } /* Check if function returned NULL pointer - no memory allocated */ else if (opt == 2 && flagvalue == NULL) { fprintf(stderr, "\nMEMORY_ERROR: %s() failed - returned NULL pointer\n\n", funcname); return(1); } return(0); } sundials-2.5.0/examples/kinsol/serial/README0000600000175000017500000000123311741421273021467 0ustar sylvestresylvestreList of serial KINSOL examples kinFerTron_dns: Ferraris-Tronconi example (DENSE) kinFoodWeb_kry: 2-D food web system, block-diagonal preconditioner kinKrylovDemo_ls: demonstration program with 3 Krylov solvers kinLaplace_bnd: 2-D elliptic PDE (BAND) kinRoboKin_dns: Robot kinematics problem (DENSE) Sample result: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 (GCC) sundials-2.5.0/examples/kinsol/fcmix_serial/0000755000175000017500000000000011767174700022016 5ustar sylvestresylvestresundials-2.5.0/examples/kinsol/fcmix_serial/CMakeLists.txt0000600000175000017500000001054011741421273024536 0ustar sylvestresylvestre# --------------------------------------------------------------- # $Revision: 1.5 $ # $Date: 2009/02/17 02:58:47 $ # --------------------------------------------------------------- # Programmer: Radu Serban @ LLNL # --------------------------------------------------------------- # Copyright (c) 2007, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # --------------------------------------------------------------- # CMakeLists.txt file for the FKINSOL serial examples # Add variable kinsol_examples with the names of the serial FKINSOL examples SET(FKINSOL_examples fkinDiagon_kry ) # Add variable FKINSOL_examples_BL with the names of the serial FKINSOL examples # that use Lapack SET(FKINSOL_examples_BL ) # Specify libraries to link against (through the target that was used to # generate them) based on the value of the variable LINK_LIBRARY_TYPE IF(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_static) SET(NVECS_LIB sundials_nvecserial_static) SET(FNVECS_LIB sundials_fnvecserial_static) ELSE(LINK_LIBRARY_TYPE MATCHES "static") SET(KINSOL_LIB sundials_kinsol_shared) SET(NVECS_LIB sundials_nvecserial_shared) SET(FNVECS_LIB sundials_fnvecserial_shared) ENDIF(LINK_LIBRARY_TYPE MATCHES "static") # Only static FCMIX libraries are available SET(FKINSOL_LIB sundials_fkinsol_static) # Set-up linker flags and link libraries SET(SUNDIALS_LIBS ${FKINSOL_LIB} ${KINSOL_LIB} ${FNVECS_LIB} ${NVECS_LIB} ${EXTRA_LINK_LIBS}) IF(LAPACK_FOUND) SET(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}") SET(SUNDIALS_LIBS "${SUNDIALS_LIBS} ${LAPACK_LIBRARIES}") ENDIF(LAPACK_FOUND) # Add the build and install targets for each FKINSOL example FOREACH(example ${FKINSOL_examples}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FKINSOL_examples}) # If Lapack support is enabled, add the build and install targets for # the examples using Lapack IF(LAPACK_FOUND) FOREACH(example ${FKINSOL_examples_BL}) ADD_EXECUTABLE(${example} ${example}.f) TARGET_LINK_LIBRARIES(${example} ${SUNDIALS_LIBS}) IF(EXAMPLES_INSTALL) INSTALL(FILES ${example}.f ${example}.out DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_serial) ENDIF(EXAMPLES_INSTALL) ENDFOREACH(example ${FKINSOL_examples_BL}) ENDIF(LAPACK_FOUND) IF(EXAMPLES_INSTALL) # Install the README file INSTALL(FILES README DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_serial) # Prepare substitution variables for Makefile and/or CMakeLists templates SET(SOLVER "KINSOL") SET(SOLVER_LIB "sundials_kinsol") SET(SOLVER_FLIB "sundials_fkinsol") LIST2STRING(FKINSOL_examples EXAMPLES) IF(LAPACK_FOUND) LIST2STRING(FKINSOL_examples_BL EXAMPLES_BL) ELSE(LAPACK_FOUND) SET(EXAMPLES_BL "") ENDIF(LAPACK_FOUND) # Regardless of the platform we're on, we will generate and install # CMakeLists.txt file for building the examples. This file can then # be used as a template for the user's own programs. # generate CMakelists.txt in the binary directory CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/cmakelists_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_serial/CMakeLists.txt @ONLY ) # install CMakelists.txt INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_serial/CMakeLists.txt DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_serial ) # On UNIX-type platforms, we also generate and install a makefile for # building the examples. This makefile can then be used as a template # for the user's own programs. IF(UNIX) # generate Makefile and place it in the binary dir CONFIGURE_FILE( ${PROJECT_SOURCE_DIR}/examples/templates/makefile_serial_F77_ex.in ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_serial/Makefile_ex @ONLY ) # install the configured Makefile_ex as Makefile INSTALL( FILES ${PROJECT_BINARY_DIR}/examples/kinsol/fcmix_serial/Makefile_ex DESTINATION ${EXAMPLES_INSTALL_PATH}/kinsol/fcmix_serial RENAME Makefile ) ENDIF(UNIX) ENDIF(EXAMPLES_INSTALL) sundials-2.5.0/examples/kinsol/fcmix_serial/Makefile.in0000600000175000017500000001111411741421273024041 0ustar sylvestresylvestre# ----------------------------------------------------------------- # $Revision: 1.10 $ # $Date: 2009/02/17 02:58:47 $ # ----------------------------------------------------------------- # Programmer(s): Radu Serban and Aaron Collier @ LLNL # ----------------------------------------------------------------- # Copyright (c) 2002, The Regents of the University of California. # Produced at the Lawrence Livermore National Laboratory. # All rights reserved. # For details, see the LICENSE file. # ----------------------------------------------------------------- # Makefile for FKINSOL serial examples # # @configure_input@ # ----------------------------------------------------------------- SHELL = @SHELL@ srcdir = @srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ prefix = @prefix@ exec_prefix = @exec_prefix@ includedir = @includedir@ libdir = @libdir@ INSTALL = @INSTALL@ INSTALL_PROG = @INSTALL_PROGRAM@ INSTALL_FILE = @INSTALL_DATA@ LIBTOOL = @LIBTOOL@ LIBTOOL_DEPS = @LIBTOOL_DEPS@ F77 = @F77@ FFLAGS = @FFLAGS@ F77_LNKR = @F77_LNKR@ F77_LDFLAGS = @F77_LDFLAGS@ F77_LIBS = @F77_LIBS@ LAPACK_ENABLED = @LAPACK_ENABLED@ BLAS_LAPACK_LIBS = @BLAS_LAPACK_LIBS@ OBJ_EXT = @OBJEXT@ EXE_EXT = @EXEEXT@ EXS_INSTDIR = @EXS_INSTDIR@ top_srcdir = $(srcdir)/../../.. SUNDIALS_LIBS = $(top_builddir)/src/kinsol/fcmix/libsundials_fkinsol.la \ $(top_builddir)/src/kinsol/libsundials_kinsol.la \ $(top_builddir)/src/nvec_ser/libsundials_fnvecserial.la \ $(top_builddir)/src/nvec_ser/libsundials_nvecserial.la fortran-update = ${SHELL} ${top_builddir}/bin/fortran-update.sh mkinstalldirs = $(SHELL) $(top_srcdir)/config/mkinstalldirs rminstalldirs = $(SHELL) $(top_srcdir)/config/rminstalldirs EXAMPLES = fkinDiagon_kry EXAMPLES_BL = OBJECTS = ${EXAMPLES:=${OBJ_EXT}} OBJECTS_BL = ${EXAMPLES_BL:=${OBJ_EXT}} EXECS = ${EXAMPLES:=${EXE_EXT}} EXECS_BL = ${EXAMPLES_BL:=${EXE_EXT}} # ---------------------------------------------------------------------------------------------------------------------- all: @for i in ${EXAMPLES} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ ${fortran-update} ${srcdir} $${i}.f ; \ ${LIBTOOL} --mode=compile ${F77} ${FFLAGS} -c ${builddir}/$${i}-updated.f ; \ ${LIBTOOL} --mode=link ${F77_LNKR} -o ${builddir}/$${i}${EXE_EXT} ${builddir}/$${i}-updated${OBJ_EXT} ${F77_LDFLAGS} ${SUNDIALS_LIBS} ${F77_LIBS} ${BLAS_LAPACK_LIBS} ; \ done ; \ fi install: $(mkinstalldirs) $(EXS_INSTDIR)/kinsol/fcmix_serial $(INSTALL_FILE) Makefile_ex $(EXS_INSTDIR)/kinsol/fcmix_serial/Makefile $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_serial/README $(EXS_INSTDIR)/kinsol/fcmix_serial/ for i in ${EXAMPLES} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_serial/$${i}.f $(EXS_INSTDIR)/kinsol/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_serial/$${i}.out $(EXS_INSTDIR)/kinsol/fcmix_serial/ ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_serial/$${i}.f $(EXS_INSTDIR)/kinsol/fcmix_serial/ ; \ $(INSTALL_FILE) $(top_srcdir)/examples/kinsol/fcmix_serial/$${i}.out $(EXS_INSTDIR)/kinsol/fcmix_serial/ ; \ done ; \ fi uninstall: rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/Makefile rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/README for i in ${EXAMPLES} ; do \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/$${i}.out ; \ done @if test "X${LAPACK_ENABLED}" = "Xyes"; then \ for i in ${EXAMPLES_BL} ; do \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/$${i}.f ; \ rm -f $(EXS_INSTDIR)/kinsol/fcmix_serial/$${i}.out ; \ done ; \ fi $(rminstalldirs) $(EXS_INSTDIR)/kinsol/fcmix_serial $(rminstalldirs) $(EXS_INSTDIR)/kinsol clean: rm -rf .libs rm -f *.lo *.o rm -f *-updated.f rm -f ${OBJECTS} ${OBJECTS_BL} rm -f $(EXECS) $(EXECS_BL) distclean: clean rm -f Makefile rm -f Makefile_ex # ---------------------------------------------------------------------------------------------------------------------- libtool: $(top_builddir)/$(LIBTOOL_DEPS) @cd ${top_builddir} ; \ ${SHELL} ./config.status --recheck ; \ cd ${abs_builddir} sundials-2.5.0/examples/kinsol/fcmix_serial/fkinDiagon_kry.out0000600000175000017500000000363311741421273025472 0ustar sylvestresylvestreExample program fkinDiagon_kry: This FKINSOL example solves a 128 eqn diagonal algebraic system. Its purpose is to demonstrate the use of the Fortran interface in a serial environment. globalstrategy = KIN_NONE FKINSOL return code is 0 The resultant values of uu are: 1 1.000000 2.000000 3.000000 4.000000 5 5.000000 6.000000 7.000000 8.000000 9 9.000000 10.000000 11.000000 12.000000 13 13.000000 14.000000 15.000000 16.000000 17 17.000000 18.000000 19.000000 20.000000 21 21.000000 22.000000 23.000000 24.000000 25 25.000000 26.000000 27.000000 28.000000 29 29.000000 30.000000 31.000000 32.000000 33 33.000000 34.000000 35.000000 36.000000 37 37.000000 38.000000 39.000000 40.000000 41 41.000000 42.000000 43.000000 44.000000 45 45.000000 46.000000 47.000000 48.000000 49 49.000000 50.000000 51.000000 52.000000 53 53.000000 54.000000 55.000000 56.000000 57 57.000000 58.000000 59.000000 60.000000 61 61.000000 62.000000 63.000000 64.000000 65 65.000000 66.000000 67.000000 68.000000 69 69.000000 70.000000 71.000000 72.000000 73 73.000000 74.000000 75.000000 76.000000 77 77.000000 78.000000 79.000000 80.000000 81 81.000000 82.000000 83.000000 84.000000 85 85.000000 86.000000 87.000000 88.000000 89 89.000000 90.000000 91.000000 92.000000 93 93.000000 94.000000 95.000000 96.000000 97 97.000000 98.000000 99.000000 100.000000 101 101.000000 102.000000 103.000000 104.000000 105 105.000000 106.000000 107.000000 108.000000 109 109.000000 110.000000 111.000000 112.000000 113 113.000000 114.000000 115.000000 116.000000 117 117.000000 118.000000 119.000000 120.000000 121 121.000000 122.000000 123.000000 124.000000 125 125.000000 126.000000 127.000000 128.000000 Final statistics: nni = 7, nli = 21 nfe = 8, npe = 2 nps = 28, ncfl = 0 sundials-2.5.0/examples/kinsol/fcmix_serial/fkinDiagon_kry.f0000600000175000017500000001277611741421273025120 0ustar sylvestresylvestre program fkinDiagon_kry c ---------------------------------------------------------------- c $Revision: 1.2 $ c $Date: 2009/09/30 23:41:32 $ c ---------------------------------------------------------------- c Programmer(s): Allan Taylor, Alan Hindmarsh and c Radu Serban @ LLNL c ---------------------------------------------------------------- c Simple diagonal test with Fortran interface, using user-supplied c preconditioner setup and solve routines (supplied in Fortran). c c This example does a basic test of the solver by solving the c system: c f(u) = 0 for c f(u) = u(i)^2 - i^2 c c No scaling is done. c An approximate diagonal preconditioner is used. c c ---------------------------------------------------------------- c implicit none integer ier, globalstrat, maxl, maxlrst integer*4 PROBSIZE parameter(PROBSIZE=128) integer*4 neq, i, msbpre integer*4 iout(15) double precision pp, fnormtol, scsteptol double precision rout(2), uu(PROBSIZE), scale(PROBSIZE) double precision constr(PROBSIZE) common /pcom/ pp(PROBSIZE) common /psize/ neq neq = PROBSIZE globalstrat = 0 fnormtol = 1.0d-5 scsteptol = 1.0d-4 maxl = 10 maxlrst = 2 msbpre = 5 c * * * * * * * * * * * * * * * * * * * * * * call fnvinits(3, neq, ier) if (ier .ne. 0) then write(6,1220) ier 1220 format('SUNDIALS_ERROR: FNVINITS returned IER = ', i2) stop endif do 20 i = 1, neq uu(i) = 2.0d0 * i scale(i) = 1.0d0 constr(i) = 0.0d0 20 continue call fkinmalloc(iout, rout, ier) if (ier .ne. 0) then write(6,1230) ier 1230 format('SUNDIALS_ERROR: FKINMALLOC returned IER = ', i2) stop endif call fkinsetiin('MAX_SETUPS', msbpre, ier) call fkinsetrin('FNORM_TOL', fnormtol, ier) call fkinsetrin('SSTEP_TOL', scsteptol, ier) call fkinsetvin('CONSTR_VEC', constr, ier) call fkinspgmr(maxl, maxlrst, ier) if (ier .ne. 0) then write(6,1235) ier 1235 format('SUNDIALS_ERROR: FKINSPGMR returned IER = ', i2) call fkinfree stop endif call fkinspilssetprec(1, ier) write(6,1240) 1240 format('Example program fkinDiagon_kry:'//' This FKINSOL example', 1 ' solves a 128 eqn diagonal algebraic system.'/ 2 ' Its purpose is to demonstrate the use of the Fortran', 3 ' interface'/' in a serial environment.'/// 4 ' globalstrategy = KIN_NONE') call fkinsol(uu, globalstrat, scale, scale, ier) if (ier .lt. 0) then write(6,1242) ier, iout(9) 1242 format('SUNDIALS_ERROR: FKINSOL returned IER = ', i2, /, 1 ' Linear Solver returned IER = ', i2) call fkinfree stop endif write(6,1245) ier 1245 format(/' FKINSOL return code is ', i3) write(6,1246) 1246 format(//' The resultant values of uu are:'/) do 30 i = 1, neq, 4 write(6,1256) i, uu(i), uu(i+1), uu(i+2), uu(i+3) 1256 format(i4, 4(1x, f10.6)) 30 continue write(6,1267) iout(3), iout(14), iout(4), iout(12), iout(13), 1 iout(15) 1267 format(//'Final statistics:'// 1 ' nni = ', i3, ', nli = ', i3, /, 2 ' nfe = ', i3, ', npe = ', i3, /, 3 ' nps = ', i3, ', ncfl = ', i3) call fkinfree stop end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The function defining the system f(u) = 0 must be defined by a Fortran c function of the following form. subroutine fkfun(uu, fval, ier) implicit none integer ier integer*4 neq, i double precision fval(*), uu(*) common /psize/ neq do 10 i = 1, neq fval(i) = uu(i) * uu(i) - i * i 10 continue ier = 0 return end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The routine kpreco is the preconditioner setup routine. It must have c that specific name be used in order that the c code can find and link c to it. The argument list must also be as illustrated below: subroutine fkpset(udata, uscale, fdata, fscale, 1 vtemp1, vtemp2, ier) implicit none integer ier integer*4 neq, i double precision pp double precision udata(*), uscale(*), fdata(*), fscale(*) double precision vtemp1(*), vtemp2(*) common /pcom/ pp(128) common /psize/ neq do 10 i = 1, neq pp(i) = 0.5d0 / (udata(i) + 5.0d0) 10 continue ier = 0 return end c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c The routine kpsol is the preconditioner solve routine. It must have c that specific name be used in order that the c code can find and link c to it. The argument list must also be as illustrated below: subroutine fkpsol(udata, uscale, fdata, fscale, 1 vv, ftem, ier) implicit none integer ier integer*4 neq, i double precision pp double precision udata(*), uscale(*), fdata(*), fscale(*) double precision vv(*), ftem(*) common /pcom/ pp(128) common /psize/ neq do 10 i = 1, neq vv(i) = vv(i) * pp(i) 10 continue ier = 0 return end sundials-2.5.0/examples/kinsol/fcmix_serial/README0000600000175000017500000000070111741421273022654 0ustar sylvestresylvestreList of serial KINSOL FCMIX examples fkinDiagon_kry: simple diagonal test with Fortran interface Sample result: SUNDIALS was built with the following options: ./configure CC=gcc F77=gfortran CFLAGS="-g3 -O0" FFLAGS="-g3 -O0" --enable-examples System Architecture: IA-32 Processor Type: Intel Pentium 4 Xeon DP (i686) Operating System: Red Hat Enterprise Linux WS 3 (Taroon Update 7) C/Fortran Compilers: gcc/gfortran v4.1.0 (GCC)