diff --git a/.gitignore b/.gitignore index 6d2a03086..76e13e3f4 100644 --- a/.gitignore +++ b/.gitignore @@ -37,13 +37,15 @@ swiftest-* __pycache__* _cmake* _dependencies +!SHTOOLS +!SHTOOLS/** #Documentation !.readthedocs.yaml !docs/ !docs/**/* -docs/_build/ +!docs/_build/ docs/_build/**/* docs/generated/ docs/generated/**/* @@ -64,14 +66,14 @@ docs/_static/fortran_docs/*/** !environment.yml !.dockerignore +swiftest/_bindings.cpython* bin/ build/* -hdf5-* -netcdf-c-* -netcdf-fortran-* -zlib-* +lib* actions-runner* env/** venv/** + +sandbox/** diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..83fc36326 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "SHTOOLS"] + path = SHTOOLS + url = https://github.com/profminton/SHTOOLS diff --git a/CMakeLists.txt b/CMakeLists.txt index 5b2663034..fad2df6a8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ ################################################## # Define the project and the depencies that it has ################################################## -CMAKE_MINIMUM_REQUIRED(VERSION 3.6.0...3.27.1) +CMAKE_MINIMUM_REQUIRED(VERSION 3.23.1...3.28.3) SET(SKBUILD_PROJECT_NAME "swiftest" CACHE STRING "Name of project set by scikit-build") # Get version stored in text file @@ -28,27 +28,44 @@ ELSE() CMAKE_POLICY(SET CMP0148 OLD) ENDIF () + # The following section is modified from Numpy f2py documentation + IF(PROJECT_SOURCE_DIR STREQUAL PROJECT_BINARY_DIR) + MESSAGE(FATAL_ERROR "In-source builds not allowed. Please make a new directory (called a build directory) and run CMake from there.\n") + ENDIF() + # Set some options the user may choose OPTION(USE_COARRAY "Use Coarray Fortran for parallelization of test particles" OFF) OPTION(USE_OPENMP "Use OpenMP for parallelization" ON) OPTION(USE_SIMD "Use SIMD vectorization" ON) OPTION(BUILD_SHARED_LIBS "Build using shared libraries" ON) + # Define the paths to the source code and python files + SET(SRC "${CMAKE_SOURCE_DIR}/src") + SET(PY "${CMAKE_SOURCE_DIR}/swiftest") + + # Make sure paths are correct for Unix or Windows style + FILE(TO_CMAKE_PATH ${SRC} SRC) + FILE(TO_CMAKE_PATH ${PY} PY) + INCLUDE(GNUInstallDirs) IF (SKBUILD) - SET(INSTALL_BINDIR ${SKBUILD_PLATLIB_DIR}/${SKBUILD_PROJECT_NAME}) - SET(INSTALL_LIBDIR ${SKBUILD_PLATLIB_DIR}/${SKBUILD_PROJECT_NAME}) - SET(INSTALL_INCLUDEDIR ${INSTALL_LIBDIR}) + SET(INSTALL_BINDIR ${SKBUILD_SCRIPTS_DIR}) + SET(INSTALL_LIBDIR ${SKBUILD_DATA_DIR}/lib) + SET(INSTALL_INCLUDEDIR ${SKBUILD_HEADERS_DIR}) + SET(INSTALL_PYPROJ ${SKBUILD_PLATLIB_DIR}/${SKBUILD_PROJECT_NAME}) IF (APPLE) - SET(CMAKE_INSTALL_RPATH "@loader_path") + SET(CMAKE_INSTALL_RPATH "@loader_path;${CMAKE_BINARY_DIR}/bin") ELSEIF (LINUX) - SET(CMAKE_INSTALL_RPATH $ORIGIN) + SET(CMAKE_INSTALL_RPATH "@ORIGIN;${CMAKE_BINARY_DIR}/bin") ENDIF () ELSE () + SET(INSTALL_PYPROJ ${PY}) SET(INSTALL_BINDIR ${CMAKE_INSTALL_BINDIR}) SET(INSTALL_LIBDIR ${CMAKE_INSTALL_LIBDIR}) SET(INSTALL_INCLUDEDIR ${CMAKE_INSTALL_INCLUDEDIR}) ENDIF () + + SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) # Have the .mod files placed in the include folder SET(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) @@ -57,6 +74,7 @@ ELSE() FILE(TO_CMAKE_PATH "${CMAKE_SOURCE_DIR}/cmake/Modules" LOCAL_MODULE_PATH) LIST(APPEND CMAKE_MODULE_PATH ${LOCAL_MODULE_PATH}) + # Add in the external dependency libraries IF (CMAKE_Fortran_COMPILER_ID MATCHES "^Intel") SET(COMPILER_OPTIONS "Intel" CACHE STRING "Compiler identified as Intel") ELSEIF (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") @@ -65,10 +83,22 @@ ELSE() MESSAGE(FATAL_ERROR "Compiler ${CMAKE_Fortran_COMPILER_ID} not recognized!") ENDIF () - # The following section is modified from Numpy f2py documentation - IF(PROJECT_SOURCE_DIR STREQUAL PROJECT_BINARY_DIR) - MESSAGE(FATAL_ERROR "In-source builds not allowed. Please make a new directory (called a build directory) and run CMake from there.\n") + IF (COMPILER_OPTIONS STREQUAL "GNU") + IF (APPLE) + SET(BLA_VENDOR "Apple" CACHE STRING "BLAS vendor") + ELSE () + SET(BLA_VENDOR "OpenBLAS" CACHE STRING "BLAS vendor") + ENDIF () + ELSEIF (COMPILER_OPTIONS STREQUAL "INTEL") + SET(BLA_VENDOR "Intel10_64lp" CACHE STRING "BLAS vendor") ENDIF() + SET(BLA_STATIC ON) + FIND_PACKAGE(BLAS REQUIRED) + FIND_PACKAGE(LAPACK REQUIRED) + FIND_PACKAGE(FFTW3 REQUIRED) + FIND_PACKAGE(SHTOOLS REQUIRED) + + FIND_PACKAGE(NETCDF_Fortran REQUIRED) IF (MSVC) @@ -85,9 +115,6 @@ ELSE() FIND_PACKAGE(Python COMPONENTS Interpreter Development.Module REQUIRED) - SET(SRC "${CMAKE_SOURCE_DIR}/src") - SET(PY "${CMAKE_SOURCE_DIR}/swiftest") - ##################################### # Tell how to install this executable ##################################### @@ -99,11 +126,6 @@ ELSE() SET(CMAKE_INSTALL_PREFIX /usr/local CACHE PATH "Path for install") ENDIF() - - # Make sure paths are correct for Unix or Windows style - FILE(TO_CMAKE_PATH ${SRC} SRC) - FILE(TO_CMAKE_PATH ${PY} PY) - # Set the name of the swiftest library SET(SWIFTEST_LIBRARY ${SKBUILD_PROJECT_NAME}) @@ -113,13 +135,11 @@ ELSE() ENDIF(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) INCLUDE(SetParallelizationLibrary) - IF (COMPILER_OPTIONS STREQUAL "Intel" AND NOT CMAKE_SYSTEM_NAME STREQUAL "Windows") - INCLUDE(SetMKL) - ENDIF () INCLUDE(SetSwiftestFlags) - - + IF (NOT BUILD_SHARED_LIBS) + SET(CMAKE_POSITION_INDEPENDENT_CODE ON) + ENDIF() # The source for the SWIFTEST binary and have it placed in the bin folder ADD_SUBDIRECTORY(${SRC} ${CMAKE_INSTALL_BINDIR}) ADD_SUBDIRECTORY(${PY}) diff --git a/README_tables/add_body_kwargs.md b/README_tables/add_body_kwargs.md index 59f52078f..a172cfc5a 100644 --- a/README_tables/add_body_kwargs.md +++ b/README_tables/add_body_kwargs.md @@ -15,7 +15,7 @@ | ```Gmass``` | Gravitational mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats | ```radius``` | Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats | ```rhill``` | Hill Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats -| ```rot``` | Rotation rate vector(s) of bodies in degrees/sec. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats +| ```rot``` | Rotation rate vector(s) of bodies in degrees/TU. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats | ```Ip``` | Principal axes moments of inertia vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats | ```J2``` | The unitless value of the spherical harmonic term equal to J2*R^2 where R is the radius of the central body. | float or array-like of floats | ```J4``` | The unitless value of the spherical harmonic term equal to J4*R^4 where R is the radius of the central body. | float or array-like of floats diff --git a/SHTOOLS b/SHTOOLS new file mode 160000 index 000000000..8b74bb7a2 --- /dev/null +++ b/SHTOOLS @@ -0,0 +1 @@ +Subproject commit 8b74bb7a27b7dab588893ab368c86ab4d735f333 diff --git a/buildscripts/_build_getopts.sh b/buildscripts/_build_getopts.sh index 113f9e526..b218da594 100755 --- a/buildscripts/_build_getopts.sh +++ b/buildscripts/_build_getopts.sh @@ -14,7 +14,8 @@ SCRIPT_DIR=$(realpath $(dirname $0)) ROOT_DIR=$(realpath ${SCRIPT_DIR}/..) # Get platform and architecture -read -r OS ARCH < <($SCRIPT_DIR/get_platform.sh) +OS=$(uname -s) +ARCH=$(uname -m) # Parse arguments USTMT="Usage: ${0} [-d /path/to/dependency/source] [-p /prefix/path] [-m MACOSX_DEPLOYMENT_TARGET]" @@ -53,8 +54,22 @@ BUILD_DIR=${BUILD_DIR:-"${HOME}/Downloads"} PREFIX=${PREFIX:-"/usr/local"} DEPENDENCY_DIR=${DEPENDENCY_DIR:-${BUILD_DIR}} -mkdir -p ${DEPENDENCY_DIR} -mkdir -p ${PREFIX}/lib -mkdir -p ${PREFIX}/include -mkdir -p ${PREFIX}/share -mkdir -p ${PREFIX}/bin \ No newline at end of file + +case $OS in + Linux*) + . ${SCRIPT_DIR}/set_environment_linux.sh + ;; + MacOSX|Darwin) + . ${SCRIPT_DIR}/set_environment_macos.sh + ;; + + *) + printf "Unknown compiler type: ${OS}\n" + echo "Valid options are Linux, MacOSX, or Darwin" + printf $USTMT + exit 1 + ;; +esac + + +mkdir -p ${DEPENDENCY_DIR} \ No newline at end of file diff --git a/buildscripts/build_dependencies.sh b/buildscripts/build_dependencies.sh index 143b4d233..5f7aa6b58 100755 --- a/buildscripts/build_dependencies.sh +++ b/buildscripts/build_dependencies.sh @@ -50,6 +50,7 @@ ${SCRIPT_DIR}/build_zlib.sh ${ARGS} ${SCRIPT_DIR}/build_hdf5.sh ${ARGS} ${SCRIPT_DIR}/build_netcdf-c.sh ${ARGS} ${SCRIPT_DIR}/build_netcdf-fortran.sh ${ARGS} +${SCRIPT_DIR}/build_shtools.sh ${ARGS} printf "\n" printf "*********************************************************\n" diff --git a/buildscripts/build_hdf5.sh b/buildscripts/build_hdf5.sh index 3f93d036b..234011f69 100755 --- a/buildscripts/build_hdf5.sh +++ b/buildscripts/build_hdf5.sh @@ -11,8 +11,8 @@ # You should have received a copy of the GNU General Public License along with Swiftest. # If not, see: https://www.gnu.org/licenses. -HDF5_VER="1_14_2" -ZLIB_VER="1.3" +HDF5_VER="1_14_3" +ZLIB_VER="1.3.1" SCRIPT_DIR=$(realpath $(dirname $0)) set -a @@ -27,7 +27,7 @@ printf "*********************************************************\n" printf "* STARTING DEPENDENCY BUILD *\n" printf "*********************************************************\n" printf "Using ${OS} compilers:\nFC: ${FC}\nCC: ${CC}\nCXX: ${CXX}\n" -printf "Installing to ${PREFIX}\n" +printf "Installing to ${HDF5_ROOT}\n" printf "\n" printf "*********************************************************\n" @@ -60,13 +60,11 @@ printf "CPPFLAGS: ${CPPFLAGS}\n" printf "CPATH: ${CPATH}\n" printf "LD_LIBRARY_PATH: ${LD_LIBRARY_PATH}\n" printf "LDFLAGS: ${LDFLAGS}\n" +printf "INSTALL_PREFIX: ${HDF5_ROOT}\n" printf "*********************************************************\n" cd ${DEPENDENCY_DIR}/hdfsrc -HDF5_ROOT=${PREFIX} -ZLIB_ROOT=${PREFIX} -SZIP_ROOT=${PREFIX} if [ $OS = "MacOSX" ]; then ZLIB_LIBRARY="${ZLIB_ROOT}/lib/libz.dylib" else @@ -85,6 +83,7 @@ ARGLIST="-DCMAKE_INSTALL_PREFIX:PATH=${HDF5_ROOT} \ -DHDF5_BUILD_FORTRAN:BOOL=OFF \ -DHDF5_BUILD_EXAMPLES:BOOL=ON \ -DBUILD_TESTING:BOOL=ON \ + -DBUILD_STATIC_LIBS:BOOL=OFF \ -DHDF5_BUILD_JAVA:BOOL=OFF" if [ $OS = "MacOSX" ]; then @@ -94,7 +93,7 @@ fi cmake -B build -C ./config/cmake/cacheinit.cmake -G Ninja ${ARGLIST} . cmake --build build -j${NPROC} --config Release -if [ -w ${PREFIX} ]; then +if [ -w ${HDF5_ROOT} ]; then cmake --install build else sudo cmake --install build diff --git a/buildscripts/build_netcdf-c.sh b/buildscripts/build_netcdf-c.sh index ee7415cbf..c9ec290e3 100755 --- a/buildscripts/build_netcdf-c.sh +++ b/buildscripts/build_netcdf-c.sh @@ -22,7 +22,7 @@ printf "*********************************************************\n" printf "* STARTING DEPENDENCY BUILD *\n" printf "*********************************************************\n" printf "Using ${OS} compilers:\nFC: ${FC}\nCC: ${CC}\nCXX: ${CXX}\n" -printf "Installing to ${PREFIX}\n" +printf "Installing to ${NCDIR}\n" printf "\n" NC_VER="4.9.2" @@ -48,16 +48,15 @@ printf "CPATH: ${CPATH}\n" printf "LD_LIBRARY_PATH: ${LD_LIBRARY_PATH}\n" printf "LDFLAGS: ${LDFLAGS}\n" printf "HDF5_ROOT: ${HDF5_ROOT}\n" +printf "INSTALL_PREFIX: ${NCDIR}\n" printf "*********************************************************\n" cd ${DEPENDENCY_DIR}/netcdf-c-* -NCDIR="${PREFIX}" -ZLIB_ROOT=${PREFIX} cmake -B build -S . -G Ninja \ -DCMAKE_BUILD_TYPE:STRING="Release" \ -DHDF5_DIR:PATH=${HDF5_ROOT}/cmake \ -DHDF5_ROOT:PATH=${HDF5_ROOT} \ - -DCMAKE_FIND_ROOT_PATH:PATH="${PREFIX}" \ + -DCMAKE_FIND_ROOT_PATH:PATH="${NCDIR}" \ -DCMAKE_INSTALL_PREFIX:STRING="${NCDIR}" \ -DENABLE_DAP:BOOL=OFF \ -DENABLE_BYTERANGE:BOOL=OFF \ @@ -68,7 +67,7 @@ cmake -B build -S . -G Ninja \ -DENABLE_REMOTE_FORTRAN_BOOTSTRAP:BOOL=ON cmake --build build -j${NPROC} -if [ -w ${PREFIX} ]; then +if [ -w ${NCDIR} ]; then cmake --install build else sudo cmake --install build diff --git a/buildscripts/build_netcdf-fortran.sh b/buildscripts/build_netcdf-fortran.sh index c82f24573..f3021a12a 100755 --- a/buildscripts/build_netcdf-fortran.sh +++ b/buildscripts/build_netcdf-fortran.sh @@ -22,7 +22,7 @@ printf "*********************************************************\n" printf "* STARTING DEPENDENCY BUILD *\n" printf "*********************************************************\n" printf "Using ${OS} compilers:\nFC: ${FC}\nCC: ${CC}\nCXX: ${CXX}\n" -printf "Installing to ${PREFIX}\n" +printf "Installing to ${NFDIR}\n" printf "\n" NF_VER="4.6.1" @@ -49,7 +49,6 @@ printf "LDFLAGS: ${LDFLAGS}\n" printf "*********************************************************\n" cd ${DEPENDENCY_DIR}/netcdf-fortran-* -NFDIR="${PREFIX}" NCLIBDIR=$(${NCDIR}/bin/nc-config --libdir) if [ $OS = "MacOSX" ]; then netCDF_LIBRARIES="${NCLIBDIR}/libnetcdf.dylib" @@ -62,7 +61,7 @@ cmake -B build -S . -G Ninja \ -DCMAKE_INSTALL_PREFIX:PATH=${NFDIR} \ -DCMAKE_INSTALL_LIBDIR="lib" cmake --build build -j${NPROC} -if [ -w ${PREFIX} ]; then +if [ -w ${NFDIR} ]; then cmake --install build else sudo cmake --install build diff --git a/buildscripts/build_shtools.sh b/buildscripts/build_shtools.sh new file mode 100755 index 000000000..a20774253 --- /dev/null +++ b/buildscripts/build_shtools.sh @@ -0,0 +1,67 @@ +#!/bin/bash +# Builds the following from source: SHTOOLS +# +# Copyright 2023 - David Minton +# This file is part of Swiftest. +# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +# Swiftest 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 Swiftest. +# If not, see: https://www.gnu.org/licenses. +SCRIPT_DIR=$(realpath $(dirname $0)) +set -a +ARGS=$@ +. ${SCRIPT_DIR}/_build_getopts.sh ${ARGS} +. ${SCRIPT_DIR}/set_compilers.sh + +SHTOOLS_VER="4.11.10" + +printf "*********************************************************\n" +printf "* FETCHING SHTOOLS SOURCE *\n" +printf "*********************************************************\n" +printf "Copying files to ${DEPENDENCY_DIR}\n" +mkdir -p ${DEPENDENCY_DIR} +if [ ! -d ${DEPENDENCY_DIR}/SHTOOLS-${SHTOOLS_VER} ]; then + [ -d ${DEPENDENCY_DIR}/SHTOOLS-* ] && rm -rf ${DEPENDENCY_DIR}/SHTOOLS-* + curl -L https://github.com/SHTOOLS/SHTOOLS/archive/refs/tags/v${SHTOOLS_VER}.tar.gz | tar xvz -C ${DEPENDENCY_DIR} +fi + +printf "*********************************************************\n" +printf "* BUILDING SHTOOLS LIBRARY *\n" +printf "*********************************************************\n" +printf "LIBS: ${LIBS}\n" +printf "FFLAGS: ${FFLAGS}\n" +printf "CFLAGS: ${CFLAGS}\n" +printf "CPPFLAGS: ${CPPFLAGS}\n" +printf "CPATH: ${CPATH}\n" +printf "LD_LIBRARY_PATH: ${LD_LIBRARY_PATH}\n" +printf "LDFLAGS: ${LDFLAGS}\n" +printf "*********************************************************\n" + +cd ${DEPENDENCY_DIR}/SHTOOLS* + +case $FC in + *"ifort"*|*"ifx"*) + echo "Using Intel Fortran compiler" + make F95="${FC}" CXX="${CXX}" F95FLAGS="-fPIC -m64 -fpp -free -O3 -Tf" fortran + make F95="${FC}" CXX="${CXX}" F95FLAGS="-fPIC -m64 -fpp -free -O3 -Tf" fortran-mp + ;; + *) + echo "Everything else" + make F95="${FC}" CXX="${CXX}" F95FLAGS="-fPIC -O3 -std=gnu -ffast-math" fortran + make F95="${FC}" CXX="${CXX}" F95FLAGS="-fPIC -O3 -std=gnu -ffast-math" fortran-mp + ;; +esac + +if [ -w ${PREFIX} ]; then + make F95="${FC}" PREFIX="${PREFIX}" install +else + sudo make F95="${FC}" PREFIX="${PREFIX}" install +fi +cd .. + +if [ $? -ne 0 ]; then + printf "SHTOOLS could not be compiled.\n" + exit 1 +fi \ No newline at end of file diff --git a/buildscripts/build_zlib.sh b/buildscripts/build_zlib.sh index 337e6a839..358941e09 100755 --- a/buildscripts/build_zlib.sh +++ b/buildscripts/build_zlib.sh @@ -22,10 +22,10 @@ printf "*********************************************************\n" printf "* STARTING DEPENDENCY BUILD *\n" printf "*********************************************************\n" printf "Using ${OS} compilers:\nFC: ${FC}\nCC: ${CC}\nCXX: ${CXX}\n" -printf "Installing to ${PREFIX}\n" +printf "Installing to ${ZLIB_ROOT}\n" printf "\n" -ZLIB_VER="1.3" +ZLIB_VER="1.3.1" printf "*********************************************************\n" printf "* FETCHING ZLIB SOURCE *\n" @@ -46,13 +46,14 @@ printf "CPPFLAGS: ${CPPFLAGS}\n" printf "CPATH: ${CPATH}\n" printf "LD_LIBRARY_PATH: ${LD_LIBRARY_PATH}\n" printf "LDFLAGS: ${LDFLAGS}\n" +printf "INSTALL_PREFIX: ${ZLIB_ROOT}\n" printf "*********************************************************\n" cd ${DEPENDENCY_DIR}/zlib-* -cmake -B build -S . -G Ninja -DCMAKE_INSTALL_PREFIX=${PREFIX} +cmake -B build -S . -G Ninja -DCMAKE_INSTALL_PREFIX=${ZLIB_ROOT} cmake --build build -j${NPROC} -if [ -w ${PREFIX} ]; then +if [ -w ${ZLIB_ROOT} ]; then cmake --install build else sudo cmake --install build diff --git a/buildscripts/get_platform.sh b/buildscripts/get_platform.sh deleted file mode 100755 index 4ad7d8aeb..000000000 --- a/buildscripts/get_platform.sh +++ /dev/null @@ -1,63 +0,0 @@ -#!/bin/bash -# This script will determine the platform (OS and architecture) and format them in a way that other scripts can make use of. -# -# The following combinations are valid: -# Linux x86_64 -# Linux aarch64 -# MacOSX x86_64 -# MacOSX arm64 -# -# Copyright 2023 - David Minton -# This file is part of Swiftest. -# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -# Swiftest 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 Swiftest. -# If not, see: https://www.gnu.org/licenses. - - -# Determine the platform and architecture -OS=$(uname -s) -ARCH=$(uname -m) - - -case $ARCH in - x86_64) - ;; - amd64) - ARCH="x86_64" - ;; - arm64) - if [ "$OS" = "Linux" ]; then - ARCH="aarch64" - fi - ;; - aarch64) - if [ "$OS" = "Darwin" ]; then - ARCH="arm64" - fi - ;; - *) - echo "Swiftest is currently not configured to build for platform ${OS}-${ARCH}" - exit 1 - ;; -esac - - -case $OS in - Linux) - ;; - Darwin) - OS="MacOSX" - ;; - *MSYS*) - OS="Windows" - ;; - *) - echo "Swiftest is currently not configured to build for platform ${OS}-${ARCH}" - exit 1 - ;; -esac - -echo $OS $ARCH diff --git a/buildscripts/install_editable_debug.sh b/buildscripts/install_editable_debug.sh deleted file mode 100755 index cf4b8f774..000000000 --- a/buildscripts/install_editable_debug.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/zsh -# installs an editable (local) package in debug mode -set -a -SCRIPT_DIR=$(realpath $(dirname $0)) -ROOT_DIR=$(realpath ${SCRIPT_DIR}/..) -VENV_DIR=${ROOT_DIR}/venv -cd ${ROOT_DIR} -python3 -m venv ${VENV_DIR} -. ${VENV_DIR}/bin/activate -python3 -m pip install --upgrade pip -pip install scikit-build-core pyproject-metadata pathspec ninja cython -pip install --config-settings=editable.rebuild=true \ - --config-settings=build-dir="build/{wheel_tag}" \ - --config-settings=cmake.build-type="Debug" \ - --config-settings=cmake.args="-DUSE_SIMD=ON" \ - --config-settings=cmake.args="-DUSE_OPENMP=ON" \ - --no-build-isolation \ - -ve . -mkdir -p $HOME/.local/lib -LIBFILE=$(realpath ${ROOT_DIR}/build/*/bin/*swiftest.*) -ln -fs $LIBFILE $HOME/.local/lib diff --git a/buildscripts/set_compilers.sh b/buildscripts/set_compilers.sh index 70dd9f71e..bbe52a2a0 100755 --- a/buildscripts/set_compilers.sh +++ b/buildscripts/set_compilers.sh @@ -15,28 +15,90 @@ # If not, see: https://www.gnu.org/licenses. SCRIPT_DIR=$(realpath $(dirname $0)) ROOT_DIR=$(realpath ${SCRIPT_DIR}/..) -case "$OS" in - Linux|MacOSX|Intel) + +# Get platform and architecture +OS=$(uname -s) +ARCH=$(uname -m) + +case $ARCH in + x86_64) + ;; + amd64) + ARCH="x86_64" + ;; + arm64) + if [ "$OS" = "Linux" ]; then + ARCH="aarch64" + fi + ;; + aarch64) + if [ "$OS" = "Darwin" ]; then + ARCH="arm64" + fi ;; *) - echo "Unknown compiler type: $OS" - echo "Valid options are Intel, Linux, or MacOSX" - echo $USTMT + echo "Swiftest is currently not configured to build for platform ${OS}-${ARCH}" exit 1 ;; esac +case $OS in + Darwin) + OS="MacOSX" + ;; + *MSYS*) + OS="Windows" + ;; +esac + +if [[ $OS == "Linux" ]]; then + # Check if FC is set yet, and if so, use it instead of the default + # Currently ifx support is not great + case $FC in + *ifx) + OS="Linux-ifx" + ;; + *mpiifort) + OS="Linux-mpiifort" + ;; + *ifort) + OS="Linux-ifort" + ;; + *gfortran) + OS="Linux-gnu" + ;; + *) + OS="Linux-gnu" + ;; + esac +fi set -a case $OS in - Linux) - . ${SCRIPT_DIR}/set_environment_linux.sh + Linux-gnu) FC=$(command -v gfortran) CC=$(command -v gcc) CXX=$(command -v g++) CPP=$(command -v cpp) ;; + Linux-ifx) + FC=$(command -v ifx) + CC=$(command -v icx) + CXX=$(command -v icpx) + CPP=$(command -v cpp) + ;; + Linux-ifort) + FC=$(command -v ifort) + CC=$(command -v icc) + CXX=$(command -v icpc) + CPP=$(command -v cpp) + ;; + Linux-mpiifort) + FC=$(command -v mpiifort) + CC=$(command -v mpiicc) + CXX=$(command -v mpiicpc) + CPP=$(command -v cpp) + ;; MacOSX) - . ${SCRIPT_DIR}/set_environment_macos.sh FC=${HOMEBREW_PREFIX}/bin/gfortran-12 CFLAGS="-mmacosx-version-min=${MACOSX_DEPLOYMENT_TARGET} -Wno-deprecated-non-prototype -arch ${ARCH}" FCFLAGS="-mmacosx-version-min=${MACOSX_DEPLOYMENT_TARGET} -arch ${ARCH}" @@ -52,15 +114,10 @@ case $OS in RANLIB=${COMPILER_PREFIX}/bin/ranlib LDFLAGS="-Wl,-no_compact_unwind" ;; - Intel) - FC=$(command -v ifx) - CC=$(command -v icx) - CXX=$(command -v icpx) - CPP=$(command -v cpp) - ;; + *) printf "Unknown compiler type: ${OS}\n" - echo "Valid options are Intel, Linux, or MacOSX" + echo "Valid options are Linux-gnu, Linux-ifort, Linux-ifx, or MacOSX" printf $USTMT exit 1 ;; diff --git a/buildscripts/set_environment_linux.sh b/buildscripts/set_environment_linux.sh index a7c566d59..6a6c055ad 100755 --- a/buildscripts/set_environment_linux.sh +++ b/buildscripts/set_environment_linux.sh @@ -1,17 +1,20 @@ #!/bin/bash # Sets environment flags on Linux set -a -PREFIX="/usr/local" -NCDIR="${PREFIX}" -NFDIR="${PREFIX}" +PREFIX=${PREFIX:-"/usr/local"} +NCDIR=${NETCDF_HOME:-"${PREFIX}"} +NFDIR=${NETCDF_FORTRAN_HOME:-"${PREFIX}"} NETCDF_FORTRAN_HOME="${NFDIR}" NETCDF_FORTRAN_INCLUDE="${NFDIR}/include" -HDF5_ROOT="${PREFIX}" +ZLIB_ROOT=${ZLIB_ROOT:-"${ZLIB_HOME}"} +ZLIB_ROOT=${ZLIB_ROOT:-"${PREFIX}"} +HDF5_ROOT=${HDF5_ROOT:-"${HDF5_HOME}"} +HDF5_ROOT=${HDF5_ROOT:-"${PREFIX}"} HDF5_LIBDIR="${HDF5_ROOT}/lib" HDF5_INCLUDE_DIR="${HDF5_ROOT}/include" HDF5_PLUGIN_PATH="${HDF5_LIBDIR}/plugin" -LD_LIBRARY_PATH="${PREFIX}/lib" -CPATH="${PREFIX}/include:" +LD_LIBRARY_PATH="${PREFIX}/lib:${LD_LIBRARY_PATH}" +CPATH="${PREFIX}/include:${CPATH}" HDF5_DIR="${HDF5_ROOT}/cmake" PATH="${HDF5_ROOT}/bin:${PATH}" CMAKE_INSTALL_LIBDIR="lib" \ No newline at end of file diff --git a/buildscripts/set_environment_macos.sh b/buildscripts/set_environment_macos.sh index cd51f1865..9f985dbdb 100755 --- a/buildscripts/set_environment_macos.sh +++ b/buildscripts/set_environment_macos.sh @@ -7,25 +7,31 @@ MACOSX_DEPLOYMENT_TARGET="$(sw_vers -productVersion)" PREFIX="/usr/local" HOMEBREW_PREFIX="$(brew --prefix)" LD_LIBRARY_PATH="/usr/local/lib:${PREFIX}/lib:${HOMEBREW_PREFIX}/lib" +DYLD_LIBRARY_PATH="${LD_LIBRARY_PATH}" LDFLAGS="-Wl,-rpath,${ROOT_DIR}/lib -Wl,-no_compact_unwind -L${PREFIX}/lib -L${HOMEBREW_PREFIX}/lib" CPATH="/usr/local/include:${PREFIX}/include:${HOMEBREW_PREFIX}/include:${ROOT_DIR}/include" CPPFLAGS="-isystem ${PREFIX}/include -isystem /usr/local/include -Xclang -fopenmp" LIBS="-lomp" CFLAGS="-mmacosx-version-min=${MACOSX_DEPLOYMENT_TARGET} -Wno-deprecated-non-prototype -arch ${ARCH}" FCFLAGS="-mmacosx-version-min=${MACOSX_DEPLOYMENT_TARGET}" -FFFLAGS="${FCFLAGS}" +FFLAGS="${FCFLAGS}" CFLAGS="${FCFLAGS} -Wno-deprecated-non-prototype" CXXFLAGS="${CFLAGS}" -HDF5_ROOT="${PREFIX}" + +NCDIR=${NETCDF_HOME:-"${PREFIX}"} +NFDIR=${NETCDF_FORTRAN_HOME:-"${PREFIX}"} +NETCDF_FORTRAN_HOME="${NFDIR}" +NETCDF_FORTRAN_INCLUDE="${NFDIR}/include" +ZLIB_ROOT=${ZLIB_ROOT:-"${ZLIB_HOME}"} +ZLIB_ROOT=${ZLIB_ROOT:-"${PREFIX}"} +HDF5_ROOT=${HDF5_ROOT:-"${HDF5_HOME}"} +HDF5_ROOT=${HDF5_ROOT:-"${PREFIX}"} HDF5_LIBDIR="${HDF5_ROOT}/lib" HDF5_INCLUDE_DIR="${HDF5_ROOT}/include" HDF5_PLUGIN_PATH="${HDF5_LIBDIR}/plugin" -NCDIR="${PREFIX}" -NFDIR="${PREFIX}" -NETCDF_FORTRAN_HOME="${NFDIR}" -NETCDF_FORTRAN_INCLUDE="${NFDIR}/include" FC="$(command -v gfortran-12)" F77="${FC}" +F95="${FC}" CC="/usr/bin/clang" CXX="/usr/bin/clang++" CPP="/usr/bin/cpp" diff --git a/cmake/Modules/FindFFTW3.cmake b/cmake/Modules/FindFFTW3.cmake new file mode 100644 index 000000000..e41405eab --- /dev/null +++ b/cmake/Modules/FindFFTW3.cmake @@ -0,0 +1,29 @@ +# Copyright 2023 - David Minton +# This file is part of Swiftest. +# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +# Swiftest 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 Swiftest. +# If not, see: https://www.gnu.org/licenses. + +# - Finds the FFTW3 library +MESSAGE(STATUS "Looking for FFTW3") +FIND_PATH(FFTW3_INCLUDE_DIR NAMES fftw3.h HINTS ENV FFTW3_HOME FFTW_HOME PATH_SUFFIXES include) +FIND_LIBRARY(FFTW3_LIBRARY NAMES libfftw3.a HINTS ENV FFTW3_HOME FFTW_HOME PATH_SUFFIXES lib) + +IF(NOT FFTW3_INCLUDE_DIR OR NOT FFTW3_LIBRARY) + MESSAGE(STATUS "FFTW3 not found") + SET(FFTW3_FOUND FALSE) +ELSE () + MESSAGE(STATUS "FFTW3 found") + SET(FFTW3_FOUND TRUE) + MESSAGE(STATUS "Found FFTW3: ${FFTW3_LIBRARY}") + + ADD_LIBRARY(FFTW3::FFTW3 UNKNOWN IMPORTED PUBLIC) + SET_TARGET_PROPERTIES(FFTW3::FFTW3 PROPERTIES + IMPORTED_LOCATION "${FFTW3_LIBRARY}" + INTERFACE_INCLUDE_DIRECTORIES "${FFTW3_INCLUDE_DIR}" + ) +ENDIF() +mark_as_advanced(FFTW3_LIBRARY FFTW3_INCLUDE_DIR) \ No newline at end of file diff --git a/cmake/Modules/FindMKL.cmake b/cmake/Modules/FindMKL.cmake deleted file mode 100644 index 9e48932c3..000000000 --- a/cmake/Modules/FindMKL.cmake +++ /dev/null @@ -1,17 +0,0 @@ -# Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -# This file is part of Swiftest. -# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -# Swiftest 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 Swiftest. -# If not, see: https://www.gnu.org/licenses. - -# - Finds the Intel MKL libraries -find_path(MKL_INCLUDE_DIR NAMES mkl.h HINTS ENV MKLROOT PATH_SUFFIXES include) -find_library(MKL_LIBRARY NAMES libmkl_core.a HINTS ENV MKLROOT PATH_SUFFIXES lib lib/intel64 ) - -set(MKL_FOUND TRUE) -set(MKL_INCLUDE_DIRS ${MKL_INCLUDE_DIR}) -set(MKL_LIBRARIES ${MKL_LIBRARY}) -mark_as_advanced(MKL_LIBRARY MKL_INCLUDE_DIR) \ No newline at end of file diff --git a/cmake/Modules/FindNETCDF_Fortran.cmake b/cmake/Modules/FindNETCDF_Fortran.cmake index ee56789a5..64ed4c923 100644 --- a/cmake/Modules/FindNETCDF_Fortran.cmake +++ b/cmake/Modules/FindNETCDF_Fortran.cmake @@ -11,14 +11,18 @@ # Tries to find the cmake config files first. Otherwise, try to find the libraries and headers by hand IF (NOT netCDF-Fortran_DIR) - IF (CMAKE_SYSTEM_NAME STREQUAL "Windows") - FILE(GLOB LIBDIRS "C:/Program Files*/NC4F") - LIST(SORT LIBDIRS) - LIST(GET LIBDIRS -1 LIBPREFIX) - SET(netCDF-Fortran_DIR "${LIBPREFIX}/lib/cmake/netCDF" CACHE PATH "Location of provided netCDF-FortranConfig.cmake file") - ELSE() - SET(netCDF-Fortran_DIR "/usr/local/lib/cmake/netCDF" CACHE PATH "Location of provided netCDF-FortranConfig.cmake file") - ENDIF () + IF (DEFINED ENV{NETCDF_FORTRAN_DIR}) + SET(netCDF-Fortran_DIR "$ENV{NETCDF_FORTRAN_DIR}" CACHE PATH "Location of provided netCDF-FortranConfig.cmake file") + ELSE() + IF (CMAKE_SYSTEM_NAME STREQUAL "Windows") + FILE(GLOB LIBDIRS "C:/Program Files*/NC4F") + LIST(SORT LIBDIRS) + LIST(GET LIBDIRS -1 LIBPREFIX) + SET(netCDF-Fortran_DIR "${LIBPREFIX}/lib/cmake/netCDF" CACHE PATH "Location of provided netCDF-FortranConfig.cmake file") + ELSE() + SET(netCDF-Fortran_DIR "/usr/local/lib/cmake/netCDF" CACHE PATH "Location of provided netCDF-FortranConfig.cmake file") + ENDIF () + ENDIF() ENDIF() MESSAGE(STATUS "Looking for netCDF-FortranConfig.cmake in ${netCDF-Fortran_DIR}") diff --git a/cmake/Modules/FindSHTOOLS.cmake b/cmake/Modules/FindSHTOOLS.cmake new file mode 100644 index 000000000..70ea0b633 --- /dev/null +++ b/cmake/Modules/FindSHTOOLS.cmake @@ -0,0 +1,33 @@ +# Copyright 2023 - David Minton +# This file is part of Swiftest. +# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +# Swiftest 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 Swiftest. +# If not, see: https://www.gnu.org/licenses. + +# - Finds the SHTOOLS library +FIND_PATH(SHTOOLS_INCLUDE_DIR NAMES shtools.h HINTS ENV SHTOOLS_HOME PATH_SUFFIXES include) +FIND_LIBRARY(SHTOOLS_LIBRARY NAMES libSHTOOLS.a HINTS ENV SHTOOLS_HOME PATH_SUFFIXES lib) +ADD_LIBRARY(SHTOOLS::serial UNKNOWN IMPORTED PUBLIC) +SET_TARGET_PROPERTIES(SHTOOLS::serial PROPERTIES + IMPORTED_LOCATION "${SHTOOLS_LIBRARY}" + INTERFACE_INCLUDE_DIRECTORIES "${SHTOOLS_INCLUDE_DIR}" +) + +FIND_LIBRARY(SHTOOLS_LIBRARY_MP NAMES libSHTOOLS-mp.a HINTS ENV SHTOOLS_HOME PATH_SUFFIXES lib) +ADD_LIBRARY(SHTOOLS::parallel UNKNOWN IMPORTED PUBLIC) +SET_TARGET_PROPERTIES(SHTOOLS::parallel PROPERTIES + IMPORTED_LOCATION "${SHTOOLS_LIBRARY_MP}" + INTERFACE_INCLUDE_DIRECTORIES "${SHTOOLS_INCLUDE_DIR}" +) +SET(SHTOOLS_FOUND TRUE) + +# These libraries are required +# How do I get them to link to the SHTOOLS library? + +MARK_AS_ADVANCED(SHTOOLS_LIBRARY SHTOOLS_LIBRARY_MP SHTOOLS_INCLUDE_DIR) +MESSAGE(STATUS "SHTOOLS library: ${SHTOOLS_LIBRARY}") +MESSAGE(STATUS "SHTOOLS OpenMP library: ${SHTOOLS_LIBRARY_MP}") +MESSAGE(STATUS "SHTOOLS include dir: ${SHTOOLS_INCLUDE_DIR}") diff --git a/cmake/Modules/SetCompileFlag.cmake b/cmake/Modules/SetCompileFlag.cmake index f5644e266..72160fe63 100644 --- a/cmake/Modules/SetCompileFlag.cmake +++ b/cmake/Modules/SetCompileFlag.cmake @@ -40,23 +40,6 @@ INCLUDE(${CMAKE_ROOT}/Modules/CheckFortranCompilerFlag.cmake) FUNCTION(SET_COMPILE_FLAG FLAGVAR FLAGVAL LANG) - # Do some up front setup if Fortran - IF(LANG STREQUAL "Fortran") - # Create a list of error messages from compilers - SET(FAIL_REGEX - "ignoring unknown option" # Intel - "invalid argument" # Intel - "not supported" # Intel ifx - "unrecognized .*option" # GNU - "[Uu]nknown switch" # Portland Group - "ignoring unknown option" # MSVC - "warning D9002" # MSVC, any lang - "[Uu]nknown option" # HP - "[Ww]arning: [Oo]ption" # SunPro - "command option .* is not recognized" # XL - ) - ENDIF(LANG STREQUAL "Fortran") - # Make a variable holding the flags. Filter out REQUIRED if it is there SET(FLAG_REQUIRED FALSE) SET(FLAG_FOUND FALSE) diff --git a/cmake/Modules/SetMKL.cmake b/cmake/Modules/SetMKL.cmake deleted file mode 100644 index e58c9f51a..000000000 --- a/cmake/Modules/SetMKL.cmake +++ /dev/null @@ -1,14 +0,0 @@ -# Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -# This file is part of Swiftest. -# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -# Swiftest 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 Swiftest. -# If not, see: https://www.gnu.org/licenses. - -# Find MKL if not already found -IF(NOT MKL_FOUND) - ENABLE_LANGUAGE(C) # Some libraries need a C compiler to find - FIND_PACKAGE(MKL REQUIRED) -ENDIF(NOT MKL_FOUND) diff --git a/cmake/Modules/SetSwiftestFlags.cmake b/cmake/Modules/SetSwiftestFlags.cmake index cf8b67827..9353f3e26 100644 --- a/cmake/Modules/SetSwiftestFlags.cmake +++ b/cmake/Modules/SetSwiftestFlags.cmake @@ -76,10 +76,6 @@ IF (COMPILER_OPTIONS STREQUAL "GNU") SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" Fortran "-ffree-form" # GNU ) - # Don't add underscores in symbols for C-compatability - SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" - Fortran "-fno-underscoring" # GNU - ) # Compile code assuming that IEEE signaling NaNs may generate user-visible traps during floating-point operations. # Setting this option disables optimizations that may change the number of exceptions visible with signaling NaNs. SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" @@ -93,6 +89,10 @@ IF (COMPILER_OPTIONS STREQUAL "GNU") SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" Fortran "-std=f2018" ) + SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" + Fortran "-fPIC" + ) + ELSEIF (COMPILER_OPTIONS STREQUAL "Intel") # Disables right margin wrapping in list-directed output IF (WINOPT) @@ -101,7 +101,7 @@ ELSEIF (COMPILER_OPTIONS STREQUAL "Intel") ) # Aligns a variable to a specified boundary and offset SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" - Fortran "/align:all /align:array64byte" # Intel + Fortran "/align:all /align:array64byte" # Intel Windows ) # Enables changing the variable and array memory layout SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" @@ -117,15 +117,21 @@ ELSEIF (COMPILER_OPTIONS STREQUAL "Intel") ) # Enables changing the variable and array memory layout SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" - Fortran "-pad" # Intel Windows + Fortran "-pad" # Intel + ) + SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" + Fortran "-mkl" # Intel ) ENDIF () ENDIF () -IF (NOT BUILD_SHARED_LIBS AND NOT WINOPT) +IF (NOT WINOPT) SET_COMPILE_FLAG(CMAKE_FORTRAN_FLAGS "${CMAKE_FORTRAN_FLAGS}" Fortran "-fPIC" ) +ENDIF() + +IF (NOT BUILD_SHARED_LIBS AND NOT WINOPT) IF (COMPILER_OPTIONS STREQUAL "Intel") # Use static Intel libraries SET_COMPILE_FLAG(CMAKE_Fortran_LINK_FLAGS "${CMAKE_Fortran_LINK_FLAGS}" @@ -159,7 +165,10 @@ IF (NOT BUILD_SHARED_LIBS AND NOT WINOPT) IF (USE_OPENMP) SET_COMPILE_FLAG(CMAKE_Fortran_LINK_FLAGS "${CMAKE_Fortran_LINK_FLAGS}" Fortran "-lomp" - "-lgomp" + + ) + SET_COMPILE_FLAG(CMAKE_Fortran_LINK_FLAGS "${CMAKE_Fortran_LINK_FLAGS}" + Fortran "-lgomp" ) ENDIF (USE_OPENMP) ENDIF () @@ -297,6 +306,9 @@ IF (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "TESTING" ) SET_COMPILE_FLAG(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG}" C "/debug:all" # Intel Windows ) + SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" + Fortran "/debug-parameters:all" # Intel Windows + ) # Disables additional interprocedural optimizations for a single file compilation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "/Qip-" # Intel Windows @@ -334,9 +346,6 @@ IF (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "TESTING" ) SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "-check all" # Intel ) - SET_COMPILE_FLAG(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG}" - C "-check=conversions,stack,uninit" # Intel - ) # Initializes matrices/arrays with NaN values SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "-init=snan,arrays" # Intel @@ -374,6 +383,9 @@ IF (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "TESTING" ) SET_COMPILE_FLAG(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG}" C "-debug all" # Intel ) + SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" + Fortran "-debug-parameters all" # Intel + ) # Disables additional interprocedural optimizations for a single file compilation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "-no-ip" # Intel @@ -416,16 +428,7 @@ IF (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "TESTING" ) SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "-fbacktrace" # GNU (gfortran) ) - # Sanitize - IF (NOT APPLE) - SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-fsanitize=address, undefined" # Gnu - ) - SET_COMPILE_FLAG(CMAKE_C_FLAGS_DEBUG "${CMAKE_C_FLAGS_DEBUG}" - C "-fsanitize=address, undefined" # Gnu - ) - ENDIF() - # Check everything + # # Check everything SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" Fortran "-fcheck=all" # GNU ) @@ -524,11 +527,6 @@ IF (CMAKE_BUILD_TYPE STREQUAL "RELEASE" OR CMAKE_BUILD_TYPE STREQUAL "PROFILE") SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "/Qfma" # Intel Windows ) - # Tells the compiler to link to certain libraries in the Intel oneAPI Math Kernel Library (oneMKL). - SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "/Qmkl:cluster" # Intel Windows - "/Qmkl" # Intel Windows - ) # Enables additional interprocedural optimizations for a single file compilation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "/Qip" # Intel Windows @@ -560,13 +558,6 @@ IF (CMAKE_BUILD_TYPE STREQUAL "RELEASE" OR CMAKE_BUILD_TYPE STREQUAL "PROFILE") SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "-fma" # Intel ) - # Tells the compiler to link to certain libraries in the Intel oneAPI Math Kernel Library (oneMKL). - SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-mkl=cluster" - "-mkl" - "-qmkl=cluster" - "-qmkl" - ) # Enables additional interprocedural optimizations for a single file compilation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "-ip" # Intel diff --git a/distclean.cmake b/distclean.cmake index 683a5db35..5df5a151e 100644 --- a/distclean.cmake +++ b/distclean.cmake @@ -47,6 +47,7 @@ FILE(GLOB_RECURSE CMAKEINSTALL "${TOPDIR}/*cmake_install.cmake" "${TOPDIR}/*install_manifest.txt") FILE(GLOB_RECURSE CMAKETESTFILES "${TOPDIR}/*CTestTestfile.cmake") SET(TOPDIRECTORIES "${TOPDIR}/lib" + "${TOPDIR}/lib64" "${TOPDIR}/libexec" "${TOPDIR}/bin" "${TOPDIR}/include" diff --git a/docs/user-guide/basic-simulation/index.rst b/docs/user-guide/basic-simulation/index.rst new file mode 100644 index 000000000..940c62138 --- /dev/null +++ b/docs/user-guide/basic-simulation/index.rst @@ -0,0 +1,55 @@ +################# +Basic Simulation +################# + +Here, we will walk you through the basic features of Swiftest and using them in Python. +This is based on ``/Basic_Simulation`` in ``swiftest/examples``. + +Start with importing Swiftest. :: + + import swiftest + +Initial Simulation Setup +=========================== + +Create a Swiftest Simulation object. +Outputs are stored in the ``/simdata`` directory by default. :: + + sim = swiftest.Simulation() + +Now that we have a simulation object set up (with default parameters), we can add bodies to the simulation. +The biggest body in the simulation is taken as the central body. + +Solar System Bodies +========================= + +We can add solar system bodies to the simulation using the ``add_solar_system_body`` method. +This method uses JPL Horizons to extract the parameters. :: + + # Add the modern planets and the Sun using the JPL Horizons Database. + sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +Add other small bodies too: :: + + # Add in some main belt asteroids + sim.add_solar_system_body(name=["Ceres","Vesta","Pallas","Hygiea"],id_type="smallbody") + + # Add in some big KBOs and Centaurs + sim.add_solar_system_body(name=["Pluto","Eris","Haumea","Quaoar", "Chiron","Chariklo"]) + +Running the Simulation +======================== + +We now set up the simulation parameters. Here we have a simulation starting from `0.0 y` and running for `1 My = 1e6 years` +with time steps of `0.01 years`. :: + + sim.set_parameter(tstart=0.0, tstop=1.0e6, dt=0.01) + +Once everything is set up, we can save the simulation object and then run it: :: + + sim.save() + sim.run() + +.. .. toctree:: +.. :maxdepth: 2 +.. :hidden: diff --git a/docs/user-guide/detailed-simulation-setup/index.rst b/docs/user-guide/detailed-simulation-setup/index.rst new file mode 100644 index 000000000..d5212ffbd --- /dev/null +++ b/docs/user-guide/detailed-simulation-setup/index.rst @@ -0,0 +1,165 @@ +##################### +Detailed Simulation +##################### + +Here, we will walk you through the basic features of Swiftest and using them in Python. +This is based on ``/Basic_Simulation`` in ``swiftest/examples``. + +Start with importing Swiftest and other packages we will use in this tutorial. :: + + import swiftest + import numpy as np + +Initial Simulation Setup +=========================== + +Create a Swiftest Simulation object and clean the simulation directory of any previous Swiftest objects, if any. +Outputs are stored in the ``/simdata`` directory by default. :: + + sim = swiftest.Simulation() + sim.clean() + +An optional argument can be passed to specify the simulation directory :: + + simdir = '/path/to/simdir' + sim = swiftest.Simulation(simdir=simdir) + sim.clean() + +Now that we have a simulation object set up (with default parameters), we can add bodies to the simulation. +The biggest body in the simulation is taken as the central body. + +Solar System Bodies +========================= + +We can add solar system bodies to the simulation using the ``add_solar_system_body`` method. +This method uses JPL Horizons to extract the parameters. :: + + # Add the modern planets and the Sun using the JPL Horizons Database. + sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +We can add other small bodies too. :: + + # Add in some main belt asteroids + sim.add_solar_system_body(name=["Ceres","Vesta","Pallas","Hygiea"],id_type="smallbody") + + # Add in some big KBOs + sim.add_solar_system_body(name=["Pluto","Eris","Haumea","Quaoar"]) + + # Add in some Centaurs + sim.add_solar_system_body(name=["Chiron","Chariklo"]) + +User Defined Bodies +========================= + +For completeness, let's also add some bodies with user defined parameters using ``sim.add_body()``. +We will randomize the initial conditions and therefore import the ``numpy.random`` module.:: + + from numpy.random import default_rng + rng = default_rng(seed=123) + +Starting with **massive bodies:** :: + + npl = 5 # number of massive bodies + density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3) + name_pl = ["SemiBody_01", "SemiBody_02", "SemiBody_03", "SemiBody_04", "SemiBody_05"] + + M_pl = np.array([6e20, 8e20, 1e21, 3e21, 5e21]) * sim.KG2MU # mass in simulation units + R_pl = np.full(npl, (3 * M_pl/ (4 * np.pi * density_pl)) ** (1.0 / 3.0)) # radius + Ip_pl = np.full((npl,3),0.4,) # moment of inertia + rot_pl = np.zeros((npl,3)) # initial rotation vector in degrees/TU + mtiny = 1.1 * np.max(M_pl) # threshold mass for semi-interacting bodies in SyMBA. + +Depending on the simulation parameters, we can add bodies with Orbital Elements or Cartesian Coordinates. + +Orbital Elements +------------------- + +Initialize orbital elements and then add the bodies. :: + + a_pl = rng.uniform(0.3, 1.5, npl) # semi-major axis + e_pl = rng.uniform(0.0, 0.2, npl) # eccentricity + inc_pl = rng.uniform(0.0, 10, npl) # inclination (degrees) + capom_pl = rng.uniform(0.0, 360.0, npl) # longitude of the ascending node + omega_pl = rng.uniform(0.0, 360.0, npl) # argument of periapsis + capm_pl = rng.uniform(0.0, 360.0, npl) # mean anomaly + + sim.add_body(name=name_pl, a=a_pl, e=e_pl, inc=inc_pl, capom=capom_pl, omega=omega_pl, capm=capm_pl, mass=M_pl, radius=R_pl, Ip=Ip_pl, rot=rot_pl) + +Cartesian Coordinates +---------------------- + +The process is similar for adding bodies with Cartesian coordinates. However, the parameter `init_cond_format` must be set to `XV` before adding the bodies. +The process of setting parameters is explained in the next section. +Start by defining the position and velocity vectors. Here we define the orbital velocities and scale them by a random value. :: + + # position vectors + rh_pl = rng.uniform(-5, 5, (npl,3)) + rh_pl_mag = np.linalg.norm(rh_pl, axis=1) # magnitudes of the position vector + + # General velocity vectors + + # define the magnitudes + velocity_scale = rng.uniform(0.5, 1.5, npl) # scale the orbital velocity + vh_pl_mag = velocity_scale * np.sqrt(sim.GU * M_pl / rh_pl_mag) # magnitude of the velocity vector + + # initialize the vectors using the position vectors + vx = rh_pl.T[0] * vh_pl_mag / rh_pl_mag + vy = rh_pl.T[1] * vh_pl_mag / rh_pl_mag + vz = rh_pl.T[2] * vh_pl_mag / rh_pl_mag + + # rotate the velocity vectors to the XY plane for orbital motion + vh_pl = np.array([vx, vy, vz]).T + vh_pl = np.cross(vh_pl, np.array([0,0,1])) # velocity vectors + + sim.add_body(name=name_pl, rh=rh_pl, vh=vh_pl, mass=M_pl, radius=R_pl, Ip=Ip_pl, rot=rot_pl) + +The process is similar for **test particles**. The only difference is to exclude ``mass`` and ``radius``. +Here is an example with orbital elements: :: + + # Add 10 user-defined test particles. + ntp = 10 + + name_tp = ["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"] + a_tp = rng.uniform(0.3, 1.5, ntp) + e_tp = rng.uniform(0.0, 0.2, ntp) + inc_tp = rng.uniform(0.0, 10, ntp) + capom_tp = rng.uniform(0.0, 360.0, ntp) + omega_tp = rng.uniform(0.0, 360.0, ntp) + capm_tp = rng.uniform(0.0, 360.0, ntp) + + sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) + + +Customising Simulation Parameters +================================== + +Now that we have added the bodies, we can set the simulation parameters. ``tstop`` and ``dt`` need to be set before running the simulation. +This can be done in multiple ways: + +- When creating the initial Swiftest simulation object :: + + sim = swiftest.Simulation(simdir = simdir, integrator = 'symba', init_cond_format = 'EL', tstart=0.0, tstop=1.0e6, dt=0.01, + istep_out=100, dump_cadence=0, compute_conservation_values=True, mtiny=mtiny) + +- ``sim.set_parameter()``: Set individual parameters in the simulation. The user can set one or multiple at a time. :: + + sim.set_parameter(tstart=0.0, tstop=1.0e6, dt=0.01, istep_out=100, dump_cadence=0, compute_conservation_values=True, mtiny=mtiny) + sim.set_parameter(rmin = 0.05) + +We now set up the simulation parameters. Here we have a simulation starting from `0.0 y` and running for `1 My = 1e6 years` +with time steps of `0.01 years`. The timestep should be less than or equal to 1/10 of the orbital period of the innermost body. + +The user can then write the parameters to the `param.in` file by using ``sim.write_param()``. +To see the parameters of the simulation, use ``sim.get_parameter()``. + +Running the Simulation +======================== + +Once everything is set up, we can save the simulation object and then run it: :: + + sim.save() + sim.run() + +.. .. toctree:: +.. :maxdepth: 2 +.. :hidden: diff --git a/docs/user-guide/index.rst b/docs/user-guide/index.rst index b63a21e90..f3a941582 100644 --- a/docs/user-guide/index.rst +++ b/docs/user-guide/index.rst @@ -2,9 +2,18 @@ User Guide ########### -TBD +In this user guide, you will find detailed descriptions and examples that describe the many capabilities of Swiftest and how to use them. +- Setting up a :doc:`Basic Simulation ` + +- A more in-depth :doc:`Detailed Simulation Setup ` + +- Understanding the :doc:`Spherical Harmonics capabilities ` .. toctree:: :maxdepth: 2 :hidden: + + Basic Simulation + Detailed Simulation Setup + Spherical Harmonics \ No newline at end of file diff --git a/docs/user-guide/spherical-harmonics/index.rst b/docs/user-guide/spherical-harmonics/index.rst new file mode 100644 index 000000000..06380bd4a --- /dev/null +++ b/docs/user-guide/spherical-harmonics/index.rst @@ -0,0 +1,12 @@ +################### +Spherical Harmonics +################### + +Here, we show how to use Swiftest's Spherical Harmonics capabilities. +This is based on ``/spherical_harmonics_cb`` in ``swiftest/examples``. + + + +.. .. toctree:: +.. :maxdepth: 2 +.. :hidden: \ No newline at end of file diff --git a/environment.yml b/environment.yml index 933cb3fe1..9c6b1d9b8 100644 --- a/environment.yml +++ b/environment.yml @@ -5,7 +5,7 @@ channels: - defaults dependencies: - - python>=3.8 + - python>=3.9 - numpy>=1.24.3 - scipy>=1.10.1 - xarray>=2022.11.0 @@ -21,3 +21,22 @@ dependencies: - x264>=1!157.20191217 - ffmpeg>=4.3.2 - cython>=3.0.0 + - pkg-config + - meson-python>=0.14 + - setuptools_scm>=8 + - fftw>=3.3.8 + - blas-devel>=3.8 + - matplotlib-base>=3.7 + - requests + - pooch>=1.1 + - cartopy>=0.18.0 + - gmt>=6.1.1 + - pygmt>=0.3.0 + - ducc0>=0.15 + - palettable>=3.3 + - jupyter + - pip + - flake8 + - pyshtools + - scikit-build-core + - ipykernel diff --git a/examples/.gitignore b/examples/.gitignore index 829298555..9b6c85b05 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -8,3 +8,4 @@ !helio_gr_test !solar_impact !whm_gr_test +!spherical_harmonics_cb diff --git a/examples/Basic_Simulation/basic_simulation.py b/examples/Basic_Simulation/basic_simulation.py index bee49ac8b..01dcc8b18 100755 --- a/examples/Basic_Simulation/basic_simulation.py +++ b/examples/Basic_Simulation/basic_simulation.py @@ -36,7 +36,6 @@ from numpy.random import default_rng # Initialize the simulation object as a variable. Arguments may be defined here or through the sim.run() method. -#sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) sim = swiftest.Simulation() sim.clean() rng = default_rng(seed=123) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index a46b6cefc..56f19362c 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -25,7 +25,6 @@ """ import swiftest -import xarray as xr import matplotlib.pyplot as plt # Read in the simulation output and store it as an Xarray dataset. diff --git a/examples/Chambers2013/README.txt b/examples/Chambers2013/README.txt index aeb95fc1f..c281be7fc 100644 --- a/examples/Chambers2013/README.txt +++ b/examples/Chambers2013/README.txt @@ -15,9 +15,10 @@ Date : December 6, 2022 Included in the Chambers2013 example directory are the following files: - - README.txt : This file - - init_cond.py : A Python Script that generates a set of initial conditions. - - scattermovie.py : A Python Script that processes data.nc and generates Chambers2013-aescatter.mp4 or Chambers2013-aiscatter.mp4 + - README.txt : This file + - init_cond.py : A Python script that generates a set of initial conditions. + - run_simulation.py : A Python script that will run the simulation. + - scattermovie.py : A Python script that processes data.nc and generates Chambers2013-aescatter.mp4 or Chambers2013-aiscatter.mp4 This example is intended to be run with Swiftest SyMBA. For details on how to generate, run, and analyze this example, see the Swiftest User Manual. \ No newline at end of file diff --git a/examples/spherical_harmonics_cb/.gitignore b/examples/spherical_harmonics_cb/.gitignore new file mode 100644 index 000000000..94eee0157 --- /dev/null +++ b/examples/spherical_harmonics_cb/.gitignore @@ -0,0 +1,3 @@ +!spherical_harmonics_cb.py +!J2_test_tp.py +!J2_test_pl_and_tp.py \ No newline at end of file diff --git a/examples/spherical_harmonics_cb/J2_test_pl_and_tp.py b/examples/spherical_harmonics_cb/J2_test_pl_and_tp.py new file mode 100644 index 000000000..62bd7228a --- /dev/null +++ b/examples/spherical_harmonics_cb/J2_test_pl_and_tp.py @@ -0,0 +1,105 @@ +#!/usr/bin/env python3 + +""" + Copyright 2024 - The Minton Group at Purdue University + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest 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 Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +""" +Generates and runs a set of Swiftest input files from initial conditions for the Spherical Harmonics features with the WHM integrator. +""" + +import swiftest +import numpy as np + +seed = 123 +rng = np.random.default_rng(seed=seed) + + +# Central Body Parameters (just an oblate sphere to test) +cb_mass = 6.1e18 # kg +cb_a = 160 # km +cb_b = 160 # km +cb_c = 90 # km +cb_volume = 4.0 / 3 * np.pi * cb_a*cb_b*cb_c**3 # km^3 +cb_density = cb_mass / cb_volume +cb_T_rotation = 7.004 / 24.0 # converting from hours to julian days (TU) +cb_rot = [[0, 0, 360.0 / cb_T_rotation]] # degrees/d + +# Add 1 user-defined test particle. +ntp = 1 + +name_tp = ["TestParticle_01"] +a_tp = 400 +e_tp = 0.05 +inc_tp = 10 +capom_tp = 0.0 +omega_tp = 0.0 +capm_tp = 0.0 + + +# Add 1 user-defined massive particle +npl = 1 +density_pl = cb_density + +name_pl = ["MassiveBody_01"] +a_pl = 300.0 +e_pl = 0.03 +inc_pl = 0.001 +capom_pl = 90.0 +omega_pl = 90.0 +capm_pl = 90.0 +R_pl = 1.0 +M_pl = 4.0 / 3 * np.pi * R_pl**3 * density_pl +Ip_pl = np.full((npl,3),0.4,) +rot_pl = np.zeros((npl,3)) +mtiny = 0.1 * np.max(M_pl) + + +# Extract the spherical harmonics coefficients (c_lm) from axes measurements +# +# The user can pass an optional reference radius at which the coefficients are calculated. If not provided, SHTOOLS +# calculates the reference radius. If lref_radius = True, the function returns the reference radius used. +# We recommend setting passing and setting a reference radius. Coefficients are geodesy (4-pi) normalised. + +c_lm, cb_radius = swiftest.clm_from_ellipsoid(mass = cb_mass, density = cb_density, a = cb_a, b = cb_b, c = cb_c, lmax = 6, lref_radius = True) + +# extracting only the J2 terms +tmp20 = c_lm[0, 2, 0] # c_20 = -J2 +c_lm = np.zeros(np.shape(c_lm)) +c_lm[0, 2, 0] = tmp20 + +J2 = -tmp20 * np.sqrt(5) # unnormalised J2 term +j2rp2 = J2 * cb_radius**2 + +# set up swiftest simulation with relevant units (here they are km, days, and kg) +sim_shgrav = swiftest.Simulation(simdir="shgrav",DU2M = 1e3, TU = 'd', MU = 'kg') + +sim_shgrav.clean() +# Use the shgrav version where you input a set of spherical harmonics coefficients +sim_shgrav.add_body(name = 'OblateBody', mass = cb_mass, rot = cb_rot, radius = cb_radius, c_lm = c_lm) +sim_shgrav.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +sim_shgrav.add_body(name=name_pl, a=a_pl, e=e_pl, inc=inc_pl, capom=capom_pl, omega=omega_pl, capm=capm_pl, mass=M_pl, radius=R_pl, Ip=Ip_pl, rot=rot_pl) +sim_shgrav.run(tstart=0.0, tstop=10.0, dt=0.01, tstep_out=10.0, dump_cadence=0, mtiny=mtiny, integrator='symba') + +# Use the original "oblate" version where you pass J2 (and/or J4) +sim_obl = swiftest.Simulation(simdir="obl", DU2M = 1e3, TU='d', MU='kg') +sim_obl.clean() +sim_obl.add_body(name = 'OblateBody', mass = cb_mass, rot = cb_rot, radius = cb_radius, J2 = j2rp2) +sim_obl.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +sim_obl.add_body(name=name_pl, a=a_pl, e=e_pl, inc=inc_pl, capom=capom_pl, omega=omega_pl, capm=capm_pl, mass=M_pl, radius=R_pl, Ip=Ip_pl, rot=rot_pl) +sim_obl.run(tstart=0.0, tstop=10.0, dt=0.01, tstep_out=10.0, dump_cadence=0, mtiny=mtiny, integrator='symba') + +diff_vars = ['a','e','inc','capom','omega','capm','rh','vh'] +ds_diff = sim_shgrav.data[diff_vars] - sim_obl.data[diff_vars] +ds_diff /= sim_obl.data[diff_vars] + +print(ds_diff.isel(time=-1,name=-2)) +print(ds_diff.isel(time=-1,name=-1)) + diff --git a/examples/spherical_harmonics_cb/J2_test_tp.py b/examples/spherical_harmonics_cb/J2_test_tp.py new file mode 100644 index 000000000..1c433f0d3 --- /dev/null +++ b/examples/spherical_harmonics_cb/J2_test_tp.py @@ -0,0 +1,83 @@ +#!/usr/bin/env python3 + +""" + Copyright 2024 - The Minton Group at Purdue University + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest 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 Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +""" +Generates and runs a set of Swiftest input files from initial conditions for the Spherical Harmonics features with the WHM integrator. +""" + +import swiftest +import numpy as np + +seed = 123 +rng = np.random.default_rng(seed=seed) + + +# Central Body Parameters (just an oblate sphere to test) +cb_mass = 6.1e18 # kg +cb_a = 160 # km +cb_b = 160 # km +cb_c = 90 # km +cb_volume = 4.0 / 3 * np.pi * cb_a*cb_b*cb_c**3 # km^3 +cb_density = cb_mass / cb_volume +cb_T_rotation = 7.004 / 24.0 # converting from hours to julian days (TU) +cb_rot = [[0, 0, 360.0 / cb_T_rotation]] # degrees/d + +# Add 1 user-defined test particle. +ntp = 1 + +name_tp = ["TestParticle_01"] +a_tp = 300 +e_tp = 0.05 +inc_tp = 10 +capom_tp = 0.0 +omega_tp = 0.0 +capm_tp = 0.0 + +# Extract the spherical harmonics coefficients (c_lm) from axes measurements +# +# The user can pass an optional reference radius at which the coefficients are calculated. If not provided, SHTOOLS +# calculates the reference radius. If lref_radius = True, the function returns the reference radius used. +# We recommend setting passing and setting a reference radius. Coefficients are geodesy (4-pi) normalised. + +c_lm, cb_radius = swiftest.clm_from_ellipsoid(mass = cb_mass, density = cb_density, a = cb_a, b = cb_b, c = cb_c, lmax = 6, lref_radius = True) + +# extracting only the J2 terms +tmp20 = c_lm[0, 2, 0] # c_20 = -J2 +c_lm = np.zeros(np.shape(c_lm)) +c_lm[0, 2, 0] = tmp20 + +J2 = -tmp20 * np.sqrt(5) # unnormalised J2 term +j2rp2 = J2 * cb_radius**2 + +# set up swiftest simulation with relevant units (here they are km, days, and kg) +sim_shgrav = swiftest.Simulation(simdir="shgrav",DU2M = 1e3, TU = 'd', MU = 'kg') + +sim_shgrav.clean() +# Use the shgrav version where you input a set of spherical harmonics coefficients +sim_shgrav.add_body(name = 'OblateBody', mass = cb_mass, rot = cb_rot, radius = cb_radius, c_lm = c_lm) +sim_shgrav.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +sim_shgrav.run(tstart=0.0, tstop=10.0, dt=0.01, tstep_out=10.0, dump_cadence=0, integrator='whm') + +# Use the original "oblate" version where you pass J2 (and/or J4) +sim_obl = swiftest.Simulation(simdir="obl", DU2M = 1e3, TU='d', MU='kg') +sim_obl.clean() +sim_obl.add_body(name = 'OblateBody', mass = cb_mass, rot = cb_rot, radius = cb_radius, J2 = j2rp2) +sim_obl.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +sim_obl.run(tstart=0.0, tstop=10.0, dt=0.01, tstep_out=10.0, dump_cadence=0, integrator='whm') + +diff_vars = ['a','e','inc','capom','omega','capm','rh','vh'] +ds_diff = sim_shgrav.data[diff_vars] - sim_obl.data[diff_vars] +ds_diff /= sim_obl.data[diff_vars] + +print(ds_diff.isel(time=-1,name=-1)) + diff --git a/examples/spherical_harmonics_cb/spherical_harmonics_cb.py b/examples/spherical_harmonics_cb/spherical_harmonics_cb.py new file mode 100644 index 000000000..83df9042a --- /dev/null +++ b/examples/spherical_harmonics_cb/spherical_harmonics_cb.py @@ -0,0 +1,91 @@ +#!/usr/bin/env python3 + +""" + Copyright 2024 - The Minton Group at Purdue University + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest 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 Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +""" +Generates and runs a set of Swiftest input files from initial conditions for the Spherical Harmonics features with the +SyMBA integrator. Using Chariklo as the example body with axes measurements taken from Leiva, et al (2017) (Jacobi +Ellipsoid model). All simulation outputs are stored in the /simdata subdirectory. + +""" + +import swiftest +import numpy as np + +seed = 123 +rng = np.random.default_rng(seed=seed) + +# set up swiftest simulation with relevant units (here they are km, days, and kg) +sim = swiftest.Simulation(DU2M = 1e3, TU = 'd', MU = 'kg') +sim.clean() + +# Central Body Parameters (Chariklo parameters from Leiva, et al (2017) (Jacobi Ellipsoid model)) +cb_mass = 6.1e18 # kg +cb_radius = 123 # km +cb_a = 157 # km +cb_b = 139 # km +cb_c = 86 # km +cb_volume = 4.0 / 3 * np.pi * cb_radius**3 # km^3 +cb_density = cb_mass / cb_volume +cb_T_rotation = 7.004 / 24.0 # converting from hours to julian days (TU) +cb_rot = [[0, 0, 360.0 / cb_T_rotation]] # degrees/d + +# Extract the spherical harmonics coefficients (c_lm) from axes measurements +# +# The user can pass an optional reference radius at which the coefficients are calculated. If not provided, SHTOOLS +# calculates the reference radius. If lref_radius = True, the function returns the reference radius used. +# We recommend setting passing and setting a reference radius. Coefficients are geodesy (4-pi) normalised. + +c_lm, cb_radius = swiftest.clm_from_ellipsoid(mass = cb_mass, density = cb_density, a = cb_a, b = cb_b, c = cb_c, lmax = 6, lref_radius = True, ref_radius = cb_radius) + +# Add the central body +# The user can pass the c_lm coefficients directly to the add_body method if they do not wish to use the clm_from_ellipsoid method. +sim.add_body(name = 'Chariklo', mass = cb_mass, rot = cb_rot, radius = cb_radius, c_lm = c_lm) + +# Add user-defined massive bodies +npl = 5 +density_pl = cb_density + +name_pl = ["SemiBody_01", "SemiBody_02", "SemiBody_03", "SemiBody_04", "SemiBody_05"] +a_pl = rng.uniform(250, 400, npl) +e_pl = rng.uniform(0.0, 0.05, npl) +inc_pl = rng.uniform(0.0, 10, npl) +capom_pl = rng.uniform(0.0, 360.0, npl) +omega_pl = rng.uniform(0.0, 360.0, npl) +capm_pl = rng.uniform(0.0, 360.0, npl) +R_pl = np.array([0.5, 1.0, 1.2, 0.75, 0.8]) +M_pl = 4.0 / 3 * np.pi * R_pl**3 * density_pl +Ip_pl = np.full((npl,3),0.4,) +rot_pl = np.zeros((npl,3)) +mtiny = 1.1 * np.max(M_pl) + +sim.add_body(name=name_pl, a=a_pl, e=e_pl, inc=inc_pl, capom=capom_pl, omega=omega_pl, capm=capm_pl, mass=M_pl, radius=R_pl, Ip=Ip_pl, rot=rot_pl) + +# Add 10 user-defined test particles. +ntp = 10 + +name_tp = ["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"] +a_tp = rng.uniform(250, 400, ntp) +e_tp = rng.uniform(0.0, 0.05, ntp) +inc_tp = rng.uniform(0.0, 10, ntp) +capom_tp = rng.uniform(0.0, 360.0, ntp) +omega_tp = rng.uniform(0.0, 360.0, ntp) +capm_tp = rng.uniform(0.0, 360.0, ntp) + +sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) +sim.set_parameter(tstart=0.0, tstop=10.0, dt=0.01, istep_out=10, dump_cadence=0, compute_conservation_values=True, mtiny=mtiny) + +# Display the run configuration parameters. +sim.get_parameter() + +# Run the simulation. Arguments may be defined here or thorugh the swiftest.Simulation() method. +sim.run() diff --git a/pyproject.toml b/pyproject.toml index 417acd3cc..0e754dc6b 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -1,6 +1,6 @@ [project] name = "swiftest" -version = "2023.12.2" +version = "2024.2.0" authors=[ {name = 'David A. Minton', email='daminton@purdue.edu'}, {name = 'Carlisle Wishard'}, @@ -29,42 +29,33 @@ dependencies = [ 'xarray>=2023.1', 'dask>=2023.5', 'distributed>=2023.5', - 'bottleneck>=1.3', + 'bottleneck>=1.3.5', 'h5netcdf>=1.1', 'h5py>=3.9', - 'netcdf4>=1.6', - 'matplotlib>=3.7', + 'netcdf4>=1.6.2', + 'matplotlib>=3.7.1', 'astropy>=5.2', 'astroquery>=0.4.6', - 'tqdm>=4.64.1', - 'cython>=3.0.0' + 'tqdm>=4.65', + 'cython>=3.0.0', ] +[project.optional-dependencies] +pyshtools = ["pyshtools"] + [project.urls] Repository = 'https://github.itap.purdue.edu/MintonGroup/swiftest' [build-system] requires = [ - "scikit-build-core", - "cython>=3.0.0", - "cmake", - "pyproject_metadata", - "pytest", - "pathspec", - "sphinx", - "sphinx-autosummary-accessors", - "sphinx-book-theme >= 0.3.0", - "sphinx-copybutton", - "sphinx-design", - "sphinx-inline-tabs", - "sphinxext-rediraffe", - "sphinxext-opengraph", - "nbsphinx", - "ford" + "scikit-build-core>=0.8", + "cython>=3.0", ] build-backend = "scikit_build_core.build" [tool.scikit-build] +cmake.version = ">=3.23.1" +ninja.version = ">=1.11.1" cmake.args = ["-DUSE_SIMD=OFF"] sdist.include = ["src/globals/globals_module.f90.in","swiftest/*.py","swiftest/*.pyx","swiftest/*.h"] build-dir = "build/{wheel_tag}" @@ -83,12 +74,14 @@ PREFIX="/usr/local" HOMEBREW_PREFIX="$(brew --prefix)" ARCH="$(uname -m)" LD_LIBRARY_PATH="/usr/local/lib:${PREFIX}/lib:${HOMEBREW_PREFIX}/lib" +DYLD_LIBRARY_PATH="${LD_LIBRARY_PATH}" +REPAIR_LIBRARY_PATH="${LD_LIBRARY_PATH}" LDFLAGS="-Wl,-rpath,${ROOT_DIR}/lib -Wl,-no_compact_unwind -L${PREFIX}/lib -L${HOMEBREW_PREFIX}/lib" CPATH="/usr/local/include:${PREFIX}/include:${HOMEBREW_PREFIX}/include:${ROOT_DIR}/include" CPPFLAGS="-isystem ${PREFIX}/include -isystem /usr/local/include" LIBS="-lomp" -FCFLAGS="-mmacos-version-min=${MACOSX_DEPLOYMENT_TARGET} -arch ${ARCH}" -FFFLAGS="${FCFLAGS}" +FCFLAGS="-mmacosx-version-min=${MACOSX_DEPLOYMENT_TARGET} -arch ${ARCH}" +FFLAGS="${FCFLAGS}" CFLAGS="${FCFLAGS} -Wno-deprecated-non-prototype -arch ${ARCH}" CXXFLAGS="${CFLAGS}" HDF5_ROOT="${PREFIX}" @@ -99,22 +92,27 @@ NCDIR="${PREFIX}" NFDIR="${PREFIX}" NETCDF_FORTRAN_HOME="${NFDIR}" NETCDF_FORTRAN_INCLUDE="${NFDIR}/include" +SHTOOLS_HOME="${PREFIX}" FC="$(command -v gfortran-12)" F77="${FC}" +F95="${FC}" CC="/usr/bin/clang" CXX="/usr/bin/clang++" CPP="/usr/bin/cpp" AR="/usr/bin/ar" NM="/usr/bin/nm" RANLIB="/usr/bin/ranlib" -netCDF-Fortran_DIR="${PREFIX}/lib/cmake/netCDF" +NETCDF_FORTRAN_DIR="${PREFIX}/lib/cmake/netCDF" [tool.cibuildwheel.macos] before-all = [ - "brew install coreutils", + "brew install coreutils pkg-config fftw vecLibFort", "LIBS=\"\" buildscripts/build_dependencies.sh -p ${PREFIX} -d ${HOME}/Downloads -m ${MACOSX_DEPLOYMENT_TARGET}" ] - +repair-wheel-command = """\ +DYLD_LIBRARY_PATH=$REPAIR_LIBRARY_PATH delocate-wheel \ +--require-archs {delocate_archs} -w {dest_dir} -v {wheel} +""" [tool.cibuildwheel.linux.environment] PREFIX="/usr/local" @@ -128,15 +126,17 @@ HDF5_INCLUDE_DIR="${HDF5_ROOT}/include" HDF5_PLUGIN_PATH="${HDF5_LIBDIR}/plugin" LD_LIBRARY_PATH="${PREFIX}/lib:/project/lib:${HDF5_LIBDIR}" CPATH="${PREFIX}/include:/project/include:${HDF5_INCLUDE_DIR}" -netCDF-Fortran_DIR="${PREFIX}/lib/cmake/netCDF" +NETCDF_FORTRAN_DIR="${PREFIX}/lib/cmake/netCDF" HDF5_DIR="${HDF5_ROOT}/cmake" +SHTOOLS_HOME="${PREFIX}" PATH="${HDF5_ROOT}/bin:${PATH}" CMAKE_INSTALL_LIBDIR="lib" [tool.cibuildwheel.linux] skip = "cp312-* pp* -manylinux_i686* *-musllinux*" before-all = [ - "yum install libxml2-devel libcurl-devel -y", + "yum install epel-release -y", + "yum install doxygen libxml2-devel libcurl-devel fftw-static openblas-devel lapack-devel -y", "buildscripts/build_dependencies.sh -p /usr/local" ] @@ -144,3 +144,5 @@ before-all = [ path = "version.txt" location = "source" template = '''${version}''' + + diff --git a/requirements.txt b/requirements.txt new file mode 100644 index 000000000..d41a21895 --- /dev/null +++ b/requirements.txt @@ -0,0 +1,15 @@ +python>=3.8 +numpy>=1.24.3 +scipy>=1.10.1 +xarray>=2023.1 +dask>=2023.5 +distributed>=2023.5 +bottleneck>=1.3.5 +h5netcdf>=1.1 +h5py>=3.9 +netcdf4>=1.6.2 +matplotlib>=3.7.1 +astropy>=5.1 +astroquery>=0.4.6 +tqdm>=4.65.0 +cython>=3.0.0 \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 925d70005..89eaadeee 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -33,6 +33,7 @@ SET(STRICT_MATH_FILES ${SRC}/operator/operator_unit.f90 ${SRC}/rmvs/rmvs_kick.f90 ${SRC}/rmvs/rmvs_step.f90 + ${SRC}/shgrav/shgrav_accel.f90 ${SRC}/swiftest/swiftest_drift.f90 ${SRC}/swiftest/swiftest_gr.f90 ${SRC}/swiftest/swiftest_io.f90 @@ -65,6 +66,7 @@ SET(FAST_MATH_FILES ${SRC}/rmvs/rmvs_module.f90 ${SRC}/helio/helio_module.f90 ${SRC}/symba/symba_module.f90 + ${SRC}/shgrav/shgrav_module.f90 ${SRC}/collision/collision_check.f90 ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_resolve.f90 @@ -102,11 +104,12 @@ IF(USE_COARRAY) set(SWIFTEST_src ${SWIFTEST_src} ${COARRAY_FILES} ) ENDIF () +STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) + # Turn preprocessor on for all files SET_SOURCE_FILES_PROPERTIES(${SWIFTEST_src} ${DRIVER_src} PROPERTIES Fortran_PREPROCESS ON) #Set strict vs fast math flags -STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) IF(BT STREQUAL "RELEASE" OR BT STREQUAL "PROFILE") SET_PROPERTY(SOURCE ${STRICT_MATH_FILES} APPEND_STRING PROPERTY COMPILE_FLAGS "${STRICTMATH_FLAGS}") SET_PROPERTY(SOURCE ${FAST_MATH_FILES} APPEND_STRING PROPERTY COMPILE_FLAGS "${FASTMATH_FLAGS}") @@ -126,20 +129,26 @@ ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${DRIVER_src}) # Add the needed libraries ##################################################### # Create a library from the source files, except the driver - ADD_LIBRARY(${SWIFTEST_LIBRARY} ${SWIFTEST_src}) -IF (NOT BUILD_SHARED_LIBS) - SET_PROPERTY(TARGET ${SWIFTEST_LIBRARY} PROPERTY POSITION_INDEPENDENT_CODE) -ENDIF () TARGET_LINK_LIBRARIES(${SWIFTEST_LIBRARY} PUBLIC netCDF::netcdff HDF5::HDF5) -TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} PUBLIC ${SWIFTEST_LIBRARY} netCDF::netcdff HDF5::HDF5) +TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} PUBLIC netCDF::netcdff HDF5::HDF5) IF(USE_OPENMP OR USE_SIMD) + TARGET_LINK_LIBRARIES(${SWIFTEST_LIBRARY} PUBLIC SHTOOLS::parallel) + TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} PUBLIC SHTOOLS::parallel) + SET_PROPERTY(TARGET ${SWIFTEST_LIBRARY} ${SWIFTEST_DRIVER} APPEND_STRING PROPERTY COMPILE_FLAGS "${OpenMP_Fortran_FLAGS} ") SET_PROPERTY(TARGET ${SWIFTEST_LIBRARY} ${SWIFTEST_DRIVER} APPEND_STRING PROPERTY LINK_FLAGS "${OpenMP_Fortran_FLAGS} ") +ELSE () + TARGET_LINK_LIBRARIES(${SWIFTEST_LIBRARY} PUBLIC SHTOOLS::serial) + TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} PUBLIC SHTOOLS::serial) ENDIF() +TARGET_LINK_LIBRARIES(${SWIFTEST_LIBRARY} PUBLIC BLAS::BLAS LAPACK::LAPACK FFTW3::FFTW3) + +TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} PUBLIC ${SWIFTEST_LIBRARY}) + IF (CMAKE_SYSTEM_NAME STREQUAL "Windows") SET_PROPERTY(TARGET ${SWIFTEST_LIBRARY} ${SWIFTEST_DRIVER} APPEND_STRING PROPERTY LINK_FLAGS "/NODEFAULTLIB") ENDIF() @@ -167,6 +176,7 @@ end program TestDoConcurrentLoc TRY_COMPILE(DOCONLOC_WORKS ${CMAKE_BINARY_DIR} ${TESTFILE} COMPILE_DEFINITIONS "${CMAKE_Fortran_FLAGS}" OUTPUT_VARIABLE OUTPUT) IF (DOCONLOC_WORKS) MESSAGE(STATUS "DO CONCURRENT supports locality-spec") + TARGET_COMPILE_DEFINITIONS(${SWIFTEST_LIBRARY} PRIVATE -DDOCONLOC) TARGET_COMPILE_DEFINITIONS(${SWIFTEST_DRIVER} PRIVATE -DDOCONLOC) ELSE () MESSAGE(STATUS "DO CONCURRENT does not support locality-spec") @@ -185,6 +195,7 @@ end program TestQuadPrecisionReal TRY_COMPILE(QUADPREC ${CMAKE_BINARY_DIR} ${TESTFILE} COMPILE_DEFINITIONS "${CMAKE_Fortran_FLAGS}" OUTPUT_VARIABLE OUTPUT) IF (QUADPREC) MESSAGE(STATUS "Quad precision real is supported") + TARGET_COMPILE_DEFINITIONS(${SWIFTEST_LIBRARY} PRIVATE -DQUADPREC) TARGET_COMPILE_DEFINITIONS(${SWIFTEST_DRIVER} PRIVATE -DQUADPREC) ELSE () MESSAGE(STATUS "Quad precision real is not supported") diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index f0b2c9839..705e90c5f 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -8,10 +8,10 @@ ! If not, see: https://www.gnu.org/licenses. module base - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. - !! + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. + !! use globals #ifdef COARRAY use coarray @@ -22,107 +22,184 @@ module base !> User defined parameters that are read in from the parameters input file. !> Each paramter is initialized to a default values. type, abstract :: base_parameters - character(STRMAX) :: integrator !! Name of the nbody integrator used - character(STRMAX) :: param_file_name !! The name of the parameter file - real(DP) :: t0 = 0.0_DP !! Integration reference time - real(DP) :: tstart = -1.0_DP !! Integration start time - real(DP) :: tstop = -1.0_DP !! Integration stop time - real(DP) :: dt = -1.0_DP !! Time step - integer(I8B) :: iloop = 0_I8B !! Main loop counter - integer(I8B) :: nloops = 0_I8B !! Total number of loops to execute - integer(I8B) :: istart = 0_I8B !! Starting index for loop counter - integer(I4B) :: iout = 0 !! Output cadence counter - integer(I4B) :: idump = 0 !! Dump cadence counter - integer(I4B) :: nout = 0 !! Current output step - integer(I4B) :: istep = 0 !! Current value of istep (used for time stretching) - character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body - character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies - character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles - character(STRMAX) :: nc_in = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = "NETCDF_DOUBLE" !! Data representation type of input data files - character(STRMAX) :: in_form = "XV" !! Format of input data files ("EL" or ["XV"]) - integer(I4B) :: istep_out = -1 !! Number of time steps between saved outputs - integer(I4B) :: nstep_out = -1 !! Total number of saved outputs - real(DP) :: fstep_out = 1.0_DP !! The output step time stretching factor - logical :: ltstretch = .false. !! Whether to employ time stretching or not - character(STRMAX) :: outfile = BIN_OUTFILE !! Name of output binary file - character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file - character(STRMAX) :: out_form = "XVEL" !! Data to write to output file - character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - integer(I4B) :: dump_cadence = 10 !! Number of output steps between dumping simulation data to file - real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle - real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle - real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle - real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle - character(STRMAX) :: qmin_coord = "HELIO" !! Coordinate frame to use for qmin (["HELIO"] or "BARY") - real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin - real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin - real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams - real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds - real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters - real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units - real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units - real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating - real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event - real(DP) :: nfrag_reduction = 30.0_DP !! Reduction factor for limiting the number of collision fragments - integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling - logical :: lmtiny_pl = .false. !! Include semi-interacting massive bodies - character(STRMAX) :: collision_model = "MERGE" !! The Coll - character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory - !! through recursion steps are saved - logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach - !! distance between pairs of bodies is saved - character(NAMELEN):: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. - !! Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" - character(NAMELEN):: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. - !! Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" - character(NAMELEN):: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. - !! Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" - logical :: lcoarray = .false. !! Use Coarrays for test particle parallelization. + character(STRMAX) :: integrator + !! Name of the nbody integrator used + character(STRMAX) :: param_file_name + !! The name of the parameter file + real(DP) :: t0 = 0.0_DP + !! Integration reference time + real(DP) :: tstart = -1.0_DP + !! Integration start time + real(DP) :: tstop = -1.0_DP + !! Integration stop time + real(DP) :: dt = -1.0_DP + !! Time step + integer(I8B) :: iloop = 0_I8B + !! Main loop counter + integer(I8B) :: nloops = 0_I8B + !! Total number of loops to execute + integer(I8B) :: istart = 0_I8B + !! Starting index for loop counter + integer(I4B) :: iout = 0 + !! Output cadence counter + integer(I4B) :: idump = 0 + !! Dump cadence counter + integer(I4B) :: nout = 0 + !! Current output step + integer(I4B) :: istep = 0 + !! Current value of istep (used for time stretching) + character(STRMAX) :: incbfile = CB_INFILE + !! Name of input file for the central body + character(STRMAX) :: inplfile = PL_INFILE + !! Name of input file for massive bodies + character(STRMAX) :: intpfile = TP_INFILE + !! Name of input file for test particles + character(STRMAX) :: nc_in = NC_INFILE + !! Name of system input file for NetCDF input + character(STRMAX) :: in_type = "NETCDF_DOUBLE" + !! Data representation type of input data files + character(STRMAX) :: in_form = "XV" + !! Format of input data files ("EL" or ["XV"]) + integer(I4B) :: istep_out = -1 + !! Number of time steps between saved outputs + integer(I4B) :: nstep_out = -1 + !! Total number of saved outputs + real(DP) :: fstep_out = 1.0_DP + !! The output step time stretching factor + logical :: ltstretch = .false. + !! Whether to employ time stretching or not + character(STRMAX) :: outfile = BIN_OUTFILE + !! Name of output binary file + character(STRMAX) :: out_type = "NETCDF_DOUBLE" + !! Binary format of output file + character(STRMAX) :: out_form = "XVEL" + !! Data to write to output file + character(STRMAX) :: out_stat = 'NEW' + !! Open status for output binary file + integer(I4B) :: dump_cadence = 10 + !! Number of output steps between dumping simulation data to file + real(DP) :: rmin = -1.0_DP + !! Minimum heliocentric radius for test particle + real(DP) :: rmax = -1.0_DP + !! Maximum heliocentric radius for test particle + real(DP) :: rmaxu = -1.0_DP + !! Maximum unbound heliocentric radius for test particle + real(DP) :: qmin = -1.0_DP + !! Minimum pericenter distance for test particle + character(STRMAX) :: qmin_coord = "HELIO" + !! Coordinate frame to use for qmin (["HELIO"] or "BARY") + real(DP) :: qmin_alo = -1.0_DP + !! Minimum semimajor axis for qmin + real(DP) :: qmin_ahi = -1.0_DP + !! Maximum semimajor axis for qmin + real(QP) :: MU2KG = -1.0_QP + !! Converts mass units to grams + real(QP) :: TU2S = -1.0_QP + !! Converts time units to seconds + real(QP) :: DU2M = -1.0_QP + !! Converts distance unit to centimeters + real(DP) :: GU = -1.0_DP + !! Universal gravitational constant in the system units + real(DP) :: inv_c2 = -1.0_DP + !! Inverse speed of light squared in the system units + real(DP) :: GMTINY = -1.0_DP + !! Smallest G*mass that is fully gravitating + real(DP) :: min_GMfrag = -1.0_DP + !! Smallest G*mass that can be produced in a fragmentation event + real(DP) :: nfrag_reduction = 30.0_DP + !! Reduction factor for limiting the number of collision fragments + integer(I4B), dimension(:), allocatable :: seed + !! Random seeds for fragmentation modeling + logical :: lmtiny_pl = .false. + !! Include semi-interacting massive bodies + character(STRMAX) :: collision_model = "MERGE" + !! The Coll + character(STRMAX) :: encounter_save = "NONE" + !! Indicate if and how encounter data should be saved + logical :: lenc_save_trajectory = .false. + !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_save_closest = .false. + !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved + character(NAMELEN):: interaction_loops = "ADAPTIVE" + !! Method used to compute interaction loops. + !! Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" + character(NAMELEN):: encounter_check_plpl = "ADAPTIVE" + !! Method used to compute pl-pl encounter checks. + !! Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + character(NAMELEN):: encounter_check_pltp = "ADAPTIVE" + !! Method used to compute pl-tp encounter checks. + !! Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + logical :: lcoarray = .false. + !! Use Coarrays for test particle parallelization. ! The following are not set by the user, but instead are determined by the input value of INTERACTION_LOOPS - logical :: lflatten_interactions = .false. !! Use the flattened upper triangular matrix for pl-pl interaction loops - logical :: lencounter_sas_plpl = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking - !! for close encounters - logical :: lencounter_sas_pltp = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking - !! for close encounters + logical :: lflatten_interactions = .false. + !! Use the flattened upper triangular matrix for pl-pl interaction loops + logical :: lencounter_sas_plpl = .false. + !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters + logical :: lencounter_sas_pltp = .false. + !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters ! Logical flags to turn on or off various features of the code - logical :: lrhill_present = .false. !! Hill radii are given as an input rather than calculated by the code (can be used to - !! inflate close encounter regions manually) - logical :: lextra_force = .false. !! User defined force function turned on - logical :: lbig_discard = .false. !! Save big bodies on every discard - logical :: lclose = .false. !! Turn on close encounters - logical :: lenergy = .false. !! Track the total energy of the system - logical :: loblatecb = .false. !! Calculate acceleration from oblate central body (automatically turns true if nonzero J2 - !! is input) - logical :: lrotation = .false. !! Include rotation states of big bodies - logical :: ltides = .false. !! Include tidal dissipation + logical :: lrhill_present = .false. + !! Hill radii are given as an input rather than calculated by the code (can be used to inflate close encounter regions + !! manually) + logical :: lextra_force = .false. + !! User defined force function turned on + logical :: lbig_discard = .false. + !! Save big bodies on every discard + logical :: lclose = .false. + !! Turn on close encounters + logical :: lenergy = .false. + !! Track the total energy of the system + logical :: lnon_spherical_cb = .false. + !! Calculate acceleration from oblate central body (automatically turns true if nonzero J2, J4, or c_lm is input) + logical :: lrotation = .false. + !! Include rotation states of big bodies + logical :: ltides = .false. + !! Include tidal dissipation ! Initial values to pass to the energy report subroutine (usually only used in the case of a restart, otherwise these will be ! updated with initial conditions values) - real(DP) :: E_orbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: L_total_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: L_orbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: L_spin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: L_escape = 0.0_DP !! Angular momentum of escaped bodies (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: E_collisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: E_untracked = 0.0_DP !! Energy gained from system due to escaped bodies - logical :: lfirstenergy = .true. !! This is the first time computing energe - logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step - logical :: lrestart = .false. !! Indicates whether or not this is a restarted run - - character(NAMELEN) :: display_style !! Style of the output display {["STANDARD"], "COMPACT"}). - integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) - logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal + real(DP) :: E_orbit_orig = 0.0_DP + !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP + !! Initial system mass + real(DP), dimension(NDIM) :: L_total_orig = 0.0_DP + !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: L_orbit_orig = 0.0_DP + !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: L_spin_orig = 0.0_DP + !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: L_escape = 0.0_DP + !! Angular momentum of escaped bodies (used for bookeeping) + real(DP) :: GMescape = 0.0_DP + !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: E_collisions = 0.0_DP + !! Energy lost from system due to collisions + real(DP) :: E_untracked = 0.0_DP + !! Energy gained from system due to escaped bodies + logical :: lfirstenergy = .true. + !! This is the first time computing energe + logical :: lfirstkick = .true. + !! Initiate the first kick in a symplectic step + logical :: lrestart = .false. + !! Indicates whether or not this is a restarted run + + character(NAMELEN) :: display_style + !! Style of the output display {["STANDARD"], "COMPACT"}). + integer(I4B) :: display_unit = OUTPUT_UNIT + !! File unit number for display (either to stdout or to a log file) + logical :: log_output = .false. + !! Logs the output to file instead of displaying it on the terminal ! Future features not implemented or in development - logical :: lgr = .false. !! Turn on GR - logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect - logical :: lyorp = .false. !! Turn on YORP effect + logical :: lgr = .false. + !! Turn on GR + logical :: lyarkovsky = .false. + !! Turn on Yarkovsky effect + logical :: lyorp = .false. + !! Turn on YORP effect contains procedure :: dealloc => base_util_dealloc_param procedure(abstract_io_dump_param), deferred :: dump @@ -138,43 +215,60 @@ module base subroutine abstract_io_dump_param(self, param_file_name) import base_parameters implicit none - class(base_parameters),intent(in) :: self !! Output collection of parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + class(base_parameters),intent(in) :: self + !! Output collection of parameters + character(len=*), intent(in) :: param_file_name + !! Parameter input file name (i.e. param.in) end subroutine abstract_io_dump_param subroutine abstract_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) import base_parameters, I4B implicit none - class(base_parameters), intent(inout) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the - !! text from the char-literal-constant, prefixed with DT. If you do - !! not include a char-literal-constant, the iotype argument contains - !! only DT. - character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + class(base_parameters), intent(inout) :: self + !! Collection of parameters + integer(I4B), intent(in) :: unit + !! File unit number + character(len=*), intent(in) :: iotype + !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with + !! DT. If you do not include a char-literal-constant, the iotype argument contains only DT. + character(len=*), intent(in) :: v_list(:) + !! The first element passes the integrator code to the reader + integer(I4B), intent(out) :: iostat + !! IO status code + character(len=*), intent(inout) :: iomsg + !! Message to pass if iostat /= 0 end subroutine abstract_io_param_reader subroutine abstract_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) import base_parameters, I4B implicit none - class(base_parameters), intent(in) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the - !! text from the char-literal-constant, prefixed with DT. If you do - !! not include a char-literal-constant, the iotype argument contains - !! only DT. - integer(I4B), intent(in) :: v_list(:) !! Not used in this procedure - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + class(base_parameters), intent(in) :: self + !! Collection of parameters + integer(I4B), intent(in) :: unit + !! File unit number + character(len=*), intent(in) :: iotype + !! Dummy argument passed to the input/output procedure contains the + + !! text from the char-literal-constant, prefixed with DT. If you do + + !! not include a char-literal-constant, the iotype argument contains + + !! only DT. + integer(I4B), intent(in) :: v_list(:) + !! Not used in this procedure + integer(I4B), intent(out) :: iostat + !! IO status code + character(len=*), intent(inout) :: iomsg + !! Message to pass if iostat /= 0 end subroutine abstract_io_param_writer subroutine abstract_io_read_in_param(self, param_file_name) import base_parameters implicit none - class(base_parameters), intent(inout) :: self !! Current run configuration parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + class(base_parameters), intent(inout) :: self + !! Current run configuration parameters + character(len=*), intent(in) :: param_file_name + !! Parameter input file name (i.e. param.in) end subroutine abstract_io_read_in_param end interface @@ -182,33 +276,47 @@ end subroutine abstract_io_read_in_param type :: base_storage_frame class(*), allocatable :: item contains - procedure :: store => base_util_copy_store !! Stores a snapshot of the nbody system so that later it can be - !! retrieved for saving to file. + procedure :: store => base_util_copy_store + !! Stores a snapshot of the nbody system so that later it can be + + !! retrieved for saving to file. generic :: assignment(=) => store final :: base_final_storage_frame end type type, abstract :: base_storage - !! An class that establishes the pattern for various storage objects - integer(I4B) :: nframes !! Total number of frames that can be stored - - !! An class that establishes the pattern for various storage objects - type(base_storage_frame), dimension(:), allocatable :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B) :: nid !! Number of unique id values in all saved snapshots - integer(I4B), dimension(:), allocatable :: idvals !! The set of unique id values contained in the snapshots - integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map - integer(I4B) :: nt !! Number of unique time values in all saved snapshots - real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots - integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map + + !! An class that establishes the pattern for various storage objects + integer(I4B) :: nframes + !! Total number of frames that can be stored An class that establishes the pattern for various storage objects + type(base_storage_frame), dimension(:), allocatable :: frame + !! Array of stored frames + integer(I4B) :: iframe = 0 + !! Index of the last frame stored in the system + integer(I4B) :: nid + !! Number of unique id values in all saved snapshots + integer(I4B), dimension(:), allocatable :: idvals + !! The set of unique id values contained in the snapshots + integer(I4B), dimension(:), allocatable :: idmap + !! The id value -> index map + integer(I4B) :: nt + !! Number of unique time values in all saved snapshots + real(DP), dimension(:), allocatable :: tvals + !! The set of unique time values contained in the snapshots + integer(I4B), dimension(:), allocatable :: tmap + !! The t value -> index map contains - procedure :: dealloc => base_util_dealloc_storage !! Deallocates all allocatables - procedure :: reset => base_util_reset_storage !! Resets the storage object back to its original state by removing all of - !! the saved items from the storage frames - procedure :: resize => base_util_resize_storage !! Resizes storage if it is too small - procedure :: setup => base_util_setup_storage !! Sets up a storage system with a set number of frames - procedure :: save => base_util_snapshot_save !! Takes a snapshot of the current system + procedure :: dealloc => base_util_dealloc_storage + !! Deallocates all allocatables + procedure :: reset => base_util_reset_storage + !! Resets the storage object back to its original state by removing all of the saved items from the storage frames + procedure :: resize => base_util_resize_storage + !! Resizes storage if it is too small + procedure :: setup => base_util_setup_storage + !! Sets up a storage system with a set number of frames + procedure :: save => base_util_snapshot_save + !! Takes a snapshot of the current system end type base_storage @@ -228,7 +336,8 @@ end subroutine abstract_io_read_in_param subroutine abstract_util_dealloc_object(self) import base_object implicit none - class(base_object), intent(inout) :: self !! Generic Swiftest object type + class(base_object), intent(inout) :: self + !! Generic Swiftest object type end subroutine abstract_util_dealloc_object end interface @@ -305,17 +414,22 @@ end subroutine abstract_util_dealloc_object contains subroutine base_util_append_arr_char_string(arr, source, nold, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of character string type onto another. If the destination array is not allocated, or is not big - !! enough, this will allocate space for it. + + !! author: David A. Minton + !! + !! Append a single array of character string type onto another. If the destination array is not allocated, or is not big + !! enough, this will allocate space for it. implicit none ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at - !! arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + character(len=STRMAX), dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig @@ -352,17 +466,22 @@ end subroutine base_util_append_arr_char_string subroutine base_util_append_arr_DP(arr, source, nold, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of double precision type onto another. If the destination array is not allocated, or is not big - !! enough, this will allocate space for it. + !! author: David A. Minton + !! + !! Append a single array of double precision type onto another. If the destination array is not allocated, or is not big + !! enough, this will allocate space for it. implicit none ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at - !! arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + real(DP), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + real(DP), dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at + + !! arr(nold+1). Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig @@ -399,17 +518,21 @@ end subroutine base_util_append_arr_DP subroutine base_util_append_arr_DPvec(arr, source, nold, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not - !! allocated, or is not big enough, this will allocate space for it. + !! author: David A. Minton + !! + !! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not + !! allocated, or is not big enough, this will allocate space for it. implicit none ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at - !! arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + real(DP), dimension(:,:), allocatable, intent(inout) :: arr + !! Destination array + real(DP), dimension(:,:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig @@ -448,17 +571,21 @@ end subroutine base_util_append_arr_DPvec subroutine base_util_append_arr_I4B(arr, source, nold, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of integer(I4B) onto another. If the destination array is not allocated, or is not big enough, - !! this will allocate space for it. + !! author: David A. Minton + !! + !! Append a single array of integer(I4B) onto another. If the destination array is not allocated, or is not big enough, + !! this will allocate space for it. implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at - !! arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + integer(I4B), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig @@ -495,17 +622,21 @@ end subroutine base_util_append_arr_I4B subroutine base_util_append_arr_logical(arr, source, nold, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of logical type onto another. If the destination array is not allocated, or is not big enough, - !! this will allocate space for it. + !! author: David A. Minton + !! + !! Append a single array of logical type onto another. If the destination array is not allocated, or is not big enough, + !! this will allocate space for it. implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at - !! arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + logical, dimension(:), allocatable, intent(inout) :: arr + !! Destination array + logical, dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig @@ -542,12 +673,14 @@ end subroutine base_util_append_arr_logical subroutine base_util_copy_store(self, source) - !! author: David A. Minton - !! - !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + !! author: David A. Minton + !! + !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. implicit none - class(base_storage_frame), intent(inout) :: self !! Swiftest storage frame object - class(*), intent(in) :: source !! Swiftest n-body system object + class(base_storage_frame), intent(inout) :: self + !! Swiftest storage frame object + class(*), intent(in) :: source + !! Swiftest n-body system object if (allocated(self%item)) deallocate(self%item) allocate(self%item, source=source) @@ -557,12 +690,13 @@ end subroutine base_util_copy_store subroutine base_util_dealloc_param(self) - !! author: David A. Minton - !! - !! Deallocates all allocatables + !! author: David A. Minton + !! + !! Deallocates all allocatables implicit none ! Arguments - class(base_parameters),intent(inout) :: self !! Collection of parameters + class(base_parameters),intent(inout) :: self + !! Collection of parameters if (allocated(self%seed)) deallocate(self%seed) @@ -571,12 +705,13 @@ end subroutine base_util_dealloc_param subroutine base_util_dealloc_storage(self) - !! author: David A. Minton - !! - !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + !! author: David A. Minton + !! + !! Resets a storage object by deallocating all items and resetting the frame counter to 0 implicit none ! Arguments - class(base_storage), intent(inout) :: self !! Swiftest storage object + class(base_storage), intent(inout) :: self + !! Swiftest storage object call self%reset() if (allocated(self%frame)) deallocate(self%frame) @@ -587,12 +722,12 @@ end subroutine base_util_dealloc_storage subroutine base_util_exit(code,unit) - !! author: David A. Minton - !! - !! Print termination message and exit program - !! - !! Adapted from David E. Kaufmann's Swifter routine: base_util_exit.f90 - !! Adapted from Hal Levison's Swift routine base_util_exit.f + !! author: David A. Minton + !! + !! Print termination message and exit program + !! + !! Adapted from David E. Kaufmann's Swifter routine: base_util_exit.f90 + !! Adapted from Hal Levison's Swift routine base_util_exit.f implicit none ! Arguments integer(I4B), intent(in) :: code @@ -600,7 +735,7 @@ subroutine base_util_exit(code,unit) ! Internals character(*), parameter :: BAR = '("---------------------------------------------------")' character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", A, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", A, ") due to error!!")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", A, ") due to error!")' character(*), parameter :: USAGE_MSG = '("Usage: swiftest_driver ' // & '[{standard}|compact|progress]")' character(*), parameter :: HELP_MSG = USAGE_MSG @@ -632,16 +767,20 @@ end subroutine base_util_exit subroutine base_util_fill_arr_char_string(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type character strings - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type character strings. + !! This is the inverse of a spill operation implicit none ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the - !! keeps + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the + + !! keeps if (.not.allocated(keeps) .or. .not.allocated(inserts)) return @@ -653,15 +792,18 @@ end subroutine base_util_fill_arr_char_string subroutine base_util_fill_arr_DP(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type DP - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type DP. + !! This is the inverse of a spill operation implicit none ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + real(DP), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + real(DP), dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps if (.not.allocated(keeps) .or. .not.allocated(inserts)) return @@ -673,15 +815,18 @@ end subroutine base_util_fill_arr_DP subroutine base_util_fill_arr_DPvec(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of DP vectors with shape (NDIM, n) - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of DP vectors with shape (NDIM, n) + !! This is the inverse of a spill operation implicit none ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps + !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps ! Internals integer(I4B) :: i @@ -697,15 +842,18 @@ end subroutine base_util_fill_arr_DPvec subroutine base_util_fill_arr_I4B(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type I4B - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type I4B + !! This is the inverse of a spill operation implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps if (.not.allocated(keeps) .or. .not.allocated(inserts)) return @@ -717,15 +865,18 @@ end subroutine base_util_fill_arr_I4B subroutine base_util_fill_arr_logical(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of logicals - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of logicals + !! This is the inverse of a spill operation implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + logical, dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + logical, dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps if (.not.allocated(keeps) .or. .not.allocated(inserts)) return @@ -736,10 +887,10 @@ subroutine base_util_fill_arr_logical(keeps, inserts, lfill_list) end subroutine base_util_fill_arr_logical subroutine base_util_reset_storage(self) - !! author: David A. Minton - !! - !! Resets the storage object back to its original state by removing all of the saved items from the storage frames, but - !! does not deallocate the frames + !! author: David A. Minton + !! + !! Resets the storage object back to its original state by removing all of the saved items from the storage frames, but + !! does not deallocate the frames implicit none ! Arguments class(base_storage), intent(inout) :: self @@ -765,16 +916,20 @@ end subroutine base_util_reset_storage subroutine base_util_resize_arr_char_string(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of type character string. nnew = 0 will deallocate. + !! author: David A. Minton + !! + !! Resizes an array component of type character string. nnew = 0 will deallocate. implicit none ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size ! Internals - character(len=STRMAX), dimension(:), allocatable :: tmp !! Temp. storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + character(len=STRMAX), dimension(:), allocatable :: tmp + !! Temp. storage array in case the input array is already allocated + integer(I4B) :: nold + !! Old size if (nnew < 0) return @@ -809,16 +964,20 @@ end subroutine base_util_resize_arr_char_string subroutine base_util_resize_arr_DP(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of double precision type. Passing nnew = 0 will deallocate. + !! author: David A. Minton + !! + !! Resizes an array component of double precision type. Passing nnew = 0 will deallocate. implicit none ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + real(DP), dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size ! Internals - real(DP), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + real(DP), dimension(:), allocatable :: tmp + !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold + !! Old size real(DP), parameter :: init_val = 0.0_DP if (nnew < 0) return @@ -854,16 +1013,20 @@ end subroutine base_util_resize_arr_DP subroutine base_util_resize_arr_DPvec(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of double precision vectors of size (NDIM, n). Passing nnew = 0 will deallocate. + !! author: David A. Minton + !! + !! Resizes an array component of double precision vectors of size (NDIM, n). Passing nnew = 0 will deallocate. implicit none ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + real(DP), dimension(:,:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size ! Internals - real(DP), dimension(:,:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + real(DP), dimension(:,:), allocatable :: tmp + !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold + !! Old size real(DP), dimension(NDIM), parameter :: init_val = 0.0_DP integer(I4B) :: i @@ -906,16 +1069,20 @@ end subroutine base_util_resize_arr_DPvec subroutine base_util_resize_arr_I4B(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of integer type. Passing nnew = 0 will deallocate. + !! author: David A. Minton + !! + !! Resizes an array component of integer type. Passing nnew = 0 will deallocate. implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + integer(I4B), dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + integer(I4B), dimension(:), allocatable :: tmp + !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold + !! Old size integer(I4B), parameter :: init_val = -1 if (nnew < 0) return @@ -951,16 +1118,20 @@ end subroutine base_util_resize_arr_I4B subroutine base_util_resize_arr_logical(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of logical type. Passing nnew = 0 will deallocate. + !! author: David A. Minton + !! + !! Resizes an array component of logical type. Passing nnew = 0 will deallocate. implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + logical, dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size + logical, dimension(:), allocatable :: tmp + !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold + !! Old size logical, parameter :: init_val = .false. if (nnew < 0) return @@ -996,13 +1167,15 @@ end subroutine base_util_resize_arr_logical subroutine base_util_resize_storage(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest against the requested size and resizes it if it is too small. + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest against the requested size and resizes it if it is too small. implicit none ! Arguments - class(base_storage), intent(inout) :: self !! Storage object - integer(I4B), intent(in) :: nnew !! New size + class(base_storage), intent(inout) :: self + !! Storage object + integer(I4B), intent(in) :: nnew + !! New size ! Internals class(base_storage_frame), dimension(:), allocatable :: tmp integer(I4B) :: i, nold, nbig @@ -1026,13 +1199,15 @@ end subroutine base_util_resize_storage subroutine base_util_setup_storage(self, n) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest against the requested size and resizes it if it is too small. + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest against the requested size and resizes it if it is too small. implicit none ! Arguments - class(base_storage), intent(inout) :: self !! Storage object - integer(I4B), intent(in) :: n !! New size + class(base_storage), intent(inout) :: self + !! Storage object + integer(I4B), intent(in) :: n + !! New size if (allocated(self%frame)) deallocate(self%frame) allocate(self%frame(n)) @@ -1043,18 +1218,20 @@ end subroutine base_util_setup_storage subroutine base_util_snapshot_save(self, snapshot) - !! author: David A. Minton - !! - !! Checks the current size of the storage object against the required size and extends it by a factor of 2 more than - !! requested if it is too small. - !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing - !! every time you want to add an encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff - !! between performance (fewer resize calls) and memory managment. Memory usage grows by a factor of 2 each time it fills - !! up, but no more. + !! author: David A. Minton + !! + !! Checks the current size of the storage object against the required size and extends it by a factor of 2 more than + !! requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing + !! every time you want to add an encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff + !! between performance (fewer resize calls) and memory managment. Memory usage grows by a factor of 2 each time it fills + !! up, but no more. implicit none ! Arguments - class(base_storage), intent(inout) :: self !! Storage encounter storage object - class(*), intent(in) :: snapshot !! Object to snapshot + class(base_storage), intent(inout) :: self + !! Storage encounter storage object + class(*), intent(in) :: snapshot + !! Object to snapshot ! Internals integer(I4B) :: nnew, nold @@ -1074,22 +1251,24 @@ end subroutine base_util_snapshot_save subroutine base_util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type character strings - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type character strings + !! This is the inverse of a spill operation implicit none ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into - !! the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not - !! this operation should alter the keeps - !! array or not + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist - character(len=STRMAX), dimension(:), allocatable :: tmp !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1120,20 +1299,26 @@ end subroutine base_util_spill_arr_char_string subroutine base_util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type DP - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type DP + !! This is the inverse of a spill operation implicit none ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation - !! should alter the keeps array or not + real(DP), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + real(DP), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation + + !! should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist - real(DP), dimension(:), allocatable :: tmp !! Array of values to keep + real(DP), dimension(:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1164,20 +1349,24 @@ end subroutine base_util_spill_arr_DP subroutine base_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of DP vectors with shape (NDIM, n) - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of DP vectors with shape (NDIM, n) + !! This is the inverse of a spill operation implicit none ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this - !! operation should alter the keeps array or not + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps + !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(inout) :: discards + !! Array discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: i, nspill, nkeep, nlist - real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep + real(DP), dimension(:,:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1212,20 +1401,24 @@ end subroutine base_util_spill_arr_DPvec subroutine base_util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type I4B - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type I4B + !! This is the inverse of a spill operation implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive!! Logical flag indicating whether or not this - !! operation should alter the keeps array or not + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist - integer(I4B), dimension(:), allocatable :: tmp !! Array of values to keep + integer(I4B), dimension(:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1256,20 +1449,26 @@ end subroutine base_util_spill_arr_I4B subroutine base_util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type I4B - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type I4B + !! This is the inverse of a spill operation implicit none ! Arguments - integer(I8B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I8B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive!! Logical flag indicating whether or not this - !! operation should alter the keeps array or not + integer(I8B), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + integer(I8B), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this + + !! operation should alter the keeps array or not ! Internals integer(I4B) :: nspill, nkeep, nlist - integer(I8B), dimension(:), allocatable :: tmp !! Array of values to keep + integer(I8B), dimension(:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1300,20 +1499,26 @@ end subroutine base_util_spill_arr_I8B subroutine base_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of logicals - !! This is the inverse of a spill operation + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of logicals + !! This is the inverse of a spill operation implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation - !! should alter the keeps array or no + logical, dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + logical, dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation + + !! should alter the keeps array or no ! Internals integer(I4B) :: nspill, nkeep, nlist - logical, dimension(:), allocatable :: tmp !! Array of values to keep + logical, dimension(:), allocatable :: tmp + !! Array of values to keep nkeep = count(.not.lspill_list(:)) nspill = count(lspill_list(:)) @@ -1344,10 +1549,9 @@ end subroutine base_util_spill_arr_logical pure subroutine base_util_sort_dp(arr) - !! author: David A. Minton - !! - !! Sort input DP precision array in place into ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array in place into ascending numerical order using quicksort. implicit none ! Arguments real(DP), dimension(:), intent(inout) :: arr @@ -1359,13 +1563,12 @@ end subroutine base_util_sort_dp pure subroutine base_util_sort_index_dp(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quick sort. - !! This algorithm works well for partially sorted arrays (which is usually the case here). - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quick sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here). + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. implicit none ! Arguments real(DP), dimension(:), intent(in) :: arr @@ -1388,15 +1591,15 @@ end subroutine base_util_sort_index_dp recursive pure subroutine base_util_sort_qsort_DP(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort sort. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort sort. implicit none ! Arguments real(DP), dimension(:), intent(inout) :: arr integer(I4B),dimension(:),intent(out), optional :: ind - !! Internals + + !! Internals integer :: iq if (size(arr) > 1) then @@ -1416,10 +1619,10 @@ end subroutine base_util_sort_qsort_DP pure subroutine base_util_sort_partition_DP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on DP type - !! + !! author: David A. Minton + !! + !! Partition function for quicksort on DP type + !! implicit none ! Arguments real(DP), intent(inout), dimension(:) :: arr @@ -1473,11 +1676,10 @@ end subroutine base_util_sort_partition_DP pure subroutine base_util_sort_i4b(arr) - !! author: David A. Minton - !! - !! Sort input integer array in place into ascending numerical order using quick sort. - !! This algorithm works well for partially sorted arrays (which is usually the case here) - !! + !! author: David A. Minton + !! + !! Sort input integer array in place into ascending numerical order using quick sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here) implicit none ! Arguments integer(I4B), dimension(:), intent(inout) :: arr @@ -1489,12 +1691,11 @@ end subroutine base_util_sort_i4b pure subroutine base_util_sort_index_I4B(arr, ind) - !! author: David A. Minton - !! - !! Sort input integer array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. - !! + !! author: David A. Minton + !! + !! Sort input integer array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. implicit none ! Arguments integer(I4B), dimension(:), intent(in) :: arr @@ -1517,12 +1718,11 @@ end subroutine base_util_sort_index_I4B pure subroutine base_util_sort_index_I4B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input integer array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. - !! + !! author: David A. Minton + !! + !! Sort input integer array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. implicit none ! Arguments integer(I4B), dimension(:), intent(in) :: arr @@ -1545,12 +1745,11 @@ end subroutine base_util_sort_index_I4B_I8Bind pure subroutine base_util_sort_index_I8B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input integer array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. - !! + !! author: David A. Minton + !! + !! Sort input integer array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. implicit none ! Arguments integer(I8B), dimension(:), intent(in) :: arr @@ -1573,10 +1772,9 @@ end subroutine base_util_sort_index_I8B_I8Bind recursive pure subroutine base_util_sort_qsort_I4B(arr, ind) - !! author: David A. Minton - !! - !! Sort input I4B array by index in ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input I4B array by index in ascending numerical order using quicksort. implicit none ! Arguments integer(I4B), dimension(:), intent(inout) :: arr @@ -1601,10 +1799,10 @@ end subroutine base_util_sort_qsort_I4B recursive pure subroutine base_util_sort_qsort_I4B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input I4B array by index in ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input I4B array by index in ascending numerical order using quicksort. + !! implicit none ! Arguments integer(I4B), dimension(:), intent(inout) :: arr @@ -1629,10 +1827,9 @@ end subroutine base_util_sort_qsort_I4B_I8Bind recursive pure subroutine base_util_sort_qsort_I8B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input I8B array by index in ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input I8B array by index in ascending numerical order using quicksort. implicit none ! Arguments integer(I8B), dimension(:), intent(inout) :: arr @@ -1657,10 +1854,14 @@ end subroutine base_util_sort_qsort_I8B_I8Bind pure subroutine base_util_sort_partition_I4B(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! + + !! author: David A. Minton + + !! + + !! Partition function for quicksort on I4B type + + !! implicit none ! Arguments integer(I4B), intent(inout), dimension(:) :: arr @@ -1714,10 +1915,9 @@ end subroutine base_util_sort_partition_I4B pure subroutine base_util_sort_partition_I4B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! + !! author: David A. Minton + !! + !! Partition function for quicksort on I4B type implicit none ! Arguments integer(I4B), intent(inout), dimension(:) :: arr @@ -1771,10 +1971,9 @@ end subroutine base_util_sort_partition_I4B_I8Bind pure subroutine base_util_sort_partition_I8B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I8B type with I8B index - !! + !! author: David A. Minton + !! + !! Partition function for quicksort on I8B type with I8B index implicit none ! Arguments integer(I8B), intent(inout), dimension(:) :: arr @@ -1828,10 +2027,10 @@ end subroutine base_util_sort_partition_I8B_I8Bind pure subroutine base_util_sort_sp(arr) - !! author: David A. Minton - !! - !! Sort input DP precision array in place into ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array in place into ascending numerical order using quicksort. + !! implicit none ! Arguments real(SP), dimension(:), intent(inout) :: arr @@ -1843,12 +2042,11 @@ end subroutine base_util_sort_sp pure subroutine base_util_sort_index_sp(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. implicit none ! Arguments real(SP), dimension(:), intent(in) :: arr @@ -1871,15 +2069,15 @@ end subroutine base_util_sort_index_sp recursive pure subroutine base_util_sort_qsort_SP(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort. - !! + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort. implicit none ! Arguments real(SP), dimension(:), intent(inout) :: arr integer(I4B),dimension(:),intent(out), optional :: ind - !! Internals + + ! Internals integer :: iq if (size(arr) > 1) then @@ -1899,10 +2097,9 @@ end subroutine base_util_sort_qsort_SP pure subroutine base_util_sort_partition_SP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on SP type - !! + !! author: David A. Minton + !! + !! Partition function for quicksort on SP type implicit none ! Arguments real(SP), intent(inout), dimension(:) :: arr @@ -1956,16 +2153,20 @@ end subroutine base_util_sort_partition_SP pure subroutine base_util_sort_rearrange_arr_char_string(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of character string in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of character string in-place from an index list. implicit none ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary copy of arry used during rearrange operation + character(len=STRMAX), dimension(:), allocatable :: tmp + !! Temporary copy of arry used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -1977,16 +2178,20 @@ end subroutine base_util_sort_rearrange_arr_char_string pure subroutine base_util_sort_rearrange_arr_DP(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of DP type in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of DP type in-place from an index list. implicit none ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + real(DP), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - real(DP), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + real(DP), dimension(:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -1998,16 +2203,20 @@ end subroutine base_util_sort_rearrange_arr_DP pure subroutine base_util_sort_rearrange_arr_DPvec(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of (NDIM,n) DP-type vectors in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of (NDIM,n) DP-type vectors in-place from an index list. implicit none ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + real(DP), dimension(:,:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - real(DP), dimension(:,:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + real(DP), dimension(:,:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -2019,16 +2228,20 @@ end subroutine base_util_sort_rearrange_arr_DPvec pure subroutine base_util_sort_rearrange_arr_I4B(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of integers in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of integers in-place from an index list. implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + integer(I4B), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + integer(I4B), dimension(:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -2039,16 +2252,20 @@ pure subroutine base_util_sort_rearrange_arr_I4B(arr, ind, n) end subroutine base_util_sort_rearrange_arr_I4B pure subroutine base_util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of integers in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of integers in-place from an index list. implicit none ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + integer(I4B), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I8B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I8B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + integer(I4B), dimension(:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0_I8B) return allocate(tmp, mold=arr) @@ -2060,16 +2277,20 @@ end subroutine base_util_sort_rearrange_arr_I4B_I8Bind pure subroutine base_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of logicals in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of logicals in-place from an index list. implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + logical, dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I8B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I8B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + logical, dimension(:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -2081,16 +2302,20 @@ end subroutine base_util_sort_rearrange_arr_logical_I8Bind pure subroutine base_util_sort_rearrange_arr_logical(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of logicals in-place from an index list. + !! author: David A. Minton + !! + !! Rearrange a single array of logicals in-place from an index list. implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + logical, dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + logical, dimension(:), allocatable :: tmp + !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) @@ -2102,16 +2327,18 @@ end subroutine base_util_sort_rearrange_arr_logical subroutine base_util_unique_DP(input_array, output_array, index_map) - !! author: David A. Minton - !! - !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) implicit none ! Arguments - real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array - real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such - !! that any for any index i, - !! output_array(index_map(i)) = input_array(i) + real(DP), dimension(:), intent(in) :: input_array + !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array + !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map + !! An array of the same size as input_array that such that any for any index i, + !! output_array(index_map(i)) = input_array(i) ! Internals real(DP), dimension(:), allocatable :: unique_array integer(I4B) :: n @@ -2137,16 +2364,18 @@ end subroutine base_util_unique_DP subroutine base_util_unique_I4B(input_array, output_array, index_map) - !! author: David A. Minton - !! + !! author: David A. Minton + !! !! Takes an input unsorted integer array and returns a new array of sorted, unique values (I4B version) implicit none ! Arguments - integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such - !! that any for any index i, - !! output_array(index_map(i)) = input_array(i) + integer(I4B), dimension(:), intent(in) :: input_array + !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array + !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map + !! An array of the same size as input_array that such that any for any index i, + !! output_array(index_map(i)) = input_array(i) ! Internals integer(I4B), dimension(:), allocatable :: unique_array integer(I4B) :: n, lo, hi @@ -2171,9 +2400,9 @@ end subroutine base_util_unique_I4B subroutine base_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer for the storage object + !! author: David A. Minton + !! + !! Finalizer for the storage object implicit none ! Arguments class(base_storage), intent(inout) :: self @@ -2184,9 +2413,9 @@ end subroutine base_final_storage subroutine base_final_storage_frame(self) - !! author: David A. Minton - !! - !! Finalizer for the storage frame data type + !! author: David A. Minton + !! + !! Finalizer for the storage frame data type implicit none type(base_storage_frame) :: self @@ -2197,12 +2426,13 @@ end subroutine base_final_storage_frame #ifdef COARRAY subroutine base_coclone_param(self) - !! author: David A. Minton - !! - !! Broadcasts the image 1 parameter to all other images in a parameter coarray + !! author: David A. Minton + !! + !! Broadcasts the image 1 parameter to all other images in a parameter coarray implicit none ! Arguments - class(base_parameters),intent(inout),codimension[*] :: self !! Collection of parameters + class(base_parameters),intent(inout),codimension[*] :: self + !! Collection of parameters ! Internals call coclone(self%integrator) @@ -2247,39 +2477,39 @@ subroutine base_coclone_param(self) call coclone(self%collision_model) call coclone(self%encounter_save) call coclone(self%lenc_save_trajectory) - call coclone(self%lenc_save_closest ) - call coclone(self%interaction_loops ) + call coclone(self%lenc_save_closest) + call coclone(self%interaction_loops) call coclone(self%encounter_check_plpl) call coclone(self%encounter_check_pltp) call coclone(self%lflatten_interactions) call coclone(self%lencounter_sas_plpl) - call coclone(self%lencounter_sas_pltp ) + call coclone(self%lencounter_sas_pltp) call coclone(self%lrhill_present) - call coclone(self%lextra_force ) - call coclone(self%lbig_discard ) - call coclone(self%lclose ) - call coclone(self%lenergy ) - call coclone(self%loblatecb ) - call coclone(self%lrotation ) - call coclone(self%ltides ) - call coclone(self%E_orbit_orig ) - call coclone(self%GMtot_orig ) + call coclone(self%lextra_force) + call coclone(self%lbig_discard) + call coclone(self%lclose) + call coclone(self%lenergy) + call coclone(self%lnon_spherical_cb) + call coclone(self%lrotation) + call coclone(self%ltides) + call coclone(self%E_orbit_orig) + call coclone(self%GMtot_orig) call coclonevec(self%L_total_orig) call coclonevec(self%L_orbit_orig) call coclonevec(self%L_spin_orig) call coclonevec(self%L_escape) - call coclone(self%GMescape ) - call coclone(self%E_collisions ) - call coclone(self%E_untracked ) + call coclone(self%GMescape) + call coclone(self%E_collisions) + call coclone(self%E_untracked) call coclone(self%lfirstenergy) - call coclone(self%lfirstkick ) - call coclone(self%lrestart ) + call coclone(self%lfirstkick) + call coclone(self%lrestart) call coclone(self%display_style) - call coclone(self%display_unit ) + call coclone(self%display_unit) call coclone(self%log_output ) - call coclone(self%lgr ) + call coclone(self%lgr) call coclone(self%lyarkovsky) - call coclone(self%lyorp ) + call coclone(self%lyorp) call coclone(self%seed) call coclone(self%lcoarray) diff --git a/src/bindings/bindings_module.f90 b/src/bindings/bindings_module.f90 index 9664c87fe..6f27a091a 100644 --- a/src/bindings/bindings_module.f90 +++ b/src/bindings/bindings_module.f90 @@ -29,7 +29,7 @@ subroutine bindings_c2f_string(c_string, f_string) return end subroutine bindings_c2f_string - subroutine bindings_c_driver(c_integrator, c_param_file_name, c_display_style) bind(c) + subroutine bindings_c_driver(c_integrator, c_param_file_name, c_display_style) bind(c, name="bindings_c_driver") implicit none character(kind=c_char), dimension(*), intent(in) :: c_integrator, c_param_file_name, c_display_style character(len=:), allocatable :: integrator, param_file_name, display_style diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index be11ee9a8..02173f6a0 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -30,7 +30,8 @@ pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, real(DP), intent(in) :: dt !! Step size logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep logical, intent(out) :: lcollision !! Logical flag indicating whether these two bodies will collide or not - logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for this pair of bodies + logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for + !! this pair of bodies ! Internals real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 @@ -39,7 +40,8 @@ pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, lclosest = .false. if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step lcollision = .true. - else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q + else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on + ! velocities and q lcollision = .false. vdotr = xr * vxr + yr * vyr + zr * vzr if (lvdotr .and. (vdotr > 0.0_DP)) then @@ -67,13 +69,13 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l !! Adapted from Hal Levison's Swift routine symba5_merge.f implicit none ! Arguments - class(collision_list_plpl), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + class(collision_list_plpl), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + class(base_parameters),intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lmask real(DP), dimension(NDIM) :: xr, vr @@ -113,14 +115,16 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l vr(:) = pl%vb(:, i) - pl%vb(:, j) rlim = pl%radius(i) + pl%radius(j) Gmtot = pl%Gmass(i) + pl%Gmass(j) - call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) + call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), & + self%lclosest(k)) end do lany_collision = any(lcollision(:)) lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) if (lany_collision .or. lany_closest) then - call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into + ! barycentric coordinates do k = 1_I8B, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) @@ -134,10 +138,12 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l self%r2(:,k) = pl%rh(:,j) + nbody_system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then - ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair + ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a + ! collider pair if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_impactors([i,j]) - ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step + ! Set the collision flag for these to bodies to true in case they become involved in another collision later in + ! the step pl%lcollision([i, j]) = .true. pl%status([i, j]) = COLLIDED call pl%info(i)%set_value(status="COLLIDED") @@ -169,13 +175,13 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l !! Adapted from Hal Levison's Swift routine symba5_merge.f implicit none ! Arguments - class(collision_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + class(collision_list_pltp),intent(inout) :: self !! SyMBA pl-tp encounter list object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lmask real(DP), dimension(NDIM) :: xr, vr @@ -187,11 +193,9 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l lany_collision = .false. if (self%nenc == 0) return + select type(nbody_system) class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - associate(pl => nbody_system%pl, tp => nbody_system%tp) nenc = self%nenc @@ -219,7 +223,8 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l j = self%index2(k) xr(:) = pl%rh(:, i) - tp%rh(:, j) vr(:) = pl%vb(:, i) - tp%vb(:, j) - call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) + call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), & + lcollision(k), self%lclosest(k)) end do lany_collision = any(lcollision(:)) @@ -227,7 +232,8 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l if (lany_collision .or. lany_closest) then - call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into + ! barycentric coordiantes do k = 1, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) @@ -249,22 +255,20 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l write(timestr, *) t call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " at t = " // trim(adjustl(timestr)) + // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) & + // ")" // " at t = " // trim(adjustl(timestr)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end if end do ! Extract the pl-tp encounter list and return the pl-tp collision_list - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + call self%extract_collisions(nbody_system, param) end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested if (lany_closest) call nbody_system%encounter_history%take_snapshot(param, nbody_system, t, "closest") end associate end select - end select return end subroutine collision_check_pltp diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 5fc489f86..072dbfa0f 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -209,7 +209,11 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) fragments%density(1) = fragments%mass(1) / volume fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) if (param%lrotation) then +#ifdef DOCONLOC + do concurrent(i = 1:NDIM) shared(impactors, fragments, L_spin_new) +#else do concurrent(i = 1:NDIM) +#endif fragments%Ip(i,1) = sum(impactors%mass(:) * impactors%Ip(i,:)) L_spin_new(i) = sum(impactors%L_orbit(i,:) + impactors%L_spin(i,:)) end do diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index ea8675089..c426310df 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -125,7 +125,8 @@ end subroutine collision_io_netcdf_dump module subroutine collision_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! - !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, + !! but with fewer variables. use, intrinsic :: ieee_arithmetic use netcdf implicit none @@ -163,102 +164,149 @@ module subroutine collision_io_netcdf_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_netcdf_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), & + "collision_io_netcdf_initialize_output nf90_create" ) nc%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%collision_id_varname, NF90_UNLIMITED, nc%collision_id_dimid), "collision_io_netcdf_initialize_output nf90_def_dim collision_id_dimid" ) ! Dimension to store individual collision events - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "collision_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_netcdf_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%collision_id_varname, NF90_UNLIMITED, nc%collision_id_dimid), & + "collision_io_netcdf_initialize_output nf90_def_dim collision_id_dimid" ) ! Dimension to store collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), & + "collision_io_netcdf_initialize_output nf90_def_dim space_dimid") ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), & + "collision_io_netcdf_initialize_output nf90_def_dim name_dimid") ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), & + "collision_io_netcdf_initialize_output nf90_def_dim str_dimid") ! Dimension for string variables (character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), & + "collision_io_netcdf_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables + ! (aka "before" vs. "after") ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, [nc%collision_id_dimid], nc%collision_id_varid), "collision_io_netcdf_initialize_output nf90_def_var collision_id_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_netcdf_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_netcdf_initialize_output nf90_def_var name_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_netcdf_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, & + [nc%collision_id_dimid], nc%collision_id_varid), & + "collision_io_netcdf_initialize_output nf90_def_var collision_id_varid") + + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, & + nc%space_dimid, nc%space_varid), & + "collision_io_netcdf_initialize_output nf90_def_var space_varid") + + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, & + [nc%str_dimid, nc%stage_dimid], nc%stage_varid), & + "collision_io_netcdf_initialize_output nf90_def_var stage_varid") ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_netcdf_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, & + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%name_varid), & + "collision_io_netcdf_initialize_output nf90_def_var name_varid") + + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, & + [nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%id_varid), & + "collision_io_netcdf_initialize_output nf90_def_var id_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%collision_id_dimid, nc%time_varid), "collision_io_netcdf_initialize_output nf90_def_var time_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%collision_id_dimid], nc%regime_varid), "collision_io_netcdf_initialize_output nf90_def_var regime_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%collision_id_dimid], nc%Qloss_varid), "collision_io_netcdf_initialize_output nf90_def_var Qloss_varid") - - call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%ptype_varid), "collision_io_netcdf_initialize_output nf90_def_var ptype_varid") + nc%collision_id_dimid, nc%time_varid), & + "collision_io_netcdf_initialize_output nf90_def_var time_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%collision_id_dimid], nc%regime_varid), & + "collision_io_netcdf_initialize_output nf90_def_var regime_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%rh_varid), "collision_io_netcdf_initialize_output nf90_def_var rh_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [nc%collision_id_dimid], nc%Qloss_varid), & + "collision_io_netcdf_initialize_output nf90_def_var Qloss_varid") + + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%name_dimid,nc%stage_dimid, nc%collision_id_dimid], nc%ptype_varid), & + "collision_io_netcdf_initialize_output nf90_def_var ptype_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%vh_varid), "collision_io_netcdf_initialize_output nf90_def_var vh_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, & + [nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%rh_varid), & + "collision_io_netcdf_initialize_output nf90_def_var rh_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%Gmass_varid), "collision_io_netcdf_initialize_output nf90_def_var Gmass_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, & + [nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%vh_varid), & + "collision_io_netcdf_initialize_output nf90_def_var vh_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, & + [nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%Gmass_varid), & + "collision_io_netcdf_initialize_output nf90_def_var Gmass_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%radius_varid), "collision_io_netcdf_initialize_output nf90_def_var radius_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, & + [nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%radius_varid), & + "collision_io_netcdf_initialize_output nf90_def_var radius_varid") if (param%lrotation) then call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%Ip_varid), "collision_io_netcdf_initialize_output nf90_def_var Ip_varid") + [nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%Ip_varid), & + "collision_io_netcdf_initialize_output nf90_def_var Ip_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%rot_varid), "collision_io_netcdf_initialize_output nf90_def_var rot_varid") + [nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%rot_varid), & + "collision_io_netcdf_initialize_output nf90_def_var rot_varid") end if if (param%lenergy) then - call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%collision_id_dimid], nc%KE_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_orb_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, & + [nc%stage_dimid, nc%collision_id_dimid], nc%KE_orb_varid), & + "collision_io_netcdf_initialize_output nf90_def_var KE_orb_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%collision_id_dimid], nc%KE_spin_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, & + [nc%stage_dimid, nc%collision_id_dimid], nc%KE_spin_varid), & + "collision_io_netcdf_initialize_output nf90_def_var KE_spin_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%collision_id_dimid], nc%PE_varid), "collision_io_netcdf_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, & + [nc%stage_dimid, nc%collision_id_dimid], nc%PE_varid), & + "collision_io_netcdf_initialize_output nf90_def_var PE_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%be_varname, nc%out_type,& - [ nc%stage_dimid, nc%collision_id_dimid], nc%BE_varid), "collision_io_netcdf_initialize_output nf90_def_var BE_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%te_varname, nc%out_type,& - [ nc%stage_dimid, nc%collision_id_dimid], nc%TE_varid), "collision_io_netcdf_initialize_output nf90_def_var TE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%be_varname, nc%out_type, & + [nc%stage_dimid, nc%collision_id_dimid], nc%BE_varid), & + "collision_io_netcdf_initialize_output nf90_def_var BE_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%te_varname, nc%out_type, & + [nc%stage_dimid, nc%collision_id_dimid], nc%TE_varid), & + "collision_io_netcdf_initialize_output nf90_def_var TE_varid") if (param%lrotation) then - call netcdf_io_check( nf90_def_var(nc%id, nc%L_orbit_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%L_orbit_varid), "collision_io_netcdf_initialize_output nf90_def_var L_orbit_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orbit_varname, nc%out_type, & + [nc%space_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%L_orbit_varid), & + "collision_io_netcdf_initialize_output nf90_def_var L_orbit_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%L_spin_varid), "collision_io_netcdf_initialize_output nf90_def_var L_spin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_spin_varname,nc%out_type, & + [nc%space_dimid, nc%stage_dimid, nc%collision_id_dimid], nc%L_spin_varid), & + "collision_io_netcdf_initialize_output nf90_def_var L_spin_varid") end if end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_netcdf_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), & + "collision_io_netcdf_initialize_output nf90_inquire nVariables") do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_netcdf_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), & + "collision_io_netcdf_initialize_output nf90_inquire_variable") select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), & + "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_INT") case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), & + "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT") case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), & + "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE") case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), & + "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR") end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "collision_io_netcdf_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_io_netcdf_initialize_output nf90_enddef") ! Add in the space and stage dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_netcdf_initialize_output nf90_put_var space" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 1" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), & + "collision_io_netcdf_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], & + count=[len(nc%stage_coords(1)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 1") + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], & + count=[len(nc%stage_coords(2)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 2" ) end associate end select @@ -306,44 +354,72 @@ module subroutine collision_io_netcdf_open(self, param, readonly) self%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_inq_dimid(nc%id, nc%collision_id_varname, nc%collision_id_dimid), "collision_io_netcdf_open nf90_inq_dimid collision_id_dimid" ) - call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%collision_id_dimid, nc%collision_id_varname, len=nc%max_idslot), "collision_io_find_idslot nf90_inquire_dimension max_idslot" ) - call netcdf_io_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "collision_io_netcdf_open nf90_inq_dimid space_dimid" ) - call netcdf_io_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "collision_io_netcdf_open nf90_inq_dimid name_dimid" ) - call netcdf_io_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "collision_io_netcdf_open nf90_inq_dimid str_dimid" ) - call netcdf_io_check( nf90_inq_dimid(nc%id, nc%stage_dimname, nc%stage_dimid), "collision_io_netcdf_open nf90_inq_dimid stage_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%collision_id_varname, nc%collision_id_dimid), & + "collision_io_netcdf_open nf90_inq_dimid collision_id_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%collision_id_dimid, nc%collision_id_varname, len=nc%max_idslot),& + "collision_io_find_idslot nf90_inquire_dimension max_idslot" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), & + "collision_io_netcdf_open nf90_inq_dimid space_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), & + "collision_io_netcdf_open nf90_inq_dimid name_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), & + "collision_io_netcdf_open nf90_inq_dimid str_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%stage_dimname, nc%stage_dimid), & + "collision_io_netcdf_open nf90_inq_dimid stage_dimid" ) ! Dimension coordinates - call netcdf_io_check( nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid), "collision_io_netcdf_open nf90_inq_varid collision_id_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "collision_io_netcdf_open nf90_inq_varid space_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "collision_io_netcdf_open nf90_inq_varid name_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%stage_dimname, nc%stage_varid), "collision_io_netcdf_open nf90_inq_varid stage_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid), & + "collision_io_netcdf_open nf90_inq_varid collision_id_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), & + "collision_io_netcdf_open nf90_inq_varid space_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), & + "collision_io_netcdf_open nf90_inq_varid name_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%stage_dimname, nc%stage_varid), & + "collision_io_netcdf_open nf90_inq_varid stage_varid" ) ! Required Variables - call netcdf_io_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "collision_io_netcdf_open nf90_inq_varid name_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "collision_io_netcdf_open nf90_inq_varid time_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%regime_varname, nc%regime_varid), "collision_io_netcdf_open nf90_inq_varid regime_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%Qloss_varname, nc%Qloss_varid), "collision_io_netcdf_open nf90_inq_varid Qloss_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid), "collision_io_netcdf_open nf90_inq_varid ptype_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "collision_io_netcdf_open nf90_inq_varid rh_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), "collision_io_netcdf_open nf90_inq_varid vh_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%Gmass_varname, nc%Gmass_varid), "collision_io_netcdf_open nf90_inq_varid Gmass_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "collision_io_netcdf_open nf90_inq_varid radius_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), & + "collision_io_netcdf_open nf90_inq_varid name_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), & + "collision_io_netcdf_open nf90_inq_varid time_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%regime_varname, nc%regime_varid), & + "collision_io_netcdf_open nf90_inq_varid regime_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%Qloss_varname, nc%Qloss_varid), & + "collision_io_netcdf_open nf90_inq_varid Qloss_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid), & + "collision_io_netcdf_open nf90_inq_varid ptype_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), & + "collision_io_netcdf_open nf90_inq_varid rh_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), & + "collision_io_netcdf_open nf90_inq_varid vh_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%Gmass_varname, nc%Gmass_varid), & + "collision_io_netcdf_open nf90_inq_varid Gmass_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), & + "collision_io_netcdf_open nf90_inq_varid radius_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "collision_io_netcdf_open nf90_inq_varid Ip_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "collision_io_netcdf_open nf90_inq_varid rot_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), & + "collision_io_netcdf_open nf90_inq_varid Ip_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), & + "collision_io_netcdf_open nf90_inq_varid rot_varid" ) end if if (param%lenergy) then - call netcdf_io_check( nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%ke_orb_varid), "collision_io_netcdf_open nf90_inq_varid ke_orb_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%pe_varname, nc%pe_varid), "collision_io_netcdf_open nf90_inq_varid pe_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%be_varname, nc%be_varid), "collision_io_netcdf_open nf90_inq_varid be_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%te_varname, nc%te_varid), "collision_io_netcdf_open nf90_inq_varid te_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%L_orbit_varname, nc%L_orbit_varid), "collision_io_netcdf_open nf90_inq_varid L_orbit_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%ke_orb_varid), & + "collision_io_netcdf_open nf90_inq_varid ke_orb_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%pe_varname, nc%pe_varid), & + "collision_io_netcdf_open nf90_inq_varid pe_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%be_varname, nc%be_varid), & + "collision_io_netcdf_open nf90_inq_varid be_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%te_varname, nc%te_varid), & + "collision_io_netcdf_open nf90_inq_varid te_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%L_orbit_varname, nc%L_orbit_varid), & + "collision_io_netcdf_open nf90_inq_varid L_orbit_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%ke_spin_varid), "collision_io_netcdf_open nf90_inq_varid ke_spin_varid" ) - call netcdf_io_check( nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid), "collision_io_netcdf_open nf90_inq_varid L_spin_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%ke_spin_varid), & + "collision_io_netcdf_open nf90_inq_varid ke_spin_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid), & + "collision_io_netcdf_open nf90_inq_varid L_spin_varid" ) end if end if @@ -365,21 +441,30 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) class(encounter_storage), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, idslot, old_mode, npl, stage, tmp + integer(I4B) :: i, idslot, old_mode, npl, stage, tmp, ntp character(len=NAMELEN) :: charstring class(swiftest_pl), allocatable :: pl + class(swiftest_tp), allocatable :: tp select type(nc => history%nc) class is (collision_netcdf_parameters) - associate(collider => self%collider, impactors => self%collider%impactors, fragments => self%collider%fragments, eslot => self%collider%collision_id) - call netcdf_io_check( nf90_set_fill(nc%id, NF90_NOFILL, old_mode), "collision_io_netcdf_write_frame_snapshot nf90_set_fill" ) + associate(collider => self%collider, impactors => self%collider%impactors, fragments => self%collider%fragments, & + eslot => self%collider%collision_id) + call netcdf_io_check( nf90_set_fill(nc%id, NF90_NOFILL, old_mode), & + "collision_io_netcdf_write_frame_snapshot nf90_set_fill" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, eslot, start=[eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var collision_id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, eslot, start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var collision_id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[NAMELEN, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_netcdf_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], & + count=[NAMELEN, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var regime_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var Qloss_varid" ) select type(before =>self%collider%before) class is (swiftest_nbody_system) @@ -387,44 +472,91 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) class is (swiftest_nbody_system) do stage = 1,2 if (allocated(pl)) deallocate(pl) + if (allocated(tp)) deallocate(tp) select case(stage) case(1) - allocate(pl, source=before%pl) + if (allocated(before%pl)) allocate(pl, source=before%pl) + if (allocated(before%tp)) allocate(tp, source=before%tp) case(2) - allocate(pl, source=after%pl) + if (allocated(after%pl)) allocate(pl, source=after%pl) + if (allocated(after%tp)) allocate(tp, source=after%tp) end select - npl = pl%nbody - - ! This ensures that there first idslot will have the first body in it, not id 0 which is the default for a new idvals array - if (.not.allocated(nc%idvals)) allocate(nc%idvals, source=pl%id) - do i = 1, npl - call nc%find_idslot(pl%id(i), idslot) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_netcdf_write_frame_snapshot nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[NAMELEN, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[NAMELEN, 1, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var radius_varid" ) - if (param%lrotation) then - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i)*RAD2DEG, start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid" ) - end if - end do + + if (.not. (allocated(pl) .or. allocated(tp))) cycle + + if (allocated(pl)) then + npl = pl%nbody + ! This ensures that there first idslot will have the first body in it, not id 0 which is the default for a new + ! idvals array + if (.not.allocated(nc%idvals)) allocate(nc%idvals, source=pl%id) + do i = 1, npl + call nc%find_idslot(pl%id(i), idslot) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot, stage, eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var id_varid: pl") + charstring = trim(adjustl(pl%info(i)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot, stage, eslot], & + count=[NAMELEN,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var name_varid: pl") + charstring = trim(adjustl(pl%info(i)%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], & + count=[NAMELEN,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid: pl") + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], & + count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rh_varid: pl") + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], & + count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid: pl") + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var Gmass_varid: pl") + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var radius_varid: pl") + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], & + count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Ip_varid: pl") + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i)*RAD2DEG, & + start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid: pl") + end if + end do + end if + + if (allocated(tp)) then + ntp = tp%nbody + ! This ensures that there first idslot will have the first body in it, not id 0 which is the default for a new + ! idvals array + if (.not.allocated(nc%idvals)) allocate(nc%idvals, source=tp%id) + do i = 1, ntp + call nc%find_idslot(tp%id(i), idslot) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[ idslot, stage, eslot]), & + "collision_io_netcdf_write_frame_snapshot nf90_put_var id_varid: tp" ) + charstring = trim(adjustl(tp%info(i)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot, stage, eslot], & + count=[NAMELEN,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var name_varid: tp" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], & + count=[NAMELEN,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid: tp" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1, idslot, stage, eslot], & + count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rh_varid: tp" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1, idslot, stage, eslot], & + count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid: tp" ) + end do + end if end do end select end select if (param%lenergy) then - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, collider%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, collider%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, collider%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%be_varid, collider%be(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%te_varid, collider%te(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid tefore" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_orbit_varid, collider%L_orbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orbit_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_spin_varid, collider%L_spin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, collider%ke_orbit(:), start=[ 1, eslot], & + count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, collider%ke_spin(:), start=[ 1, eslot], & + count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, collider%pe(:), start=[ 1, eslot], & + count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%be_varid, collider%be(:), start=[ 1, eslot], & + count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%te_varid, collider%te(:), start=[ 1, eslot], & + count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid tefore" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orbit_varid, collider%L_orbit(:,:), start=[1, 1, eslot], & + count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orbit_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_spin_varid, collider%L_spin(:,:), start=[1, 1, eslot], & + count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_spin_varid before" ) end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, tmp) ) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index a3daf7122..895fe1f54 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -11,19 +11,19 @@ use swiftest contains - module subroutine collision_resolve_consolidate_impactors(self, nbody_system, param, idx_parent, lflag) !! author: David A. Minton !! - !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%id members, - !! and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the collisional outcome. + !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%id + !! members, and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the + !! collisional outcome. implicit none ! Arguments - class(collision_impactors), intent(out) :: self !! Collision impactors object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions - integer(I4B), dimension(:), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical, intent(out) :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not + class(collision_impactors),intent(out) :: self !! Collision impactors object + class(base_nbody_system),intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions + integer(I4B), dimension(:), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical, intent(out) :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not ! Internals type collidx_array integer(I4B), dimension(:), allocatable :: id @@ -45,7 +45,8 @@ module subroutine collision_resolve_consolidate_impactors(self, nbody_system, pa ! If all of these bodies share a parent, but this is still a unique collision, move the last child ! out of the parent's position and make it the secondary body if (idx_parent(1) == idx_parent(2)) then - if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) + if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring + ! of the kinship relationships, though it should be rare) lflag = .false. call pl%reset_kinship([idx_parent(1)]) return @@ -220,7 +221,7 @@ module subroutine collision_resolve_extract_plpl(self, nbody_system, param) unique_parent_idx = pack(collision_idx(:), lplpl_unique_parent(:)) ! Scrub all pl-pl collisions involving unique pairs of parents, which will remove all duplicates and leave behind - ! all pairs that have themselves as parents but are not part of the unique parent list. This can hapepn in rare cases + ! all pairs that have themselves as parents but are not part of the unique parent list. This can happen in rare cases ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single ! step lplpl_unique_parent(:) = .true. @@ -233,15 +234,16 @@ module subroutine collision_resolve_extract_plpl(self, nbody_system, param) end associate end do - ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique pairs that don't - ! contain a parent body on the unique parent list. + ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique + ! pairs that don't contain a parent body on the unique parent list. ncollisions = nunique_parent + count(lplpl_unique_parent) collision_idx = [unique_parent_idx(:), pack(collision_idx(:), lplpl_unique_parent(:))] ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them lplpl_collision(:) = .false. lplpl_collision(collision_idx(:)) = .true. - call self%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + ! Extract any encounters that are not collisions from the list. + call self%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) end associate end select end select @@ -255,6 +257,39 @@ module subroutine collision_resolve_extract_pltp(self, nbody_system, param) class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + logical, dimension(:), allocatable :: lpltp_collision + integer(I8B) :: ncollisions, index_coll, k, npltpenc + integer(I8B), dimension(:), allocatable :: collision_idx + + select type(nbody_system) + class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) + select type (tp => nbody_system%tp) + class is (swiftest_tp) + associate(idx1 => self%index1, idx2 => self%index2) + npltpenc = self%nenc + allocate(lpltp_collision(npltpenc)) + lpltp_collision(:) = self%status(1_I8B:npltpenc) == COLLIDED + if (.not.any(lpltp_collision)) return + ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. + + ! Get the subset of pl-tp encounters that lead to a collision + ncollisions = count(lpltp_collision(:)) + allocate(collision_idx(ncollisions)) + collision_idx = pack([(k, k=1_I8B, npltpenc)], lpltp_collision) + + ! Create a mask that contains only the pl-tp encounters that did not result in a collision, and then discard them + lpltp_collision(:) = .false. + lpltp_collision(collision_idx(:)) = .true. + ! Extract any encounters that are not collisions from the list. + call self%spill(nbody_system%pltp_collision, lpltp_collision, ldestructive=.true.) + end associate + end select + end select + end select + return end subroutine collision_resolve_extract_pltp @@ -351,8 +386,9 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, & - collider => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) + associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, & + pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, collider => nbody_system%collider, & + impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) ! Add the impactors%id bodies to the subtraction list nimpactors = impactors%ncoll @@ -496,7 +532,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) allocate(plsub, mold=pl) call pl%spill(plsub, lmask, ldestructive=.false.) - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) + ! call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) ! Save the before/after snapshots select type(before => collider%before) @@ -551,7 +587,8 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) class is (swiftest_parameters) associate(plpl_collision => nbody_system%plpl_collision, & collision_history => nbody_system%collision_history, pl => nbody_system%pl, cb => nbody_system%cb, & - collider => nbody_system%collider, fragments => nbody_system%collider%fragments, impactors => nbody_system%collider%impactors) + collider => nbody_system%collider, fragments => nbody_system%collider%fragments, & + impactors => nbody_system%collider%impactors) if (plpl_collision%nenc == 0) return ! No collisions to resolve @@ -571,11 +608,13 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) ncollisions = plpl_collision%nenc write(timestr,*) t call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT,& + "***********************************************************" // & "***********************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between massive bodies detected at time t = " // & trim(adjustl(timestr))) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "***********************************************************" // & "***********************************************************") do k = 1_I8B, ncollisions @@ -608,16 +647,18 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) ! Destroy the collision list now that the collisions are resolved call plpl_collision%setup(0_I8B) - if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit + if ((nbody_system%pl_adds%nbody == 0) .and. (.not.any(pl%ldiscard(:)))) exit if (allocated(idnew)) deallocate(idnew) nnew = nbody_system%pl_adds%nbody allocate(idnew, source=nbody_system%pl_adds%id) mnew = sum(nbody_system%pl_adds%mass(:)) - ! Rearrange the arrays: Remove discarded bodies, add any new bodies, re-sort, and recompute all indices and encounter lists + ! Rearrange the arrays: Remove discarded bodies, add any new bodies, re-sort, and recompute all indices and + ! encounter lists call pl%rearray(nbody_system, param) - ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected + ! Destroy the add/discard list so that we don't append the same body multiple times if another collision + ! is detected call nbody_system%pl_discards%setup(0, param) call nbody_system%pl_adds%setup(0, param) @@ -641,13 +682,17 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) end if - ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision + ! Check whether or not any of the particles that were just added are themselves in a collision state. This will + ! generate a new plpl_collision call self%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit if (loop == MAXCASCADE) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT,"A runaway collisional cascade has been detected in collision_resolve_plpl.") - call swiftest_io_log_one_message(COLLISION_LOG_OUT,"Consider reducing the step size or changing the parameters in the collisional model to reduce the number of fragments.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT,"A runaway collisional cascade has been detected in " // & + "collision_resolve_plpl.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT,"Consider reducing the step size or changing the " // & + "parameters in the collisional model to reduce the " // & + "number of fragments.") call base_util_exit(FAILURE,unit=param%display_unit) end if end associate @@ -675,19 +720,92 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) real(DP), intent(in) :: t !! Current simulation tim real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level + ! Internals + class(swiftest_pl), allocatable :: plsub + class(swiftest_tp), allocatable :: tpsub + logical :: lpltp_collision + character(len=STRMAX) :: timestr, idstr + integer(I4B) :: i, j, nnew, loop + integer(I8B) :: k, ncollisions + integer(I4B), dimension(:), allocatable :: idnew + logical, dimension(:), allocatable :: lmask ! Make sure coordinate systems are all synced up due to being inside the recursion at this point select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - call nbody_system%pl%vb2vh(nbody_system%cb) - call nbody_system%tp%vb2vh(nbody_system%cb%vb) - call nbody_system%pl%b2h(nbody_system%cb) - call nbody_system%tp%b2h(nbody_system%cb) + associate(pltp_collision => nbody_system%pltp_collision, & + collision_history => nbody_system%collision_history, pl => nbody_system%pl, cb => nbody_system%cb, & + tp => nbody_system%tp, collider => nbody_system%collider, impactors => nbody_system%collider%impactors) + call pl%vb2vh(nbody_system%cb) + call tp%vb2vh(nbody_system%cb%vb) + call pl%b2h(nbody_system%cb) + call tp%b2h(nbody_system%cb) + + ! Restructure the massive bodies based on the outcome of the collision + call tp%rearray(nbody_system, param) + + ! Check for discards + call nbody_system%tp%discard(nbody_system, param) + + associate(idx1 => pltp_collision%index1, idx2 => pltp_collision%index2) + ncollisions = pltp_collision%nenc + write(timestr,*) t + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT,"***********************************************************" // & + "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between test particle and massive body detected " // & + "at time t = " // trim(adjustl(timestr))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT,"***********************************************************" // & + "***********************************************************") + + do k = 1_I8B, ncollisions + ! Advance the collision id number and save it + collider%maxid_collision = max(collider%maxid_collision, maxval(nbody_system%pl%info(:)%collision_id)) + collider%maxid_collision = collider%maxid_collision + 1 + collider%collision_id = collider%maxid_collision + write(idstr,*) collider%collision_id + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "collision_id " // trim(adjustl(idstr))) + collider%impactors%regime = COLLRESOLVE_REGIME_MERGE + allocate(lmask, mold=pl%lmask) + lmask(:) = .false. + lmask(idx1(k)) = .true. + + allocate(plsub, mold=pl) + call pl%spill(plsub, lmask, ldestructive=.false.) + + ! Save the before snapshots + select type(before => collider%before) + class is (swiftest_nbody_system) + call move_alloc(plsub, before%pl) + end select + + deallocate(lmask) + allocate(lmask, mold=tp%lmask) + lmask(:) = .false. + lmask(idx2(k)) = .true. + + allocate(tpsub, mold=tp) + call tp%spill(tpsub, lmask, ldestructive=.false.) + + ! Save the before snapshots + select type(before => collider%before) + class is (swiftest_nbody_system) + call move_alloc(tpsub, before%tp) + end select + + call collision_history%take_snapshot(param,nbody_system, t, "particle") + + call impactors%dealloc() + end do - ! Discard the collider - call nbody_system%tp%discard(nbody_system, param) + ! Destroy the collision list now that the collisions are resolved + call pltp_collision%setup(0_I8B) + + end associate + + end associate end select end select diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 9ce2be434..49c3e1814 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -285,6 +285,7 @@ module subroutine collision_util_dealloc_snapshot(self) return end subroutine collision_util_dealloc_snapshot + module subroutine collision_util_dealloc_impactors(self) !! author: David A. Minton !! @@ -419,7 +420,8 @@ end subroutine collision_util_dealloc_basic module subroutine collision_util_reset_fragments(self) !! author: David A. Minton !! - !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, + !! radius, or other values that get set prior to the call to fraggle_generate) implicit none ! Arguments class(collision_fragments), intent(inout) :: self @@ -756,8 +758,8 @@ end subroutine collision_util_shift_vector_to_origin module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) !! author: David A. Minton !! - !! Takes a minimal snapshot of the state of the nbody_system during an encounter so that the trajectories - !! can be played back through the encounter + !! Takes a minimal snapshot of the state of the nbody_system during a collision to record the before and after states of the + !! system through the collision. implicit none ! Internals class(collision_storage), intent(inout) :: self !! Swiftest storage object @@ -791,63 +793,70 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) snapshot%t = t case ("after") phase_val = 2 + case ("particle") + phase_val = -1 + allocate(collision_snapshot :: snapshot) + allocate(snapshot%collider, source=nbody_system%collider) case default - write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" + write(*,*) "collision_util_snapshot requies either 'before', 'after', or 'particle' passed to 'arg'" return end select - ! Get and record the energy of the system before the collision - call nbody_system%get_energy_and_momentum(param) - snapshot%collider%L_orbit(:,phase_val) = nbody_system%L_orbit(:) - snapshot%collider%L_spin(:,phase_val) = nbody_system%L_spin(:) - snapshot%collider%L_total(:,phase_val) = nbody_system%L_total(:) - snapshot%collider%ke_orbit(phase_val) = nbody_system%ke_orbit - snapshot%collider%ke_spin(phase_val) = nbody_system%ke_spin - snapshot%collider%pe(phase_val) = nbody_system%pe - snapshot%collider%be(phase_val) = nbody_system%be - snapshot%collider%te(phase_val) = nbody_system%te - - if (stage == "after") then - select type(before_snap => snapshot%collider%before ) - class is (swiftest_nbody_system) - select type(before_orig => nbody_system%collider%before) + if (stage /= "particle" ) then + ! Get and record the energy of the system before the collision + call nbody_system%get_energy_and_momentum(param) + snapshot%collider%L_orbit(:,phase_val) = nbody_system%L_orbit(:) + snapshot%collider%L_spin(:,phase_val) = nbody_system%L_spin(:) + snapshot%collider%L_total(:,phase_val) = nbody_system%L_total(:) + snapshot%collider%ke_orbit(phase_val) = nbody_system%ke_orbit + snapshot%collider%ke_spin(phase_val) = nbody_system%ke_spin + snapshot%collider%pe(phase_val) = nbody_system%pe + snapshot%collider%be(phase_val) = nbody_system%be + snapshot%collider%te(phase_val) = nbody_system%te + + if (stage == "after") then + select type(before_snap => snapshot%collider%before ) + class is (swiftest_nbody_system) + select type(before_orig => nbody_system%collider%before) + class is (swiftest_nbody_system) + select type(plsub => before_orig%pl) + class is (swiftest_pl) + ! Log the properties of the old and new bodies + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Removing bodies:") + do i = 1, plsub%nbody + write(message,*) trim(adjustl(plsub%info(i)%name)), " (", trim(adjustl(plsub%info(i)%particle_type)),")" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + end do + + allocate(before_snap%pl, source=plsub) + end select + deallocate(before_orig%pl) + end select + end select + + select type(after_snap => snapshot%collider%after ) + class is (swiftest_nbody_system) + select type(after_orig => nbody_system%collider%after) class is (swiftest_nbody_system) - select type(plsub => before_orig%pl) - class is (swiftest_pl) - ! Log the properties of the old and new bodies - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Removing bodies:") - do i = 1, plsub%nbody - write(message,*) trim(adjustl(plsub%info(i)%name)), " (", trim(adjustl(plsub%info(i)%particle_type)),")" - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - end do - - allocate(before_snap%pl, source=plsub) + select type(plnew => after_orig%pl) + class is (swiftest_pl) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Adding bodies:") + do i = 1, plnew%nbody + write(message,*) trim(adjustl(plnew%info(i)%name)), " (", trim(adjustl(plnew%info(i)%particle_type)),")" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + end do + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "***********************************************************" // & + "***********************************************************") + allocate(after_snap%pl, source=plnew) + end select + deallocate(after_orig%pl) end select - deallocate(before_orig%pl) - end select - end select - - - select type(after_snap => snapshot%collider%after ) - class is (swiftest_nbody_system) - select type(after_orig => nbody_system%collider%after) - class is (swiftest_nbody_system) - select type(plnew => after_orig%pl) - class is (swiftest_pl) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Adding bodies:") - do i = 1, plnew%nbody - write(message,*) trim(adjustl(plnew%info(i)%name)), " (", trim(adjustl(plnew%info(i)%particle_type)),")" - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - end do - call swiftest_io_log_one_message(COLLISION_LOG_OUT, & - "***********************************************************" // & - "***********************************************************") - allocate(after_snap%pl, source=plnew) end select - deallocate(after_orig%pl) - end select - end select + end if + end if + if ((stage == "after") .or. (stage == "particle")) then ! Save the snapshot for posterity call self%save(snapshot) deallocate(snapshot) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index a00313abb..0e0914012 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -884,6 +884,7 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu L_mag_factor = .mag.(collider%L_total(:,1) + collider%L_total(:,2)) L_residual(:) = (collider%L_total(:,2) / L_mag_factor - collider%L_total(:,1)) / L_mag_factor call collision_util_velocity_torque(-L_residual(:) * L_mag_factor, collider%fragments%mtot, impactors%rbcom, impactors%vbcom) + nfrag = collider%fragments%nbody #ifdef DOCONLOC do concurrent(i = 1:nfrag) shared(collider, impactors) diff --git a/src/globals/globals_module.f90 b/src/globals/globals_module.f90 index ec79028be..c17d6a2eb 100644 --- a/src/globals/globals_module.f90 +++ b/src/globals/globals_module.f90 @@ -48,7 +48,7 @@ module globals integer(I4B), parameter :: UPPERCASE_OFFSET = iachar('A') - iachar('a') !! ASCII character set parameter for lower to upper !! conversion - offset between upper and lower - character(*), parameter :: VERSION = "2023.12.2" !! Swiftest version + character(*), parameter :: VERSION = "2024.2.0" !! Swiftest version !> Symbolic name for integrator types character(*), parameter :: UNKNOWN_INTEGRATOR = "UKNOWN INTEGRATOR" diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index 0552d9168..7b7adee40 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -30,8 +30,8 @@ module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%accel_int(param) - if (param%loblatecb) then - call pl%accel_obl(nbody_system) + if (param%lnon_spherical_cb) then + call pl%accel_non_spherical_cb(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -74,12 +74,14 @@ module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, npl => nbody_system%pl%nbody) nbody_system%lbeg = lbeg - if (nbody_system%lbeg) then - call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) - else - call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) + if (npl > 0) then + if (nbody_system%lbeg) then + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) + else + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) + end if end if - if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lnon_spherical_cb) call tp%accel_non_spherical_cb(nbody_system) if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 index 52b588148..c528d7669 100644 --- a/src/helio/helio_util.f90 +++ b/src/helio/helio_util.f90 @@ -28,6 +28,7 @@ module subroutine helio_util_setup_initialize_system(self, system_history, param call self%tp%h2b(self%cb) ! Make sure that the discard list gets allocated initially + call self%pl_discards%setup(0, param) call self%tp_discards%setup(0, param) call self%pl%set_mu(self%cb) call self%tp%set_mu(self%cb) diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 index 0fa517986..2c072186f 100644 --- a/src/netcdf_io/netcdf_io_module.f90 +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -11,181 +11,346 @@ module netcdf_io !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. - !! use globals use base implicit none public - !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in base + !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as + !! the base class defined in base type, abstract :: netcdf_parameters - character(STRMAX) :: file_name !! Name of the output file - logical :: lfile_is_open = .false. !! Flag indicating that the linked file is currently open - integer(I4B) :: out_type !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) - integer(I4B) :: id !! ID for the output file - integer(I4B) :: tslot = 1 !! The current time slot that gets passed to the NetCDF reader/writer - integer(I4B) :: max_tslot = 0 !! Records the last index value of time in the NetCDF file - integer(I4B), dimension(:), allocatable :: idvals !! Array of id values in this NetCDF file - integer(I4B) :: idslot = 1 !! The current id slot that gets passed to the NetCDF reader/writer - integer(I4B) :: max_idslot = 0 !! Records the last index value of id in the NetCDF file + character(STRMAX) :: file_name + !! Name of the output file + logical :: lfile_is_open = .false. + !! Flag indicating that the linked file is currently open + integer(I4B) :: out_type + !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) + integer(I4B) :: id + !! ID for the output file + integer(I4B) :: tslot = 1 + !! The current time slot that gets passed to the NetCDF reader/writer + integer(I4B) :: max_tslot = 0 + !! Records the last index value of time in the NetCDF file + integer(I4B), dimension(:), allocatable :: idvals + !! Array of id values in this NetCDF file + integer(I4B) :: idslot = 1 + !! The current id slot that gets passed to the NetCDF reader/writer + integer(I4B) :: max_idslot = 0 + !! Records the last index value of id in the NetCDF file ! Dimension ids and variable names - character(NAMELEN) :: str_dimname = "string32" !! name of the character string dimension - integer(I4B) :: str_dimid !! ID for the character string dimension - character(NAMELEN) :: time_dimname = "time" !! name of the time dimension - integer(I4B) :: time_dimid !! ID for the time dimension - integer(I4B) :: time_varid !! ID for the time variable - character(NAMELEN) :: name_dimname = "name" !! name of the particle name dimension - integer(I4B) :: name_dimid !! ID for the particle name dimension - integer(I4B) :: name_varid !! ID for the particle name variable - character(NAMELEN) :: space_dimname = "space" !! name of the space dimension - integer(I4B) :: space_dimid !! ID for the space dimension - integer(I4B) :: space_varid !! ID for the space variable - character(len=1), dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels + character(NAMELEN) :: str_dimname = "string32" + !! name of the character string dimension + integer(I4B) :: str_dimid + !! ID for the character string dimension + character(NAMELEN) :: time_dimname = "time" + !! name of the time dimension + integer(I4B) :: time_dimid + !! ID for the time dimension + integer(I4B) :: time_varid + !! ID for the time variable + character(NAMELEN) :: name_dimname = "name" + !! name of the particle name dimension + integer(I4B) :: name_dimid + !! ID for the particle name dimension + integer(I4B) :: name_varid + !! ID for the particle name variable + character(NAMELEN) :: space_dimname = "space" + !! name of the space dimension + integer(I4B) :: space_dimid + !! ID for the space dimension + integer(I4B) :: space_varid + !! ID for the space variable + character(len=1), dimension(3) :: space_coords = ["x","y","z"] + !! The space dimension coordinate labels + character(NAMELEN) :: sign_dimname = "sign" + !! name of the sign dimension for c_lm + integer(I4B) :: sign_dimid + !! ID for sign dimension + integer(I4B) :: sign_varid + !! ID for sign variable + character(NAMELEN) :: l_dimname = "l" + !! name of l dimension for c_lm + integer(I4B) :: l_dimid + !! ID for the l dimension for c_lm + integer(I4B) :: l_varid + !! ID for the l variable + character(NAMELEN) :: m_dimname = "m" + !! name of m dimension for c_lm + integer(I4B) :: m_dimid + !! ID for the m dimension for c_lm + integer(I4B) :: m_varid + !! ID for the m variable + ! Non-dimension ids and variable names - character(NAMELEN) :: id_varname = "id" !! name of the particle id variable - integer(I4B) :: id_varid !! ID for the id variable - character(NAMELEN) :: status_varname = "status" !! name of the particle status variable - integer(I4B) :: status_varid !! ID for the status variable - character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable - integer(I4B) :: ptype_varid !! ID for the particle type variable - character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable - integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable - character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable - integer(I4B) :: ntp_varid !! ID for the number of active test particles variable - character(NAMELEN) :: nplm_varname = "nplm" !! name of the number of active fully interacting massive bodies variable (SyMBA) - integer(I4B) :: nplm_varid !! ID for the number of active fully interacting massive bodies variable (SyMBA) - character(NAMELEN) :: a_varname = "a" !! name of the semimajor axis variable - integer(I4B) :: a_varid !! ID for the semimajor axis variable - character(NAMELEN) :: e_varname = "e" !! name of the eccentricity variable - integer(I4B) :: e_varid !! ID for the eccentricity variable - character(NAMELEN) :: inc_varname = "inc" !! name of the inclination variable - integer(I4B) :: inc_varid !! ID for the inclination variable - character(NAMELEN) :: capom_varname = "capom" !! name of the long. asc. node variable - integer(I4B) :: capom_varid !! ID for the long. asc. node variable - character(NAMELEN) :: omega_varname = "omega" !! name of the arg. of periapsis variable - integer(I4B) :: omega_varid !! ID for the arg. of periapsis variable - character(NAMELEN) :: capm_varname = "capm" !! name of the mean anomaly variable - integer(I4B) :: capm_varid !! ID for the mean anomaly variable - character(NAMELEN) :: varpi_varname = "varpi" !! name of the long. of periapsis variable - integer(I4B) :: varpi_varid !! ID for the long. of periapsis variable - character(NAMELEN) :: lam_varname = "lam" !! name of the mean longitude variable - integer(I4B) :: lam_varid !! ID for the mean longitude variable - character(NAMELEN) :: f_varname = "f" !! name of the true anomaly variable - integer(I4B) :: f_varid !! ID for the true anomaly variable - character(NAMELEN) :: cape_varname = "cape" !! name of the eccentric anomaly variable - integer(I4B) :: cape_varid !! ID for the eccentric anomaly variable - character(NAMELEN) :: rh_varname = "rh" !! name of the heliocentric position vector variable - integer(I4B) :: rh_varid !! ID for the heliocentric position vector variable - character(NAMELEN) :: vh_varname = "vh" !! name of the heliocentric velocity vector variable - integer(I4B) :: vh_varid !! ID for the heliocentric velocity vector variable - character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" !! name of the heliocentric pseudovelocity vector variable (used in GR only) - integer(I4B) :: gr_pseudo_vh_varid !! ID for the heliocentric pseudovelocity vector variable (used in GR) - character(NAMELEN) :: Gmass_varname = "Gmass" !! name of the G*mass variable - integer(I4B) :: Gmass_varid !! ID for the G*mass variable - character(NAMELEN) :: mass_varname = "mass" !! name of the mass variable - integer(I4B) :: mass_varid !! ID for the mass variable - character(NAMELEN) :: rhill_varname = "rhill" !! name of the hill radius variable - integer(I4B) :: rhill_varid !! ID for the hill radius variable - character(NAMELEN) :: radius_varname = "radius" !! name of the radius variable - integer(I4B) :: radius_varid !! ID for the radius variable - character(NAMELEN) :: Ip_varname = "Ip" !! name of the principal moment of inertial variable - integer(I4B) :: Ip_varid !! ID for the axis principal moment of inertia variable - character(NAMELEN) :: rot_varname = "rot" !! name of the rotation vector variable - integer(I4B) :: rot_varid !! ID for the rotation vector variable - character(NAMELEN) :: j2rp2_varname = "j2rp2" !! name of the j2rp2 variable - integer(I4B) :: j2rp2_varid !! ID for the j2 variable - character(NAMELEN) :: j4rp4_varname = "j4rp4" !! name of the j4pr4 variable - integer(I4B) :: j4rp4_varid !! ID for the j4 variable - character(NAMELEN) :: k2_varname = "k2" !! name of the Love number variable - integer(I4B) :: k2_varid !! ID for the Love number variable - character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable - integer(I4B) :: Q_varid !! ID for the energy dissipation variable - character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable - integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable - character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable - integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable - character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable - integer(I4B) :: PE_varid !! ID for the system potential energy variable - character(NAMELEN) :: be_varname = "BE" !! name of the system binding energy variable - integer(I4B) :: BE_varid !! ID for the system binding energy variable - character(NAMELEN) :: te_varname = "TE" !! name of the system binding energy variable - integer(I4B) :: TE_varid !! ID for the system binding energy variable - character(NAMELEN) :: L_orbit_varname = "L_orbit" !! name of the orbital angular momentum vector variable - integer(I4B) :: L_orbit_varid !! ID for the system orbital angular momentum vector variable - character(NAMELEN) :: L_spin_varname = "L_spin" !! name of the spin angular momentum vector variable - integer(I4B) :: L_spin_varid !! ID for the system spin angular momentum vector variable - character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable - integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable - character(NAMELEN) :: E_collisions_varname = "E_collisions" !! name of the escaped angular momentum y variable - integer(I4B) :: E_collisions_varid !! ID for the energy lost in collisions variable - character(NAMELEN) :: E_untracked_varname = "E_untracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - integer(I4B) :: E_untracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system - integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system - character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) - integer(I4B) :: origin_type_varid !! ID for the origin type - character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable - integer(I4B) :: origin_time_varid !! ID for the origin time - character(NAMELEN) :: collision_id_varname = "collision_id" !! name of the collision id variable - integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID - character(NAMELEN) :: origin_rh_varname = "origin_rh" !! name of the heliocentric position vector of the body at the time of origin variable - integer(I4B) :: origin_rh_varid !! ID for the origin position vector variable - character(NAMELEN) :: origin_vh_varname = "origin_vh" !! name of the heliocentric velocity vector of the body at the time of origin variable - integer(I4B) :: origin_vh_varid !! ID for the origin velocity vector component - character(NAMELEN) :: discard_time_varname = "discard_time" !! name of the time of discard variable - integer(I4B) :: discard_time_varid !! ID for the time of discard variable - character(NAMELEN) :: discard_rh_varname = "discard_rh" !! name of the heliocentric position vector of the body at the time of discard variable - integer(I4B) :: discard_rh_varid !! ID for the heliocentric position vector of the body at the time of discard variable - character(NAMELEN) :: discard_vh_varname = "discard_vh" !! name of the heliocentric velocity vector of the body at the time of discard variable - integer(I4B) :: discard_vh_varid !! ID for the heliocentric velocity vector of the body at the time of discard variable - character(NAMELEN) :: discard_body_id_varname = "discard_body_id" !! name of the id of the other body involved in the discard - integer(I4B) :: discard_body_id_varid !! ID for the id of the other body involved in the discard - logical :: lpseudo_vel_exists = .false. !! Logical flag to indicate whether or not the pseudovelocity vectors were present in an old file. + character(NAMELEN) :: id_varname = "id" + !! name of the particle id variable + integer(I4B) :: id_varid + !! ID for the id variable + character(NAMELEN) :: status_varname = "status" + !! name of the particle status variable + integer(I4B) :: status_varid + !! ID for the status variable + character(NAMELEN) :: ptype_varname = "particle_type" + !! name of the particle type variable + integer(I4B) :: ptype_varid + !! ID for the particle type variable + character(NAMELEN) :: npl_varname = "npl" + !! name of the number of active massive bodies variable + integer(I4B) :: npl_varid + !! ID for the number of active massive bodies variable + character(NAMELEN) :: ntp_varname = "ntp" + !! name of the number of active test particles variable + integer(I4B) :: ntp_varid + !! ID for the number of active test particles variable + character(NAMELEN) :: nplm_varname = "nplm" + !! name of the number of active fully interacting massive bodies variable (SyMBA) + integer(I4B) :: nplm_varid + !! ID for the number of active fully interacting massive bodies variable (SyMBA) + character(NAMELEN) :: a_varname = "a" + !! name of the semimajor axis variable + integer(I4B) :: a_varid + !! ID for the semimajor axis variable + character(NAMELEN) :: e_varname = "e" + !! name of the eccentricity variable + integer(I4B) :: e_varid + !! ID for the eccentricity variable + character(NAMELEN) :: inc_varname = "inc" + !! name of the inclination variable + integer(I4B) :: inc_varid + !! ID for the inclination variable + character(NAMELEN) :: capom_varname = "capom" + !! name of the long. asc. node variable + integer(I4B) :: capom_varid + !! ID for the long. asc. node variable + character(NAMELEN) :: omega_varname = "omega" + !! name of the arg. of periapsis variable + integer(I4B) :: omega_varid + !! ID for the arg. of periapsis variable + character(NAMELEN) :: capm_varname = "capm" + !! name of the mean anomaly variable + integer(I4B) :: capm_varid + !! ID for the mean anomaly variable + character(NAMELEN) :: varpi_varname = "varpi" + !! name of the long. of periapsis variable + integer(I4B) :: varpi_varid + !! ID for the long. of periapsis variable + character(NAMELEN) :: lam_varname = "lam" + !! name of the mean longitude variable + integer(I4B) :: lam_varid + !! ID for the mean longitude variable + character(NAMELEN) :: f_varname = "f" + !! name of the true anomaly variable + integer(I4B) :: f_varid + !! ID for the true anomaly variable + character(NAMELEN) :: cape_varname = "cape" + !! name of the eccentric anomaly variable + integer(I4B) :: cape_varid + !! ID for the eccentric anomaly variable + character(NAMELEN) :: rh_varname = "rh" + !! name of the heliocentric position vector variable + integer(I4B) :: rh_varid + !! ID for the heliocentric position vector variable + character(NAMELEN) :: vh_varname = "vh" + !! name of the heliocentric velocity vector variable + integer(I4B) :: vh_varid + !! ID for the heliocentric velocity vector variable + character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" + !! name of the heliocentric pseudovelocity vector variable (GR) + integer(I4B) :: gr_pseudo_vh_varid + !! ID for the heliocentric pseudovelocity vector variable (used in GR) + character(NAMELEN) :: Gmass_varname = "Gmass" + !! name of the G*mass variable + integer(I4B) :: Gmass_varid + !! ID for the G*mass variable + character(NAMELEN) :: mass_varname = "mass" + !! name of the mass variable + integer(I4B) :: mass_varid + !! ID for the mass variable + character(NAMELEN) :: rhill_varname = "rhill" + !! name of the hill radius variable + integer(I4B) :: rhill_varid + !! ID for the hill radius variable + character(NAMELEN) :: radius_varname = "radius" + !! name of the radius variable + integer(I4B) :: radius_varid + !! ID for the radius variable + character(NAMELEN) :: Ip_varname = "Ip" + !! name of the principal moment of inertial variable + integer(I4B) :: Ip_varid + !! ID for the axis principal moment of inertia variable + character(NAMELEN) :: rot_varname = "rot" + !! name of the rotation vector variable + integer(I4B) :: rot_varid + !! ID for the rotation vector variable + character(NAMELEN) :: rotphase_varname = "rotphase" + !! name of the rotation phase variable + integer(I4B) :: rotphase_varid + !! ID for the rotation phase variable + character(NAMELEN) :: j2rp2_varname = "j2rp2" + !! name of the j2rp2 variable + integer(I4B) :: j2rp2_varid + !! ID for the j2 variable + character(NAMELEN) :: j4rp4_varname = "j4rp4" + !! name of the j4pr4 variable + integer(I4B) :: j4rp4_varid + !! ID for the j4 variable + character(NAMELEN) :: c_lm_varname = "c_lm" + !! name for the c_lm array + integer(I4B) :: c_lm_varid + !! ID for the c_lm aqrray + character(NAMELEN) :: k2_varname = "k2" + !! name of the Love number variable + integer(I4B) :: k2_varid + !! ID for the Love number variable + character(NAMELEN) :: q_varname = "Q" + !! name of the energy dissipation variable + integer(I4B) :: Q_varid + !! ID for the energy dissipation variable + character(NAMELEN) :: ke_orb_varname = "KE_orb" + !! name of the system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid + !! ID for the system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" + !! name of the system spin kinetic energy variable + integer(I4B) :: KE_spin_varid + !! ID for the system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" + !! name of the system potential energy variable + integer(I4B) :: PE_varid + !! ID for the system potential energy variable + character(NAMELEN) :: be_varname = "BE" + !! name of the system binding energy variable + integer(I4B) :: BE_varid + !! ID for the system binding energy variable + character(NAMELEN) :: te_varname = "TE" + !! name of the system binding energy variable + integer(I4B) :: TE_varid + !! ID for the system binding energy variable + character(NAMELEN) :: L_orbit_varname = "L_orbit" + !! name of the orbital angular momentum vector variable + integer(I4B) :: L_orbit_varid + !! ID for the system orbital angular momentum vector variable + character(NAMELEN) :: L_spin_varname = "L_spin" + !! name of the spin angular momentum vector variable + integer(I4B) :: L_spin_varid + !! ID for the system spin angular momentum vector variable + character(NAMELEN) :: L_escape_varname = "L_escape" + !! name of the escaped angular momentum vector variable + integer(I4B) :: L_escape_varid + !! ID for the escaped angular momentum vector variable + character(NAMELEN) :: E_collisions_varname = "E_collisions" + !! name of the escaped angular momentum y variable + integer(I4B) :: E_collisions_varid + !! ID for the energy lost in collisions variable + character(NAMELEN) :: E_untracked_varname = "E_untracked" + !! name of the energy that is untracked due to loss (due to mergers and body energy for escaped bodies) + integer(I4B) :: E_untracked_varid + !! ID for the energy that is untracked due to loss (due to mergers and body energy for escaped bodies) + character(NAMELEN) :: GMescape_varname = "GMescape" + !! name of the G*Mass of bodies that escape the system + integer(I4B) :: GMescape_varid + !! ID for the G*Mass of bodies that escape the system + character(NAMELEN) :: origin_type_varname = "origin_type" + !! name of the origin type variable + integer(I4B) :: origin_type_varid + !! ID for the origin type + character(NAMELEN) :: origin_time_varname = "origin_time" + !! name of the time of origin variable + integer(I4B) :: origin_time_varid + !! ID for the origin time + character(NAMELEN) :: collision_id_varname = "collision_id" + !! name of the collision id variable + integer(I4B) :: collision_id_varid + !! Netcdf ID for the origin collision ID + character(NAMELEN) :: origin_rh_varname = "origin_rh" + !! name of the heliocentric position vector of the body at the time of origin variable + integer(I4B) :: origin_rh_varid + !! ID for the origin position vector variable + character(NAMELEN) :: origin_vh_varname = "origin_vh" + !! name of the heliocentric velocity vector of the body at the time of origin variable + integer(I4B) :: origin_vh_varid + !! ID for the origin velocity vector component + character(NAMELEN) :: discard_time_varname = "discard_time" + !! name of the time of discard variable + integer(I4B) :: discard_time_varid + !! ID for the time of discard variable + character(NAMELEN) :: discard_rh_varname = "discard_rh" + !! name of the heliocentric position vector of the body at the time of discard variable + integer(I4B) :: discard_rh_varid + !! ID for the heliocentric position vector of the body at the time of discard variable + character(NAMELEN) :: discard_vh_varname = "discard_vh" + !! name of the heliocentric velocity vector of the body at the time of discard variable + integer(I4B) :: discard_vh_varid + !! ID for the heliocentric velocity vector of the body at the time of discard variable + character(NAMELEN) :: discard_body_id_varname = "discard_body_id" + !! name of the id of the other body involved in the discard + integer(I4B) :: discard_body_id_varid + !! ID for the id of the other body involved in the discard + logical :: lpseudo_vel_exists = .false. + !! Logical flag to indicate whether or not the pseudovelocity vectors were present in an old file. + logical :: lc_lm_exists = .false. + !! Logical flag to indicate whether or not the c_lm array was present in an old file. contains - procedure :: close => netcdf_io_close !! Closes an open NetCDF file - procedure :: find_tslot => netcdf_io_find_tslot !! Finds the time dimension index for a given value of t - procedure :: find_idslot => netcdf_io_find_idslot !! Finds the id dimension index for a given value of id - procedure :: get_idvals => netcdf_io_get_idvals !! Gets the valid id numbers currently stored in this dataset - procedure :: sync => netcdf_io_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + procedure :: close => netcdf_io_close + !! Closes an open NetCDF file + procedure :: find_tslot => netcdf_io_find_tslot + !! Finds the time dimension index for a given value of t + procedure :: find_idslot => netcdf_io_find_idslot + !! Finds the id dimension index for a given value of id + procedure :: get_idvals => netcdf_io_get_idvals + !! Gets the valid id numbers currently stored in this dataset + procedure :: sync => netcdf_io_sync + !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) end type netcdf_parameters interface module subroutine netcdf_io_check(status, call_identifier) implicit none - integer, intent (in) :: status !! The status code returned by a NetCDF function - character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes + integer, intent (in) :: status + !! The status code returned by a NetCDF function + character(len=*), intent(in), optional :: call_identifier + !! String that indicates which calling function caused the error for diagnostic purposes end subroutine netcdf_io_check module subroutine netcdf_io_close(self) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters),intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset end subroutine netcdf_io_close module subroutine netcdf_io_get_idvals(self) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset end subroutine netcdf_io_get_idvals module subroutine netcdf_io_find_tslot(self, t, tslot) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - real(DP), intent(in) :: t !! The value of time to search for - integer(I4B), intent(out) :: tslot !! The index of the time slot where this data belongs + class(netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset + real(DP),intent(in) :: t + !! The value of time to search for + integer(I4B), intent(out) :: tslot + !! The index of the time slot where this data belongs end subroutine netcdf_io_find_tslot module subroutine netcdf_io_find_idslot(self, id, idslot) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - integer(I4B), intent(in) :: id !! The value of id to search for - integer(I4B), intent(out) :: idslot !! The index of the id slot where this data belongs + class(netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset + integer(I4B), intent(in) :: id + !! The value of id to search for + integer(I4B), intent(out) :: idslot + !! The index of the id slot where this data belongs end subroutine netcdf_io_find_idslot module subroutine netcdf_io_sync(self) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset end subroutine netcdf_io_sync end interface diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 0b8b7d9ba..9d3e2ac1f 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -44,6 +44,7 @@ module subroutine rmvs_discard_tp(self, nbody_system, param) call swiftest_io_log_one_message(COLLISION_LOG_OUT,message) tp%ldiscard(i) = .true. tp%lmask(i) = .false. + pl%ldiscard(iplperP) = .true. call tp%info(i)%set_value(status="DISCARDED_PLQ", discard_time=t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(iplperP)) end if diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 3dfc5e4e8..b51b94737 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -52,7 +52,7 @@ module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) ! Temporarily turn off the heliocentric-dependent acceleration terms during an inner encounter using a copy of the parameter list with all of the heliocentric-specific acceleration terms turned off allocate(param_planetocen, source=param) - param_planetocen%loblatecb = .false. + param_planetocen%lnon_spherical_cb = .false. param_planetocen%lextra_force = .false. param_planetocen%lgr = .false. @@ -90,7 +90,7 @@ module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) cb%Gmass = tp%cb_heliocentric%Gmass ! If the heliocentric-specifc acceleration terms are requested, compute those now - if (param%loblatecb) call tp%accel_obl(system_planetocen) + if (param%lnon_spherical_cb) call tp%accel_non_spherical_cb(system_planetocen) if (param%lextra_force) call tp%accel_user(system_planetocen, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 8d89b76d4..757ceb418 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -202,9 +202,11 @@ subroutine rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) call tp%step(nbody_system, param, outer_time, dto) tp%lfirst = lfirsttp else - if (param%loblatecb) then - call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rbeg, pl%lmask, pl%outer(outer_index-1)%aobl, pl%Gmass, cb%aoblbeg) - call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rend, pl%lmask, pl%outer(outer_index)%aobl, pl%Gmass, cb%aoblend) + if (param%lnon_spherical_cb) then + call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rbeg, pl%lmask, pl%outer(outer_index-1)%aobl, cb%rot,& + pl%Gmass, cb%aoblbeg) + call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rend, pl%lmask, pl%outer(outer_index)%aobl, cb%rot, & + pl%Gmass, cb%aoblend) end if call tp%step(nbody_system, param, outer_time, dto) end if @@ -265,13 +267,14 @@ subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) xtmp(:, 1:npl) = pl%inner(0)%x(:, 1:npl) vtmp(:, 1:npl) = pl%inner(0)%v(:, 1:npl) - if ((param%loblatecb) .or. (param%ltides)) then + if ((param%lnon_spherical_cb) .or. (param%ltides)) then allocate(rh_original, source=pl%rh) allocate(ah_original, source=pl%ah) - pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the oblateness terms + pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the + ! oblateness terms end if - if (param%loblatecb) then - call pl%accel_obl(nbody_system) + if (param%lnon_spherical_cb) then + call pl%accel_non_spherical_cb(nbody_system) pl%inner(0)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep end if ! TODO: Implement tides @@ -325,9 +328,9 @@ subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) pl%inner(inner_index)%x(:, 1:npl) = pl%inner(inner_index)%x(:, 1:npl) + frac * xtmp(:, 1:npl) pl%inner(inner_index)%v(:, 1:npl) = pl%inner(inner_index)%v(:, 1:npl) + frac * vtmp(:, 1:npl) - if (param%loblatecb) then + if (param%lnon_spherical_cb) then pl%rh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) - call pl%accel_obl(nbody_system) + call pl%accel_non_spherical_cb(nbody_system) pl%inner(inner_index)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides @@ -336,10 +339,10 @@ subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) ! pl%inner(inner_index)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if end do - if (param%loblatecb) then + if (param%lnon_spherical_cb) then ! Calculate the final value of oblateness accelerations at the final inner substep pl%rh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) - call pl%accel_obl(nbody_system) + call pl%accel_non_spherical_cb(nbody_system) pl%inner(NTPHENC)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides @@ -396,12 +399,13 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) call rmvs_peri_tp(tpenci, pl, inner_time, dti, .true., 0, i, param) ! now step the encountering test particles fully through the inner encounter lfirsttp = .true. - do inner_index = 1, NTPHENC ! Integrate over the encounter region, using the "substitute" planetocentric systems at each level + do inner_index = 1, NTPHENC ! Integrate over the encounter region, using the "substitute" planetocentric + ! systems at each level plenci%rh(:, 1:npl) = plenci%inner(inner_index - 1)%x(:, 1:npl) call plenci%set_beg_end(rbeg = plenci%inner(inner_index - 1)%x, & rend = plenci%inner(inner_index)%x) - if (param%loblatecb) then + if (param%lnon_spherical_cb) then cbenci%aoblbeg = cbenci%inner(inner_index - 1)%aobl(:, 1) cbenci%aoblend = cbenci%inner(inner_index )%aobl(:, 1) end if @@ -491,7 +495,7 @@ subroutine rmvs_make_planetocentric(param, cb, pl, tp) plenci%inner(inner_index)%x(:,1) = -cbenci%inner(inner_index)%x(:,1) plenci%inner(inner_index)%v(:,1) = -cbenci%inner(inner_index)%v(:,1) - if (param%loblatecb) then + if (param%lnon_spherical_cb) then allocate(plenci%inner(inner_index)%aobl, mold=pl%inner(inner_index)%aobl) allocate(cbenci%inner(inner_index)%aobl(NDIM,1)) cbenci%inner(inner_index)%aobl(:,1) = pl%inner(inner_index)%aobl(:, i) diff --git a/src/shgrav/shgrav_accel.f90 b/src/shgrav/shgrav_accel.f90 new file mode 100644 index 000000000..4dc29bbcb --- /dev/null +++ b/src/shgrav/shgrav_accel.f90 @@ -0,0 +1,176 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest 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 Swiftest. +!! If not, see: https://www.gnu.org/licenses. + + +!! Swiftest submodule to calculate higher order terms for gravitational acceleration given spherical harmonic coefficients (c_lm) + +submodule (shgrav) s_shgrav_accel +use swiftest +use SHTOOLS + +contains + + subroutine shgrav_g_acc_one(GMcb, r_0, phi_cb, rh, c_lm, g_sph, GMpl, aoblcb) + !! author: Kaustub P. Anand + !! + !! Calculate the acceleration terms for one pair of bodies given c_lm, theta, phi, r + implicit none + ! Arguments + real(DP), intent(in) :: GMcb + !! GMass of the central body + real(DP), intent(in) :: r_0 + !! radius of the central body + real(DP), intent(in) :: phi_cb + !! rotation phase angle of the central body + real(DP), intent(in), dimension(:) :: rh + !! distance vector of body + real(DP), intent(in), dimension(:, :, :) :: c_lm + !! Spherical Harmonic coefficients + real(DP), intent(out), dimension(NDIM) :: g_sph + !! acceleration vector + real(DP), intent(in), optional :: GMpl + !! Mass of input body if it is not a test particle + real(DP), dimension(:), intent(inout), optional :: aoblcb + !! Barycentric acceleration of central body (only for massive input bodies) + + ! Internals + integer :: l, m + !! SPH coefficients + integer :: l_max + !! max Spherical Harmonic l order value + integer(I4B) :: N, lmindex + !! Length of Legendre polynomials and index at a given l, m + real(DP) :: r_mag + !! magnitude of rh + real(DP) :: phi, phi_bar + !! Azimuthal/Phase angle (radians) wrt coordinate axes, and central body rotation phase + real(DP) :: theta + !! Inclination/Zenith angle (radians) + real(DP) :: plm, plm1 + !! Associated Legendre polynomials at a given l, m + real(DP) :: ccss, cssc + !! See definition in source code + real(DP) :: cos_theta, sin_theta + !! cos(theta) and sin(theta) + real(DP), dimension(:), allocatable :: p + !! Associated Lengendre Polynomials at a given cos(theta) + real(DP) :: fac1, fac2, r_fac + !! calculation factors + + g_sph(:) = 0.0_DP + theta = atan2(sqrt(rh(1)**2 + rh(2)**2), rh(3)) + phi = atan2(rh(2), rh(1)) + phi_bar = MOD(phi - phi_cb, 2 * PI) ! represents the phase difference between the central body's and the particle's phase + r_mag = sqrt(dot_product(rh(:), rh(:))) + l_max = size(c_lm, 2) - 1 + N = (l_max + 1) * (l_max + 2) / 2 + allocate(p(N)) + + cos_theta = cos(theta) + sin_theta = sin(theta) + + ! check if cos_theta is too small to avoid floating underflow error + if (abs(cos_theta) < EPSILON(0.0_DP)) then + call PlmBar(p, l_max, 0.0_DP) + else + call PlmBar(p, l_max, cos_theta) + end if + + do l = 1, l_max ! skipping the l = 0 term; It is the spherical body term + do m = 0, l + + ! If c_lm is too small, skip the iteration to improve performance + if (abs(c_lm(m+1, l+1, 1)) < epsilon(0.0_DP) .and. abs(c_lm(m+1, l+1, 2)) < epsilon(0.0_DP)) then + cycle + endif + + ! Associated Legendre Polynomials + lmindex = PlmIndex(l, m) + plm = p(lmindex) ! p_l,m + + ! C_lm and S_lm with Cos and Sin of m * phi + ccss = c_lm(m+1, l+1, 1) * cos(m * phi_bar) & + + c_lm(m+1, l+1, 2) * sin(m * phi_bar) ! C_lm * cos(m * phi_bar) + S_lm * sin(m * phi_bar) + cssc = -1 * c_lm(m+1, l+1, 1) * sin(m * phi_bar) & + + c_lm(m+1, l+1, 2) * cos(m * phi_bar) ! - C_lm * sin(m * phi_bar) + S_lm * cos(m * phi_bar) + ! cssc * m = first derivative of ccss with respect to phi + + if ((m+1) <= l) then + lmindex = PlmIndex(l, m+1) + plm1 = p(lmindex) + if(m == 0) then + plm1 = plm1 * sqrt(((l + m + 1) * (l - m)) / 2.0) ! renormalize plm1 to the norm of plm + else + plm1 = plm1 * sqrt((l + m + 1) * (l - m) * 1.0) ! renormalize plm1 to the norm of plm + end if + else + plm1 = 0.0_DP + end if + + if(abs(sin_theta) < epsilon(1.0_DP)) then + fac1 = 0.0_DP + else + fac1 = m * plm / sin_theta + end if + + fac2 = plm * (l + m + 1) * sin_theta + plm1 * cos_theta + r_fac = -GMcb * r_0**l / r_mag**(l + 2) + + g_sph(1) = g_sph(1) + r_fac * (cssc * fac1 * sin(phi) + ccss * (fac2 - fac1) * cos(phi)) + g_sph(2) = g_sph(2) + r_fac * (-cssc * fac1 * cos(phi) + ccss * (fac2 - fac1) * sin(phi)) + g_sph(3) = g_sph(3) + r_fac * ccss * (plm * (l + m + 1) * cos_theta - plm1 * sin_theta) + + end do + end do + + if (present(GMpl) .and. present(aoblcb)) then + aoblcb(:) = aoblcb(:) - GMpl * g_sph(:) / GMcb + end if + + return + end subroutine shgrav_g_acc_one + + module subroutine shgrav_acc(body, nbody_system) + !! author: Kaustub P. Anand + !! + !! Calculate the acceleration terms for bodies given c_lm values for the central body + !! + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: body + !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + ! Internals + integer(I4B) :: i + real(DP), dimension(NDIM) :: g_sph + !! Gravitational terms from Spherical Harmonics + + associate(cb => nbody_system%cb) + cb%aobl(:) = 0.0_DP + select type(body) + class is (swiftest_pl) + do i = 1, body%nbody + if (body%lmask(i)) then + call shgrav_g_acc_one(cb%Gmass, cb%radius, cb%rotphase, body%rh(:,i), cb%c_lm, body%aobl(:,i), & + GMpl=body%Gmass(i), aoblcb=cb%aobl) + end if + end do + class is (swiftest_tp) + do i = 1, body%nbody + if (body%lmask(i)) then + call shgrav_g_acc_one(cb%Gmass, cb%radius, cb%rotphase, body%rh(:,i), cb%c_lm, body%aobl(:,i)) + end if + end do + end select + end associate + return + end subroutine shgrav_acc + +end submodule s_shgrav_accel \ No newline at end of file diff --git a/src/shgrav/shgrav_module.f90 b/src/shgrav/shgrav_module.f90 new file mode 100644 index 000000000..416f51d19 --- /dev/null +++ b/src/shgrav/shgrav_module.f90 @@ -0,0 +1,31 @@ +! Copyight 2024 - The Minton Group at Purdue University +! This file is part of Swiftest. +! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +! Swiftest 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 Swiftest. +! If not, see: https://www.gnu.org/licenses. + +module shgrav + !! author: David A. Minton and Kaustub Anand + !! + !! This module defines functions used for the computation of accelerations based on spherical harmonics representation of the + !! gravitational potential of the central body. It uses the SHTOOLS library https://shtools.github.io/SHTOOLS/ + use swiftest + implicit none + public + + interface + module subroutine shgrav_acc(body, nbody_system) + implicit none + class(swiftest_body), intent(inout) :: body + !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + end subroutine shgrav_acc + + end interface + +end module shgrav + \ No newline at end of file diff --git a/src/swiftest/swiftest_coarray.f90 b/src/swiftest/swiftest_coarray.f90 index c8e4da943..60912902f 100644 --- a/src/swiftest/swiftest_coarray.f90 +++ b/src/swiftest/swiftest_coarray.f90 @@ -239,6 +239,7 @@ module subroutine swiftest_coarray_coclone_nc(self) call coclone(self%discard_vh_varid) call coclone(self%discard_body_id_varname) call coclone(self%lpseudo_vel_exists) + call coclone(self%lc_lm_exists) return end subroutine swiftest_coarray_coclone_nc diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index 2d7d2c7a2..33dd7feb0 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -21,33 +21,87 @@ module subroutine swiftest_discard_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical :: lpl_discards, ltp_discards, lpl_check, ltp_check + logical, dimension(:), allocatable :: ldiscard + integer(I4B) :: i, nstart, nend, nsub + character(len=STRMAX) :: idstr + class(swiftest_pl), allocatable :: plsub + class(swiftest_tp), allocatable :: tpsub - lpl_check = allocated(self%pl_discards) - ltp_check = allocated(self%tp_discards) + lpl_check = allocated(self%pl_discards) .and. self%pl%nbody > 0 + ltp_check = allocated(self%tp_discards) .and. self%tp%nbody > 0 - associate(nbody_system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) + associate(nbody_system => self,tp => self%tp,pl => self%pl,tp_discards => self%tp_discards,pl_discards => self%pl_discards, & + npl => self%pl%nbody, ntp => self%tp%nbody, t => self%t, collision_history => self%collision_history, & + collider => self%collider) lpl_discards = .false. ltp_discards = .false. if (lpl_check .and. pl%nbody > 0) then pl%ldiscard = pl%status(:) /= ACTIVE call pl%discard(nbody_system, param) - lpl_discards = (pl_discards%nbody > 0) + if (npl > 0) lpl_discards = any(pl%ldiscard(1:npl)) end if if (ltp_check .and. tp%nbody > 0) then tp%ldiscard = tp%status(:) /= ACTIVE call tp%discard(nbody_system, param) - ltp_discards = (tp_discards%nbody > 0) + if (ntp > 0) ltp_discards = any(tp%ldiscard(1:ntp)) + if (npl > 0) lpl_discards = any(pl%ldiscard(1:npl)) end if if (ltp_discards.or.lpl_discards) then - if (lpl_discards) then - if (param%lenergy) call self%conservation_report(param, lterminal=.false.) - call pl_discards%setup(0,param) - end if + ! Advance the collision id number and save it + collider%maxid_collision = collider%maxid_collision + 1 + collider%collision_id = collider%maxid_collision + collider%impactors%regime = COLLRESOLVE_REGIME_MERGE + write(idstr,*) collider%collision_id + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "collision_id " // trim(adjustl(idstr))) + if (ltp_discards) then + allocate(ldiscard, source=tp%ldiscard(:)) + do i = 1, ntp + if (ldiscard(i)) call tp%info(i)%set_value(collision_id=collider%collision_id) + end do + allocate(tpsub, mold=tp) + call tp%spill(tpsub, ldiscard, ldestructive=.true.) + nsub = tpsub%nbody + nstart = tp_discards%nbody + 1 + nend = tp_discards%nbody + nsub + call tp_discards%append(tpsub, lsource_mask=[(.true., i = 1, nsub)]) + deallocate(ldiscard) + select type(before => collider%before) + class is (swiftest_nbody_system) + if (allocated(before%tp)) deallocate(before%tp) + allocate(before%tp, source=tp_discards) + end select call tp_discards%setup(0,param) end if + + if (lpl_discards) then ! In the base integrators, massive bodies are not true discards. The discard is + ! simply used to trigger a snapshot. + if (param%lenergy) call self%conservation_report(param, lterminal=.false.) + allocate(ldiscard, source=pl%ldiscard(:)) + do i = 1, npl + if (ldiscard(i)) call pl%info(i)%set_value(collision_id=collider%collision_id) + end do + allocate(plsub, mold=pl) + call pl%spill(plsub, ldiscard, ldestructive=.false.) + nsub = plsub%nbody + nstart = pl_discards%nbody + 1 + nend = pl_discards%nbody + nsub + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nsub)]) + deallocate(ldiscard) + pl%ldiscard(1:npl) = .false. + ! Save the before snapshots + select type(before => collider%before) + class is (swiftest_nbody_system) + if (allocated(before%pl)) deallocate(before%pl) + allocate(before%pl, source=pl_discards) + end select + call pl_discards%setup(0,param) + end if + + + call collision_history%take_snapshot(param,nbody_system, t, "particle") end if end associate @@ -59,8 +113,8 @@ end subroutine swiftest_discard_system module subroutine swiftest_discard_pl(self, nbody_system, param) !! author: David A. Minton !! - !! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set to false. - !! This method is intended to be overridden by more advanced integrators. + !! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set + !! to false. This method is intended to be overridden by more advanced integrators. implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -86,15 +140,11 @@ module subroutine swiftest_discard_tp(self, nbody_system, param) class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter - ! Internals - logical, dimension(:), allocatable :: ldiscard - integer(I4B) :: npl, ntp if (self%nbody == 0) return - associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) - ntp = tp%nbody - npl = pl%nbody + associate(tp => self, ntp => self%nbody, cb => nbody_system%cb, pl => nbody_system%pl, npl => nbody_system%pl%nbody, & + tp_discards => nbody_system%tp_discards, pl_discards => nbody_system%pl_discards) if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. & (param%rmaxu >= 0.0_DP) .or. ((param%qmin >= 0.0_DP) .and. (param%qmin_coord == "BARY"))) then @@ -102,12 +152,16 @@ module subroutine swiftest_discard_tp(self, nbody_system, param) call tp%h2b(cb) end if - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, nbody_system, param) - if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, nbody_system, param) - if (param%lclose) call swiftest_discard_pl_tp(tp, nbody_system, param) - if (any(tp%ldiscard(1:ntp))) then - allocate(ldiscard, source=tp%ldiscard) - call tp%spill(nbody_system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) + if ((param%rmin >= 0.0_DP) .or. & + (param%rmax >= 0.0_DP) .or. & + (param%rmaxu >= 0.0_DP)) then + call swiftest_discard_cb_tp(tp, nbody_system, param) + end if + if (param%qmin >= 0.0_DP) then + call swiftest_discard_peri_tp(tp, nbody_system, param) + end if + if (param%lclose) then + call swiftest_discard_pl_tp(tp, nbody_system, param) end if end associate @@ -229,7 +283,7 @@ subroutine swiftest_discard_peri_tp(tp, nbody_system, param) call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) tp%ldiscard(i) = .true. call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & - discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) + discard_vh=tp%vh(:,i), discard_body_id=cb%id) end if end if end if @@ -274,9 +328,10 @@ subroutine swiftest_discard_pl_tp(tp, nbody_system, param) write(idstri, *) tp%id(i) write(idstrj, *) pl%id(j) write(timestr, *) nbody_system%t - write(message, *) "Test particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " too close to massive body " // trim(adjustl(pl%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " at t = " // trim(adjustl(timestr)) + write(message, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & + // " too close to massive body " // trim(adjustl(pl%info(j)%name)) // " (" & + // trim(adjustl(idstrj)) // ")" & + // " at t = " // trim(adjustl(timestr)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) tp%ldiscard(i) = .true. call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & diff --git a/src/swiftest/swiftest_drift.f90 b/src/swiftest/swiftest_drift.f90 index 71fe737a6..f146e2359 100644 --- a/src/swiftest/swiftest_drift.f90 +++ b/src/swiftest/swiftest_drift.f90 @@ -48,6 +48,7 @@ module subroutine swiftest_drift_body(self, nbody_system, param, dt) end if end do end if + end associate deallocate(iflag) @@ -458,6 +459,7 @@ pure subroutine swiftest_drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, do nc = 0, 6 x = s*s*alpha + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1*s c2 = c2*s*s @@ -550,7 +552,7 @@ pure subroutine swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) ! Internals integer(I4B) :: i, n real(DP) :: xm - + n = 0 xm = 0.1_DP do while (abs(x) >= xm) @@ -578,5 +580,22 @@ pure subroutine swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) return end subroutine swiftest_drift_kepu_stumpff + module subroutine swiftest_drift_cb_rotphase_update(self, param, dt) + !! Author : Kaustub Anand + !! subroutine to update the rotation phase of the central body + !! Units: radians + !! + !! initial 0 is set at the x-axis + !! phase is stored and calculated in radians. Converted to degrees for output + implicit none + ! Arguments + class(swiftest_cb), intent(inout) :: self !! Swiftest central body data structure + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: dt !! Stepsize + + self%rotphase = MOD(self%rotphase + (.mag. self%rot(:)) * dt , 2 * PI) ! phase angle calculated in radians and then scaled by 2pi to be unitless + + end subroutine swiftest_drift_cb_rotphase_update + end submodule s_swiftest_drift diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index 0ed7536e4..88cab75d2 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -23,10 +23,11 @@ module subroutine swiftest_driver(integrator, param_file_name, display_style) ! Arguments character(len=:), intent(in), allocatable :: integrator !! Symbolic code of the requested integrator character(len=:), intent(in), allocatable :: param_file_name !! Name of the input parameters file - character(len=:), intent(in), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" + character(len=:), intent(in), allocatable :: display_style !! Style of the output display + !! {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" ! Internals - class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated + class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated type(swiftest_parameters) :: param !! Run configuration parameters class(swiftest_storage), allocatable :: system_history !! Stores the system history between output dumps type(walltimer) :: integration_timer !! Object used for computing elapsed wall time @@ -101,7 +102,8 @@ module subroutine swiftest_driver(integrator, param_file_name, display_style) if (param%log_output) flush(param%display_unit) #ifdef COARRAY - ! The following line lets us read in the input files one image at a time. Letting each image read the input in is faster than broadcasting all of the data + ! The following line lets us read in the input files one image at a time. Letting each image read the input in is faster + ! than broadcasting all of the data if (param%lcoarray .and. (this_image() /= 1)) sync images(this_image() - 1) #endif call nbody_system%initialize(system_history, param) @@ -112,14 +114,16 @@ module subroutine swiftest_driver(integrator, param_file_name, display_style) if (param%lcoarray) call nbody_system%coarray_distribute(param) #endif - ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. + ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial + ! conditions to file. call nbody_system%display_run_information(param, integration_timer, phase="first") if (param%lenergy) then if (param%lrestart) then call nbody_system%get_t0_values(system_history%nc, param) else - call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and + ! momentum end if call nbody_system%conservation_report(param, lterminal=.true.) end if diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 132b9fb2f..c50345cd3 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -168,16 +168,19 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) end if if (.not.param%lfirstenergy) then - - nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%E_orbit_orig) - nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%E_orbit_orig) - nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%E_orbit_orig) + nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%te_orig) + nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%te_orig) + nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%te_orig) be_cb_orig = -(3 * cb%GM0**2 / param%GU) / (5 * cb%R0) nbody_system%be_error = (be_now - nbody_system%be_orig) / abs(nbody_system%te_orig) + (be_cb_now - be_cb_orig) & / abs(nbody_system%te_orig) - nbody_system%E_orbit_error = (E_orbit_now - nbody_system%E_orbit_orig) / abs(nbody_system%E_orbit_orig) + if (abs(nbody_system%E_orbit_orig) < 10*tiny(1.0_DP)) then + nbody_system%E_orbit_error = 0.0_DP + else + nbody_system%E_orbit_error = (E_orbit_now - nbody_system%E_orbit_orig) / abs(nbody_system%E_orbit_orig) + end if nbody_system%Ecoll_error = nbody_system%E_collisions / abs(nbody_system%te_orig) nbody_system%E_untracked_error = nbody_system%E_untracked / abs(nbody_system%te_orig) nbody_system%te_error = (nbody_system%te - nbody_system%te_orig - nbody_system%E_collisions - nbody_system%E_untracked)& @@ -764,6 +767,15 @@ module subroutine swiftest_io_netcdf_get_t0_values_system(self, nc, param) call netcdf_io_check( nf90_get_var(nc%id, nc%E_untracked_varid, self%E_untracked, start=[tslot]), & "netcdf_io_get_t0_values_system E_untracked_varid" ) + ! ! SH gravity variable dimensions + + ! call netcdf_io_check( nf90_get_var(nc%id, nc%sign_dimname, nc%sign_dimid), & + ! "swiftest_io_netcdf_open nf90_inq_dimid sign_dimid") + ! call netcdf_io_check( nf90_inq_dimid(nc%id, nc%l_dimname, nc%l_dimid), & + ! "swiftest_io_netcdf_open nf90_inq_dimid l_dimid") + ! call netcdf_io_check( nf90_inq_dimid(nc%id, nc%m_dimname, nc%m_dimid), & + ! "swiftest_io_netcdf_open nf90_inq_dimid m_dimid") + end if deallocate(vals) @@ -785,6 +797,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: nvar, varid, vartype + integer(I4B) :: status real(DP) :: dfill real(SP) :: sfill integer(I4B), parameter :: NO_FILL = 0 @@ -826,6 +839,13 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) "netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), & "netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables + + call netcdf_io_check( nf90_def_dim(nc%id, nc%sign_dimname, NF90_UNLIMITED, nc%sign_dimid), & + "swiftest_io_netcdf_open nf90_def_dim sign_dimid") + call netcdf_io_check( nf90_def_dim(nc%id, nc%l_dimname, NF90_UNLIMITED, nc%l_dimid), & + "swiftest_io_netcdf_open nf90_def_dim l_dimid") + call netcdf_io_check( nf90_def_dim(nc%id, nc%m_dimname, NF90_UNLIMITED, nc%m_dimid), & + "swiftest_io_netcdf_open nf90_def_dim m_dimid") ! Dimension coordinates call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), & @@ -835,6 +855,13 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), & "netcdf_io_initialize_output nf90_def_var name_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%sign_dimname, nc%out_type, nc%sign_dimid, nc%sign_varid), & + "swiftest_io_netcdf_open nf90_def_var sign_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%l_dimname, nc%out_type, nc%l_dimid, nc%l_varid), & + "swiftest_io_netcdf_open nf90_def_var l_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%m_dimname, nc%out_type, nc%m_dimid, nc%m_varid), & + "swiftest_io_netcdf_open nf90_def_var m_varid") + ! Variables call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), & "netcdf_io_initialize_output nf90_def_var id_varid" ) @@ -856,7 +883,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) nc%vh_varid), "netcdf_io_initialize_output nf90_def_var vh_varid" ) !! When GR is enabled, we need to save the pseudovelocity vectors in addition to the true heliocentric velocity vectors, - !! otherwise !! we cannnot expect bit-identical runs from restarted runs with GR enabled due to floating point errors + !! otherwise we cannnot expect bit-identical runs from restarted runs with GR enabled due to floating point errors !! during the conversion. if (param%lgr) then call netcdf_io_check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, & @@ -940,6 +967,8 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], & nc%rot_varid), & "netcdf_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rotphase_varname, nc%out_type, nc%time_dimid, nc%rotphase_varid), & + "netcdf_io_initialize_output nf90_def_var rotphase_varid" ) end if ! if (param%ltides) then @@ -982,6 +1011,11 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) call netcdf_io_check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%j4rp4_varid), & "netcdf_io_initialize_output nf90_def_var j4rp4_varid" ) + if (nc%lc_lm_exists) then + call netcdf_io_check( nf90_def_var(nc%id, nc%c_lm_varname, nc%out_type, [nc%m_dimid, nc%l_dimid, nc%sign_dimid], & + nc%c_lm_varid), "netcdf_io_initialize_output nf90_def_var c_lm_varid" ) + end if + ! Set fill mode to NaN for all variables call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "netcdf_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar @@ -1072,6 +1106,16 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) call netcdf_io_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), & "swiftest_io_netcdf_open nf90_inq_dimid str_dimid" ) + status = nf90_inq_varid(nc%id, nc%c_lm_varname, nc%c_lm_varid) + if (status == NF90_NOERR) then + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%sign_dimname, nc%sign_dimid), & + "swiftest_io_netcdf_open nf90_inq_dimid sign_dimid") + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%l_dimname, nc%l_dimid), & + "swiftest_io_netcdf_open nf90_inq_dimid l_dimid") + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%m_dimname, nc%m_dimid), & + "swiftest_io_netcdf_open nf90_inq_dimid m_dimid") + end if + ! Dimension coordinates call netcdf_io_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), & "swiftest_io_netcdf_open nf90_inq_varid time_varid" ) @@ -1079,6 +1123,15 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) "swiftest_io_netcdf_open nf90_inq_varid space_varid" ) call netcdf_io_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), & "swiftest_io_netcdf_open nf90_inq_varid name_varid" ) + status = nf90_inq_varid(nc%id, nc%c_lm_varname, nc%c_lm_varid) + if (status == NF90_NOERR) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%sign_dimname, nc%sign_varid), & + "swiftest_io_netcdf_open nf90_inq_varid sign_varid") + call netcdf_io_check( nf90_inq_varid(nc%id, nc%l_dimname, nc%l_varid), & + "swiftest_io_netcdf_open nf90_inq_varid l_varid") + call netcdf_io_check( nf90_inq_varid(nc%id, nc%m_dimname, nc%m_varid), & + "swiftest_io_netcdf_open nf90_inq_varid m_varid") + end if ! Required Variables call netcdf_io_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), & @@ -1130,6 +1183,13 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) "swiftest_io_netcdf_open nf90_inq_varid Ip_varid" ) call netcdf_io_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), & "swiftest_io_netcdf_open nf90_inq_varid rot_varid" ) + + ! rotphase may not be input by the user + status = nf90_inq_varid(nc%id, nc%rotphase_varname, nc%rotphase_varid) + + ! call netcdf_io_check( nf90_inq_varid(nc%id, nc%rotphase_varname, nc%rotphase_varid), & + ! "swiftest_io_netcdf_open nf90_inq_varid rotphase_varid") + end if ! if (param%ltides) then @@ -1181,6 +1241,8 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) end if + status = nf90_inq_varid(nc%id, nc%c_lm_varname, nc%c_lm_varid) + end associate return @@ -1292,6 +1354,7 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier integer(I4B) :: ierr !! Error code: returns 0 if the read is successful ! Internals integer(I4B) :: i, idmax, npl_check, ntp_check, str_max, status, npl, ntp + integer(I4B) :: l_dim_max, m_dim_max ! dimensions for c_lm array real(DP), dimension(:), allocatable :: rtemp real(DP), dimension(:,:), allocatable :: vectemp integer(I4B), dimension(:), allocatable :: itemp @@ -1463,7 +1526,17 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier end do ! Set initial central body angular momentum for bookkeeping - cb%L0(:) = cb%Ip(3) * cb%mass * cb%R0**2 * cb%rot(:) + cb%L0(:) = cb%Ip(3) * cb%mass * cb%R0**2 * cb%rot(:) + + ! rotphase may not be input by the user + status = nf90_inq_varid(nc%id, nc%rotphase_varname, nc%rotphase_varid) + if (status == NF90_NOERR) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rotphase_varid, cb%rotphase, start=[tslot]), & + "netcdf_io_read_frame_system nf90_getvar rotphase_varid" ) + cb%rotphase = cb%rotphase * DEG2RAD + else + cb%rotphase = 0.0_DP + end if end if ! if (param%ltides) then @@ -1494,6 +1567,23 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier cb%j4rp4 = 0.0_DP end if + status = nf90_inq_varid(nc%id, nc%c_lm_varname, nc%c_lm_varid) + if (status == NF90_NOERR) then + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%l_dimid, len = l_dim_max), "netcdf_io_read_frame_system nf90_inquire_dimension l_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%m_dimid, len = m_dim_max), "netcdf_io_read_frame_system nf90_inquire_dimension m_dimid") + + if(.not. allocated(cb%c_lm)) then + allocate(cb%c_lm(m_dim_max, l_dim_max, 2)) + end if + call netcdf_io_check( nf90_get_var(nc%id, nc%c_lm_varid, cb%c_lm, count = [m_dim_max, l_dim_max, 2]), "netcdf_io_read_frame_system nf90_getvar c_lm_varid") + + ! ordering of dimensions above seen to stackoverflow to prevent error 'NetCDF: Start + count exceeds dimension bound' + nc%lc_lm_exists = .true. + else + if (allocated(cb%c_lm)) deallocate(cb%c_lm) + nc%lc_lm_exists = .false. + end if + call self%read_particle_info(nc, param, plmask, tpmask) if (param%in_form == "EL") then @@ -2002,11 +2092,14 @@ module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) !! Write a frame of output of the central body implicit none ! Arguments - class(swiftest_cb), intent(in) :: self !! Swiftest base object + class(swiftest_cb), intent(inout) :: self !! Swiftest base object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: idslot, old_mode, tmp + integer(I4B) :: idslot, old_mode, tmp, i + integer(I4B) :: l_dim_max, m_dim_max + integer(I4B), dimension(:), allocatable :: lm_coords + integer(I4B) :: status associate(tslot => nc%tslot) call self%write_info(nc, param) @@ -2035,7 +2128,33 @@ module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) "swiftest_io_netcdf_write_frame_cb nf90_put_var cb Ip_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:) * RAD2DEG, start=[1, idslot, tslot], & count=[NDIM,1,1]), & - "swiftest_io_netcdf_write_frame_cby nf90_put_var cb rot_varid" ) + "swiftest_io_netcdf_write_frame_cb nf90_put_var cb rot_varid" ) + + ! Following the template of j2rp2 + call netcdf_io_check( nf90_put_var(nc%id, nc%rotphase_varid, self%rotphase * RAD2DEG, start = [tslot]), & + "swiftest_io_netcdf_write_frame_cb nf90_put_var cb rotphase") + end if + + if (allocated(self%c_lm)) then + status = nf90_inq_varid(nc%id, nc%c_lm_varname, nc%c_lm_varid) + if (status == NF90_NOERR) then + m_dim_max = size(self%c_lm, 1) + l_dim_max = size(self%c_lm, 2) + + ! Populate coordinate values for l and m and export to hdf file + allocate(lm_coords(l_dim_max)) + do i = 0, l_dim_max - 1 + lm_coords(i + 1) = i + end do + + call netcdf_io_check( nf90_put_var(nc%id, nc%l_varid, lm_coords), "netcdf_io_write_frame_cb nf90_put_var l_varid") + call netcdf_io_check( nf90_put_var(nc%id, nc%m_varid, lm_coords), "netcdf_io_write_frame_cb nf90_put_var m_varid") + call netcdf_io_check( nf90_put_var(nc%id, nc%sign_varid, [1,-1]), "netcdf_io_write_frame_cb nf90_put_var sign_varid") + + ! Write dimension-coordinates to file + call netcdf_io_check( nf90_put_var(nc%id, nc%c_lm_varid, self%c_lm, count = [m_dim_max, l_dim_max, 2]), & + "netcdf_io_write_frame_cb nf90_put_var c_lm_varid") + end if end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, tmp), & @@ -3257,8 +3376,8 @@ module subroutine swiftest_io_read_in_system(self, nc, param) if (ierr /=0) call base_util_exit(FAILURE,param%display_unit) end if - param%loblatecb = ((abs(self%cb%j2rp2) > 0.0_DP) .or. (abs(self%cb%j4rp4) > 0.0_DP)) - if (.not.param%loblatecb) then + param%lnon_spherical_cb = (self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP) .or. allocated(self%cb%c_lm) + if (.not.param%lnon_spherical_cb) then if (allocated(self%pl%aobl)) deallocate(self%pl%aobl) if (allocated(self%tp%aobl)) deallocate(self%tp%aobl) else @@ -3270,6 +3389,8 @@ module subroutine swiftest_io_read_in_system(self, nc, param) if (.not. allocated(self%tp%aobl)) allocate(self%tp%aobl(NDIM,self%tp%nbody)) self%tp%aobl(:,:) = 0.0_DP end if + + end if return diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 52ab45e7a..0e0c40749 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -10,29 +10,33 @@ module swiftest !! author: David A. Minton !! - !! This module serves to combine all of the Swiftest project modules under a single umbrella so that they can be accessed from individual submodule implementations - !! with a simple "use swiftest" line. + !! This module serves to combine all of the Swiftest project modules under a single umbrella so that they can be accessed from + !! individual submodule implementations with a simple "use swiftest" line. !! - !! The project structure is divided into a heirarchy of modules. The lowest level of the heirarchy are the modules called in the "use" statements below. Next the - !! "swiftest" !! modules (this one), and finally each individual integrator (and potential future integrators) sit at the top. This structure is a consequence of two - !! competing constraints: - !! 1) The desire that much of the basic functionality of the code is modular, such that new functionality can be easily added without altering too much of the basic code. + !! The project structure is divided into a heirarchy of modules. The lowest level of the heirarchy are the modules called in the + !! "use" statements below. Next the "swiftest" modules (this one), and finally each individual integrator (and potential future + !! integrators) sit at the top. This structure is a consequence of two competing constraints: + !! 1) The desire that much of the basic functionality of the code is modular, such that new functionality can be easily added + !! without altering too much of the basic code. !! 2) Adhering to Modern Fortran's typing rules. !! - !! A set of "base" types is defined in the base module. These define classes of objects, (i.e. central body, massive body, and test particles) and other major types - !! used throughout the project. However, none of the derived data types are defined with concrete type-bound procedures attached (only abstract procedures). - !! However, the *interfaces* of type-bound procedures are defined using the base types as arguments. Because of the typing rules of Modern Fortran's type-bound procedure overrides, any non-pass arguments - !! (i.e. arguments not named self) must be identical in all extended types. Because some of the basic functionality in the project is split across multiple modules, - !! we cannot define type-bound procedures in base class objects until the all interfaces are defined. In order to avoid these dependency issues and not end up with a - !! massive base class with every possibly type-bound procedure interface in the project (thus reducing the modularity of the project), the type-bound procedures are added - !! to the base types here. + !! A set of "base" types is defined in the base module. These define classes of objects, (i.e. central body, massive body, and + !! test particles) and other major types used throughout the project. However, none of the derived data types are defined with + !! concrete type-bound procedures attached (only abstract procedures). However, the *interfaces* of type-bound procedures are + !! defined using the base types as arguments. Because of the typing rules of Modern Fortran's type-bound procedure overrides, any + !! non-pass arguments(i.e. arguments not named self) must be identical in all extended types. Because some of the basic + !! functionality in the project is split across multiple modules, we cannot define type-bound procedures in base class objects + !! until the all interfaces are defined. In order to avoid these dependency issues and not end up with a massive base class with + !! every possibly type-bound procedure interface in the project (thus reducing the modularity of the project), the type-bound + !! procedures are added to the base types here. !! - !! Structuring this code this way adds somewhat to the verbosity of the code. The main thing that has to happen is that for any procedures where one wishes to make use of an - !! type-bound procedures defined for arguments at the swiftest-type level or higher, but that are passsed to base-level procedures, must have their arguments wrapped in - !! a select type(...); class is(...) construct in order to "reveal" the procedures. This is done throughout the project at the beginning of many procedures (along with - !! copious amounts of associate(...) statements, in order to help with code readibility) + !! Structuring this code this way adds somewhat to the verbosity of the code. The main thing that has to happen is that for any + !! procedures where one wishes to make use of an type-bound procedures defined for arguments at the swiftest-type level or + !! higher, but that are passsed to base-level procedures, must have their arguments wrapped in a select type(...); class is(...) + !! construct in order to "reveal" the procedures. This is done throughout the project at the beginning of many procedures (along + !! with copious amounts of associate(...) statements, in order to help with code readibility) !! - !! Adapted from David E. Kaufmann's Swifter routine: module_swifter.f90 + !! Adapted from David E. Kaufmann's Swifter routine: module_swifter.f90 use globals use operators use lambda_function @@ -53,10 +57,14 @@ module swiftest type, extends(netcdf_parameters) :: swiftest_netcdf_parameters contains - procedure :: initialize => swiftest_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: get_valid_masks => swiftest_io_netcdf_get_valid_masks !! Gets logical masks indicating which bodies are valid pl and tp type at the current time - procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids - procedure :: flush => swiftest_io_netcdf_flush !! Flushes a NetCDF file by closing it then opening it again + procedure :: initialize => swiftest_io_netcdf_initialize_output + !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: get_valid_masks => swiftest_io_netcdf_get_valid_masks + !! Gets logical masks indicating which bodies are valid pl and tp type at the current time + procedure :: open => swiftest_io_netcdf_open + !! Opens a NetCDF file and does the variable inquiries to activate variable ids + procedure :: flush => swiftest_io_netcdf_flush + !! Flushes a NetCDF file by closing it then opening it again #ifdef COARRAY procedure :: coclone => swiftest_coarray_coclone_nc #endif @@ -64,18 +72,25 @@ module swiftest type, extends(base_storage) :: swiftest_storage - class(swiftest_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object + class(swiftest_netcdf_parameters), allocatable :: nc + !! NetCDF object attached to this storage object contains - procedure :: dump => swiftest_io_dump_storage !! Dumps storage object contents to file - procedure :: dealloc => swiftest_util_dealloc_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) - procedure :: make_index_map => swiftest_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the nbody_system for later file storage + procedure :: dump => swiftest_io_dump_storage + !! Dumps storage object contents to file + procedure :: dealloc => swiftest_util_dealloc_storage + !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: get_index_values => swiftest_util_get_vals_storage + !! Gets the unique values of the indices of a storage object (i.e. body id or time value) + procedure :: make_index_map => swiftest_util_index_map_storage + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => swiftest_util_snapshot_system + !! Takes a snapshot of the nbody_system for later file storage final :: swiftest_final_storage end type swiftest_storage - ! The following extended types or their children should be used, where possible, as the base of any types defined in additional modules, such as new integrators. + ! The following extended types or their children should be used, where possible, as the base of any types defined in additional + ! modules, such as new integrators. type, extends(base_parameters) :: swiftest_parameters contains procedure :: dump => swiftest_io_dump_param @@ -88,71 +103,118 @@ module swiftest !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. type, extends(base_kinship) :: swiftest_kinship - integer(I4B) :: parent !! Index of parent particle - integer(I4B) :: nchild !! number of children in merger list - integer(I4B), dimension(:), allocatable :: child !! Index of children particles + integer(I4B) :: parent + !! Index of parent particle + integer(I4B) :: nchild + !! number of children in merger list + integer(I4B), dimension(:), allocatable :: child + !! Index of children particles contains - procedure :: dealloc => swiftest_util_dealloc_kin !! Deallocates all allocatable arrays + procedure :: dealloc => swiftest_util_dealloc_kin + !! Deallocates all allocatable arrays #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_kin !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: coclone => swiftest_coarray_coclone_kin + !! Clones the image 1 body object to all other images in the coarray structure. #endif - final :: swiftest_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables + final :: swiftest_final_kin + !! Finalizes the Swiftest kinship object - deallocates all allocatables end type swiftest_kinship type, extends(base_particle_info) :: swiftest_particle_info - character(len=NAMELEN) :: name !! Non-unique name - character(len=NAMELEN) :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) - character(len=NAMELEN) :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) - real(DP) :: origin_time !! The time of the particle's formation - integer(I4B) :: collision_id !! The ID of the collision that formed the particle - real(DP), dimension(NDIM) :: origin_rh !! The heliocentric distance vector at the time of the particle's formation - real(DP), dimension(NDIM) :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation - real(DP) :: discard_time !! The time of the particle's discard - character(len=NAMELEN) :: status !! Particle status description: Active, Merged, Fragmented, etc. - real(DP), dimension(NDIM) :: discard_rh !! The heliocentric distance vector at the time of the particle's discard - real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard - integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) + character(len=NAMELEN) :: name + !! Non-unique name + character(len=NAMELEN) :: particle_type + !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) + character(len=NAMELEN) :: origin_type + !! String containing a description of the origin of the particle (e.g. Initial Conditions, Disruption, etc.) + real(DP) :: origin_time + !! The time of the particle's formation + integer(I4B) :: collision_id + !! The ID of the collision that formed the particle + real(DP), dimension(NDIM) :: origin_rh + !! The heliocentric distance vector at the time of the particle's formation + real(DP), dimension(NDIM) :: origin_vh + !! The heliocentric velocity vector at the time of the particle's formation + real(DP) :: discard_time + !! The time of the particle's discard + character(len=NAMELEN) :: status + !! Particle status description: Active, Merged, Fragmented, etc. + real(DP), dimension(NDIM) :: discard_rh + !! The heliocentric distance vector at the time of the particle's discard + real(DP), dimension(NDIM) :: discard_vh + !! The heliocentric velocity vector at the time of the particle's discard + integer(I4B) :: discard_body_id + !! The id of the other body involved in the discard (0 if no other body involved) contains - procedure :: copy => swiftest_util_copy_particle_info !! Copies one set of information object components into another, component-by-component - procedure :: set_value => swiftest_util_set_particle_info !! Sets one or more values of the particle information metadata object + procedure :: copy => swiftest_util_copy_particle_info + !! Copies one set of information object components into another, component-by-component + procedure :: set_value => swiftest_util_set_particle_info + !! Sets one or more values of the particle information metadata object end type swiftest_particle_info !> An abstract class for a generic collection of Swiftest bodies type, abstract, extends(base_object) :: swiftest_body - !! Superclass that defines the generic elements of a Swiftest particle - logical :: lfirst = .true. !! Run the current step as a first - integer(I4B) :: nbody = 0 !! Number of bodies - integer(I4B), dimension(:), allocatable :: id !! Identifier - type(swiftest_particle_info), dimension(:), allocatable :: info !! Particle metadata information - logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) - integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator - logical, dimension(:), allocatable :: ldiscard !! Body should be discarded - logical, dimension(:), allocatable :: lcollision !! flag indicating whether body has merged with another this time step - logical, dimension(:), allocatable :: lencounter !! flag indicating whether body is part of an encounter this time step - real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) - real(DP), dimension(:,:), allocatable :: rh !! Heliocentric position - real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity - real(DP), dimension(:,:), allocatable :: rb !! Barycentric position - real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity - real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration - real(DP), dimension(:,:), allocatable :: aobl !! Barycentric accelerations of bodies due to central body oblatenes - real(DP), dimension(:,:), allocatable :: agr !! Acceleration due to post-Newtonian correction - real(DP), dimension(:,:), allocatable :: atide !! Tanngential component of acceleration of bodies due to tides - real(DP), dimension(:), allocatable :: ir3h !! Inverse heliocentric radius term (1/rh**3) - integer(I4B), dimension(:), allocatable :: isperi !! perihelion passage flag - real(DP), dimension(:), allocatable :: peri !! perihelion distance - real(DP), dimension(:), allocatable :: atp !! semimajor axis following perihelion passage - real(DP), dimension(:), allocatable :: a !! Semimajor axis (pericentric distance for a parabolic orbit) - real(DP), dimension(:), allocatable :: e !! Eccentricity - real(DP), dimension(:), allocatable :: inc !! Inclination - real(DP), dimension(:), allocatable :: capom !! Longitude of ascending node - real(DP), dimension(:), allocatable :: omega !! Argument of pericenter - real(DP), dimension(:), allocatable :: capm !! Mean anomaly - - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_body and util_spill + !! Superclass that defines the generic elements of a Swiftest particle + logical :: lfirst = .true. + !! Run the current step as a first + integer(I4B) :: nbody = 0 + !! Number of bodies + integer(I4B), dimension(:), allocatable :: id + !! Identifier + type(swiftest_particle_info), dimension(:), allocatable :: info + !! Particle metadata information + logical, dimension(:), allocatable :: lmask + !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) + integer(I4B), dimension(:), allocatable :: status + !! An integrator-specific status indicator + logical, dimension(:), allocatable :: ldiscard + !! Body should be discarded + logical, dimension(:), allocatable :: lcollision + !! flag indicating whether body has merged with another this time step + logical, dimension(:), allocatable :: lencounter + !! flag indicating whether body is part of an encounter this time step + real(DP), dimension(:), allocatable :: mu + !! G * (Mcb + [m]) + real(DP), dimension(:,:), allocatable :: rh + !! Heliocentric position + real(DP), dimension(:,:), allocatable :: vh + !! Heliocentric velocity + real(DP), dimension(:,:), allocatable :: rb + !! Barycentric position + real(DP), dimension(:,:), allocatable :: vb + !! Barycentric velocity + real(DP), dimension(:,:), allocatable :: ah + !! Total heliocentric acceleration + real(DP), dimension(:,:), allocatable :: aobl + !! Barycentric accelerations of bodies due to central body oblatenes + real(DP), dimension(:,:), allocatable :: agr + !! Acceleration due to post-Newtonian correction + real(DP), dimension(:,:), allocatable :: atide + !! Tanngential component of acceleration of bodies due to tides + real(DP), dimension(:), allocatable :: ir3h + !! Inverse heliocentric radius term (1/rh**3) + integer(I4B), dimension(:), allocatable :: isperi + !! perihelion passage flag + real(DP), dimension(:), allocatable :: peri + !! perihelion distance + real(DP), dimension(:), allocatable :: atp + !! semimajor axis following perihelion passage + real(DP), dimension(:), allocatable :: a + !! Semimajor axis (pericentric distance for a parabolic orbit) + real(DP), dimension(:), allocatable :: e + !! Eccentricity + real(DP), dimension(:), allocatable :: inc + !! Inclination + real(DP), dimension(:), allocatable :: capom + !! Longitude of ascending node + real(DP), dimension(:), allocatable :: omega + !! Argument of pericenter + real(DP), dimension(:), allocatable :: capm + !! Mean anomaly + ! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + ! component list, such as setup_body and util_spill contains procedure(abstract_discard_body), deferred :: discard procedure(abstract_kick_body), deferred :: kick @@ -161,220 +223,397 @@ module swiftest procedure(abstract_accel), deferred :: accel ! These are concrete because the implementation is the same for all types of particles - procedure :: drift => swiftest_drift_body !! Loop through bodies and call Danby drift routine on heliocentric variables - procedure :: v2pv => swiftest_gr_vh2pv_body !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators - procedure :: pv2v => swiftest_gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators - procedure :: read_frame_bin => swiftest_io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body - procedure :: read_in => swiftest_io_read_in_body !! Read in body initial conditions from an ascii file - procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format - procedure :: write_info => swiftest_io_netcdf_write_info_body !! Dump contents of particle information metadata to file - procedure :: el2xv => swiftest_orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors - procedure :: xv2el => swiftest_orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements - procedure :: setup => swiftest_util_setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays - procedure :: accel_user => swiftest_user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets - procedure :: append => swiftest_util_append_body !! Appends elements from one structure to another - procedure :: dealloc => swiftest_util_dealloc_body !! Deallocates all allocatable arrays - procedure :: fill => swiftest_util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => swiftest_util_peri_body !! Determine nbody_system pericenter passages for test particles - procedure :: resize => swiftest_util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_ir3 => swiftest_util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) - procedure :: sort => swiftest_util_sort_body !! Sorts body arrays by a sortable componen - procedure :: rearrange => swiftest_util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => swiftest_util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files + procedure :: drift => swiftest_drift_body + !! Loop through bodies and call Danby drift routine on heliocentric variables + procedure :: v2pv => swiftest_gr_vh2pv_body + !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators + procedure :: pv2v => swiftest_gr_pv2vh_body + !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators + procedure :: read_frame_bin => swiftest_io_read_frame_body + !! I/O routine for writing out a single frame of time-series data for the central body + procedure :: read_in => swiftest_io_read_in_body + !! Read in body initial conditions from an ascii file + procedure :: write_frame => swiftest_io_netcdf_write_frame_body + !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format + procedure :: write_info => swiftest_io_netcdf_write_info_body + !! Dump contents of particle information metadata to file + procedure :: el2xv => swiftest_orbel_el2xv_vec + !! Convert orbital elements to position and velocity vectors + procedure :: xv2el => swiftest_orbel_xv2el_vec + !! Convert position and velocity vectors to orbital elements + procedure :: setup => swiftest_util_setup_body + !! A constructor that sets the number of bodies and allocates all allocatable arrays + procedure :: accel_user => swiftest_user_kick_getacch_body + !! Add user-supplied heliocentric accelerations to planets + procedure :: append => swiftest_util_append_body + !! Appends elements from one structure to another + procedure :: dealloc => swiftest_util_dealloc_body + !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_body + !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: get_peri => swiftest_util_peri_body + !! Determine nbody_system pericenter passages for test particles + procedure :: resize => swiftest_util_resize_body + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: set_ir3 => swiftest_util_set_ir3h + !! Sets the inverse heliocentric radius term (1/rh**3) + procedure :: sort => swiftest_util_sort_body + !! Sorts body arrays by a sortable componen + procedure :: rearrange => swiftest_util_sort_rearrange_body + !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_body + !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + generic :: read_frame => read_frame_bin + !! Add the generic read frame for Fortran binary files #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_body !! Clones the image 1 body object to all other images in the coarray structure. - procedure :: cocollect => swiftest_coarray_cocollect_body !! Collects all body object array components from all images and combines them into the image 1 body object + procedure :: coclone => swiftest_coarray_coclone_body + !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: cocollect => swiftest_coarray_cocollect_body + !! Collects all body object array components from all images and combines them into the image 1 body object #endif end type swiftest_body type, abstract, extends(base_object) :: swiftest_cb !> An abstract class for a generic central body in a Swiftest simulation - class(swiftest_particle_info), allocatable :: info !! Particle metadata information - integer(I4B) :: id = 0 !! External identifier (unique) - real(DP) :: mass = 0.0_DP !! Central body mass (units MU) - real(DP) :: Gmass = 0.0_DP !! Central mass gravitational term G * mass (units GU * MU) - real(DP) :: radius = 0.0_DP !! Central body radius (units DU) - real(DP) :: density = 1.0_DP !! Central body mass density - calculated internally (units MU / DU**3) - real(DP) :: j2rp2 = 0.0_DP !! J2*R^2 term for central body - real(DP) :: j4rp4 = 0.0_DP !! J4*R^2 term for central body - real(DP), dimension(NDIM) :: aobl = 0.0_DP !! Barycentric acceleration due to central body oblatenes - real(DP), dimension(NDIM) :: atide = 0.0_DP !! Barycentric acceleration due to central body oblatenes - real(DP), dimension(NDIM) :: aoblbeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step - real(DP), dimension(NDIM) :: aoblend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: atidebeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step - real(DP), dimension(NDIM) :: atideend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: rb = 0.0_DP !! Barycentric position (units DU) - real(DP), dimension(NDIM) :: vb = 0.0_DP !! Barycentric velocity (units DU / TU) - real(DP), dimension(NDIM) :: agr = 0.0_DP !! Acceleration due to post-Newtonian correction - real(DP), dimension(NDIM) :: Ip = 0.0_DP !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. - real(DP), dimension(NDIM) :: rot = 0.0_DP !! Body rotation vector in inertial coordinate frame (units rad / TU) - real(DP) :: k2 = 0.0_DP !! Tidal Love number - real(DP) :: Q = 0.0_DP !! Tidal quality factor - real(DP) :: tlag = 0.0_DP !! Tidal phase lag angle - real(DP), dimension(NDIM) :: L0 = 0.0_DP !! Initial angular momentum of the central body - real(DP), dimension(NDIM) :: dL = 0.0_DP !! Change in angular momentum of the central body - real(DP) :: GM0 = 0.0_DP !! Initial G*mass of the central body - real(DP) :: dGM = 0.0_DP !! Change in G*mass of the central body - real(DP) :: R0 = 0.0_DP !! Initial radius of the central body - real(DP) :: dR = 0.0_DP !! Change in the radius of the central body + class(swiftest_particle_info), allocatable :: info + !! Particle metadata information + integer(I4B) :: id = 0 + !! External identifier (unique) + real(DP) :: mass = 0.0_DP + !! Central body mass (units MU) + real(DP) :: Gmass = 0.0_DP + !! Central mass gravitational term G * mass (units GU * MU) + real(DP) :: radius = 0.0_DP + !! Central body radius (units DU) + real(DP) :: density = 1.0_DP + !! Central body mass density - calculated internally (units MU / DU**3) + real(DP) :: j2rp2 = 0.0_DP + !! J2*R^2 term for central body + real(DP) :: j4rp4 = 0.0_DP + !! J4*R^4 term for central body + real(DP), dimension(:,:,:), allocatable :: c_lm + !! Spherical Harmonics coefficients for the central body + real(DP), dimension(NDIM) :: aobl = 0.0_DP + !! Barycentric acceleration due to central body oblatenes + real(DP), dimension(NDIM) :: atide = 0.0_DP + !! Barycentric acceleration due to central body oblatenes + real(DP), dimension(NDIM) :: aoblbeg = 0.0_DP + !! Barycentric acceleration due to central body oblatenes at beginning of step + real(DP), dimension(NDIM) :: aoblend = 0.0_DP + !! Barycentric acceleration due to central body oblatenes at end of step + real(DP), dimension(NDIM) :: atidebeg = 0.0_DP + !! Barycentric acceleration due to central body oblatenes at beginning of step + real(DP), dimension(NDIM) :: atideend = 0.0_DP + !! Barycentric acceleration due to central body oblatenes at end of step + real(DP), dimension(NDIM) :: rb = 0.0_DP + !! Barycentric position (units DU) + real(DP), dimension(NDIM) :: vb = 0.0_DP + !! Barycentric velocity (units DU / TU) + real(DP), dimension(NDIM) :: agr = 0.0_DP + !! Acceleration due to post-Newtonian correction + real(DP), dimension(NDIM) :: Ip = 0.0_DP + !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. + real(DP), dimension(NDIM) :: rot = 0.0_DP + !! Body rotation vector in inertial coordinate frame (units rad / TU) + real(DP) :: rotphase = 0.0_DP + !! Body rotation phase about the rotation pole (0 to 1) + real(DP) :: k2 = 0.0_DP + !! Tidal Love number + real(DP) :: Q = 0.0_DP + !! Tidal quality factor + real(DP) :: tlag = 0.0_DP + !! Tidal phase lag angle + real(DP), dimension(NDIM) :: L0 = 0.0_DP + !! Initial angular momentum of the central body + real(DP), dimension(NDIM) :: dL = 0.0_DP + !! Change in angular momentum of the central body + real(DP) :: GM0 = 0.0_DP + !! Initial G*mass of the central body + real(DP) :: dGM = 0.0_DP + !! Change in G*mass of the central body + real(DP) :: R0 = 0.0_DP + !! Initial radius of the central body + real(DP) :: dR = 0.0_DP + !! Change in the radius of the central body contains - procedure :: dealloc => swiftest_util_dealloc_cb !! Deallocates all allocatables and resets all values to defaults - procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file - procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format - procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file + procedure :: rotphase_update => swiftest_drift_cb_rotphase_update + !! updates the central body rotation phase + procedure :: dealloc => swiftest_util_dealloc_cb + !! Deallocates all allocatables and resets all values to defaults + procedure :: read_in => swiftest_io_read_in_cb + !! Read in central body initial conditions from an ASCII file + procedure :: write_frame => swiftest_io_netcdf_write_frame_cb + !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_info => swiftest_io_netcdf_write_info_cb + !! Dump contents of particle information metadata to file #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_cb !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: coclone => swiftest_coarray_coclone_cb + !! Clones the image 1 body object to all other images in the coarray structure. #endif end type swiftest_cb type, abstract, extends(swiftest_body) :: swiftest_pl - !! Superclass that defines the generic elements of a Swiftest particle - real(DP), dimension(:), allocatable :: mass !! Body mass (units MU) - real(DP), dimension(:), allocatable :: Gmass !! Mass gravitational term G * mass (units GU * MU) - real(DP), dimension(:), allocatable :: rhill !! Body mass (units MU) - real(DP), dimension(:), allocatable :: renc !! Critical radius for close encounters - real(DP), dimension(:), allocatable :: radius !! Body radius (units DU) - real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) - real(DP), dimension(:,:), allocatable :: rbeg !! Position at beginning of step - real(DP), dimension(:,:), allocatable :: rend !! Position at end of step - real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step - real(DP), dimension(:,:), allocatable :: Ip !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. - real(DP), dimension(:,:), allocatable :: rot !! Body rotation vector in inertial coordinate frame (units rad / TU) - real(DP), dimension(:), allocatable :: k2 !! Tidal Love number - real(DP), dimension(:), allocatable :: Q !! Tidal quality factor - real(DP), dimension(:), allocatable :: tlag !! Tidal phase lag - integer(I4B), dimension(:,:), allocatable :: k_plpl !! Index array used to convert flattened the body-body comparison upper triangular matrix - integer(I8B) :: nplpl !! Number of body-body comparisons in the flattened upper triangular matrix - type(swiftest_kinship), dimension(:), allocatable :: kin !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step - logical, dimension(:), allocatable :: lmtiny !! flag indicating whether this body is below the GMTINY cutoff value - integer(I4B) :: nplm = 0 !! number of bodies above the GMTINY limit - integer(I8B) :: nplplm !! Number of body (all massive)-body (only those above GMTINY) comparisons in the flattened upper triangular matrix - integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with other planets this time step - integer(I4B), dimension(:), allocatable :: ntpenc !! number of encounters with test particles this time step - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_pl and util_spill_pl + !! Superclass that defines the generic elements of a Swiftest particle + real(DP), dimension(:), allocatable :: mass + !! Body mass (units MU) + real(DP), dimension(:), allocatable :: Gmass + !! Mass gravitational term G * mass (units GU * MU) + real(DP), dimension(:), allocatable :: rhill + !! Body mass (units MU) + real(DP), dimension(:), allocatable :: renc + !! Critical radius for close encounters + real(DP), dimension(:), allocatable :: radius + !! Body radius (units DU) + real(DP), dimension(:), allocatable :: density + !! Body mass density - calculated internally (units MU / DU**3) + real(DP), dimension(:,:), allocatable :: rbeg + !! Position at beginning of step + real(DP), dimension(:,:), allocatable :: rend + !! Position at end of step + real(DP), dimension(:,:), allocatable :: vbeg + !! Velocity at beginning of step + real(DP), dimension(:,:), allocatable :: Ip + !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. + real(DP), dimension(:,:), allocatable :: rot + !! Body rotation vector in inertial coordinate frame (units rad / TU) + real(DP), dimension(:), allocatable :: k2 + !! Tidal Love number + real(DP), dimension(:), allocatable :: Q + !! Tidal quality factor + real(DP), dimension(:), allocatable :: tlag + !! Tidal phase lag + integer(I4B), dimension(:,:), allocatable :: k_plpl + !! Index array used to convert flattened the body-body comparison upper triangular matrix + integer(I8B) :: nplpl + !! Number of body-body comparisons in the flattened upper triangular matrix + type(swiftest_kinship), dimension(:), allocatable :: kin + !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step + logical, dimension(:), allocatable :: lmtiny + !! flag indicating whether this body is below the GMTINY cutoff value + integer(I4B) :: nplm = 0 + !! number of bodies above the GMTINY limit + integer(I8B) :: nplplm + !! Number of body (all massive)-body (only those above GMTINY) comparisons in the flattened upper triangular matrix + integer(I4B), dimension(:), allocatable :: nplenc + !! number of encounters with other planets this time step + integer(I4B), dimension(:), allocatable :: ntpenc + !! number of encounters with test particles this time step + + ! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + ! component list, such as setup_pl and util_spill_pl contains ! Massive body-specific concrete methods ! These are concrete because they are the same implemenation for all integrators - procedure :: make_impactors => swiftest_util_make_impactors_pl !! Make impactors out of the current kinship relationships - procedure :: discard => swiftest_discard_pl !! Placeholder method for discarding massive bodies - procedure :: accel_int => swiftest_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies - procedure :: accel_obl => swiftest_obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => swiftest_util_setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays - ! procedure :: accel_tides => tides_kick_getacch_pl !! Compute the accelerations of bodies due to tidal interactions with the central body - procedure :: append => swiftest_util_append_pl !! Appends elements from one structure to another - procedure :: h2b => swiftest_util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => swiftest_util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - procedure :: vh2vb => swiftest_util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) - procedure :: vb2vh => swiftest_util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - procedure :: rh2rb => swiftest_util_coord_rh2rb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => swiftest_util_dealloc_pl !! Deallocates all allocatable arrays - procedure :: fill => swiftest_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: flatten => swiftest_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix - procedure :: rearray => swiftest_util_rearray_pl !! Clean up the massive body structures to remove discarded bodies and add new bodies - procedure :: resize => swiftest_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: reset_kinship => swiftest_util_reset_kinship_pl !! Resets the kinship status of bodies - procedure :: set_beg_end => swiftest_util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. - procedure :: set_mu => swiftest_util_set_mu_pl !! Method used to construct the vectorized form of the central body mass - procedure :: set_rhill => swiftest_util_set_rhill !! Calculates the Hill's radii for each body - procedure :: set_renc_I4B => swiftest_util_set_renc_I4B !! Sets the critical radius for encounter given an inpput integer scale factor - procedure :: set_renc_DP => swiftest_util_set_renc_DP !! Sets the critical radius for encounter given an input real scale factor - procedure :: sort => swiftest_util_sort_pl !! Sorts body arrays by a sortable component - procedure :: rearrange => swiftest_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => swiftest_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: make_impactors => swiftest_util_make_impactors_pl + !! Make impactors out of the current kinship relationships + procedure :: discard => swiftest_discard_pl + !! Placeholder method for discarding massive bodies + procedure :: accel_int => swiftest_kick_getacch_int_pl + !! Compute direct cross (third) term heliocentric accelerations of massive bodies + procedure :: accel_non_spherical_cb => swiftest_non_spherical_cb_acc_pl + !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + procedure :: setup => swiftest_util_setup_pl + !! A base constructor that sets the number of bodies and allocates and initializes all arrays + ! procedure :: accel_tides => tides_kick_getacch_pl + !! Compute the accelerations of bodies due to tidal interactions with the central body + procedure :: append => swiftest_util_append_pl + !! Appends elements from one structure to another + procedure :: h2b => swiftest_util_coord_h2b_pl + !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) + procedure :: b2h => swiftest_util_coord_b2h_pl + !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) + procedure :: vh2vb => swiftest_util_coord_vh2vb_pl + !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) + procedure :: vb2vh => swiftest_util_coord_vb2vh_pl + !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) + procedure :: rh2rb => swiftest_util_coord_rh2rb_pl + !! Convert massive bodies from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => swiftest_util_dealloc_pl + !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_pl + !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: flatten => swiftest_util_flatten_eucl_plpl + !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix + procedure :: rearray => swiftest_util_rearray_pl + !! Clean up the massive body structures to remove discarded bodies and add new bodies + procedure :: resize => swiftest_util_resize_pl + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: reset_kinship => swiftest_util_reset_kinship_pl + !! Resets the kinship status of bodies + procedure :: set_beg_end => swiftest_util_set_beg_end_pl + !! Sets the beginning and ending positions and velocities of planets. + procedure :: set_mu => swiftest_util_set_mu_pl + !! Method used to construct the vectorized form of the central body mass + procedure :: set_rhill => swiftest_util_set_rhill + !! Calculates the Hill's radii for each body + procedure :: set_renc_I4B => swiftest_util_set_renc_I4B + !! Sets the critical radius for encounter given an inpput integer scale factor + procedure :: set_renc_DP => swiftest_util_set_renc_DP + !! Sets the critical radius for encounter given an input real scale factor + procedure :: sort => swiftest_util_sort_pl + !! Sorts body arrays by a sortable component + procedure :: rearrange => swiftest_util_sort_rearrange_pl + !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_pl + !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) generic :: set_renc => set_renc_I4B, set_renc_DP #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_pl !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: coclone => swiftest_coarray_coclone_pl + !! Clones the image 1 body object to all other images in the coarray structure. #endif end type swiftest_pl type, abstract, extends(swiftest_body) :: swiftest_tp - !! Superclass that defines the generic elements of a Swiftest test particle - integer(I4B), dimension(:,:), allocatable :: k_pltp !! Index array used to convert flattened the body-body comparison upper triangular matrix - integer(I8B) :: npltp !! Number of pl-tp comparisons in the flattened upper triangular matrix - integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as swiftest_util_setup_tp and util_spill_tp + + !! Superclass that defines the generic elements of a Swiftest test particle + integer(I4B), dimension(:,:), allocatable :: k_pltp + !! Index array used to convert flattened the body-body comparison upper triangular matrix + integer(I8B) :: npltp + !! Number of pl-tp comparisons in the flattened upper triangular matrix + integer(I4B), dimension(:), allocatable :: nplenc + !! number of encounters with planets this time step + + ! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + ! component list, such as swiftest_util_setup_tp and util_spill_tp contains ! Test particle-specific concrete methods ! These are concrete because they are the same implemenation for all integrators - procedure :: discard => swiftest_discard_tp !! Check to see if test particles should be discarded based on their positions relative to the massive bodies - procedure :: accel_int => swiftest_kick_getacch_int_tp !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies - procedure :: accel_obl => swiftest_obl_acc_tp !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => swiftest_util_setup_tp !! A base constructor that sets the number of bodies and - procedure :: append => swiftest_util_append_tp !! Appends elements from one structure to another - procedure :: h2b => swiftest_util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => swiftest_util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - procedure :: vb2vh => swiftest_util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) - procedure :: vh2vb => swiftest_util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - procedure :: rh2rb => swiftest_util_coord_rh2rb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => swiftest_util_dealloc_tp !! Deallocates all allocatable arrays - procedure :: fill => swiftest_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => swiftest_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_mu => swiftest_util_set_mu_tp !! Method used to construct the vectorized form of the central body mass - procedure :: sort => swiftest_util_sort_tp !! Sorts body arrays by a sortable component - procedure :: rearrange => swiftest_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => swiftest_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + procedure :: discard => swiftest_discard_tp + !! Check to see if test particles should be discarded based on their positions relative to the massive bodies + procedure :: accel_int => swiftest_kick_getacch_int_tp + !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies + procedure :: accel_non_spherical_cb => swiftest_non_spherical_cb_acc_tp + !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + procedure :: setup => swiftest_util_setup_tp + !! A base constructor that sets the number of bodies and + procedure :: append => swiftest_util_append_tp + !! Appends elements from one structure to another + procedure :: h2b => swiftest_util_coord_h2b_tp + !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) + procedure :: b2h => swiftest_util_coord_b2h_tp + !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) + procedure :: vb2vh => swiftest_util_coord_vb2vh_tp + !! Convert test particles from barycentric to heliocentric coordinates (velocity only) + procedure :: vh2vb => swiftest_util_coord_vh2vb_tp + !! Convert test particles from heliocentric to barycentric coordinates (velocity only) + procedure :: rh2rb => swiftest_util_coord_rh2rb_tp + !! Convert test particles from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => swiftest_util_dealloc_tp + !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_tp + !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: rearray => swiftest_util_rearray_tp + !! Clean up the test particle structures to remove discarded bodies + procedure :: resize => swiftest_util_resize_tp + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: set_mu => swiftest_util_set_mu_tp + !! Method used to construct the vectorized form of the central body mass + procedure :: sort => swiftest_util_sort_tp + !! Sorts body arrays by a sortable component + procedure :: rearrange => swiftest_util_sort_rearrange_tp + !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_tp + !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_tp !! Clones the image 1 object to all other images in the coarray structure. - procedure :: cocollect => swiftest_coarray_cocollect_tp !! Collects all object array components from all images and combines them into the image 1 object + procedure :: coclone => swiftest_coarray_coclone_tp + !! Clones the image 1 object to all other images in the coarray structure. + procedure :: cocollect => swiftest_coarray_cocollect_tp + !! Collects all object array components from all images and combines them into the image 1 object #endif end type swiftest_tp !> An abstract class for a basic Swiftest nbody system type, abstract, extends(base_nbody_system) :: swiftest_nbody_system - !! This superclass contains a minimial nbody_system of a set of test particles (tp), massive bodies (pl), and a central body (cb) - !! The full swiftest_nbody_system type that is used as the parent class of all integrators is defined in collision - - class(swiftest_cb), allocatable :: cb !! Central body data structure - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure - - class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure - class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure - class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions - class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step - class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step - class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step - class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_basic), allocatable :: collider !! Collision system object - class(encounter_storage), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - class(collision_storage), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file - - integer(I4B) :: maxid = -1 !! The current maximum particle id number - real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: GMtot = 0.0_DP !! Total nbody_system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! nbody_system orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! nbody_system spin kinetic energy - real(DP) :: pe = 0.0_DP !! nbody_system potential energy - real(DP) :: be = 0.0_DP !! nbody_system binding energy of all bodies - real(DP) :: te = 0.0_DP !! nbody_system total energy - real(DP) :: oblpot = 0.0_DP !! nbody_system potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: L_orbit = 0.0_DP !! nbody_system orbital angular momentum vector - real(DP), dimension(NDIM) :: L_spin = 0.0_DP !! nbody_system spin angular momentum vector - real(DP), dimension(NDIM) :: L_total = 0.0_DP !! nbody_system angular momentum vector - real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy - real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy - real(DP) :: pe_orig = 0.0_DP !! Initial potential energy - real(DP) :: be_orig = 0.0_DP !! Initial gravitational binding energy - real(DP) :: te_orig = 0.0_DP !! Initial total energy (sum of all sources of energy tracked) - real(DP) :: be_cb = 0.0_DP !! Binding energy of central body (usually orders of magnitude larger than the rest of the system, and therefore tracked seperately) - real(DP) :: E_orbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial nbody_system mass - real(DP), dimension(NDIM) :: L_total_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: L_orbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: L_spin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: L_escape = 0.0_DP !! Angular momentum of bodies that escaped the nbody_system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the nbody_system (used for bookeeping) - real(DP) :: E_collisions = 0.0_DP !! Energy lost from nbody_system due to collisions - real(DP) :: E_untracked = 0.0_DP !! Energy gained from nbody_system due to escaped bodies + !! This superclass contains a minimial nbody_system of a set of test particles (tp), massive bodies (pl), and a central + !! body (cb). + class(swiftest_cb), allocatable :: cb + !! Central body data structure + class(swiftest_pl), allocatable :: pl + !! Massive body data structure + class(swiftest_tp), allocatable :: tp + !! Test particle data structure + class(swiftest_tp), allocatable :: tp_discards + !! Discarded test particle data structure + class(swiftest_pl), allocatable :: pl_discards + !! Discarded massive body particle data structure + class(swiftest_pl), allocatable :: pl_adds + !! List of added bodies in mergers or collisions + class(swiftest_tp), allocatable :: tp_adds + !! List of added bodies in mergers or collisions + class(encounter_list), allocatable :: pltp_encounter + !! List of massive body-test particle encounters in a single step + class(encounter_list), allocatable :: plpl_encounter + !! List of massive body-massive body encounters in a single step + class(collision_list_plpl), allocatable :: plpl_collision + !! List of massive body-massive body collisions in a single step + class(collision_list_pltp), allocatable :: pltp_collision + !! List of massive body-test particle collisions in a single step + class(collision_basic), allocatable :: collider + !! Collision system object + class(encounter_storage), allocatable :: encounter_history + !! Stores encounter history for later retrieval and saving to file + class(collision_storage), allocatable :: collision_history + !! Stores encounter history for later retrieval and saving to file + integer(I4B) :: maxid = -1 + !! The current maximum particle id number + real(DP) :: t = -1.0_DP + !! Integration current time + real(DP) :: GMtot = 0.0_DP + !! Total nbody_system mass - used for barycentric coordinate conversion + real(DP) :: ke_orbit = 0.0_DP + !! nbody_system orbital kinetic energy + real(DP) :: ke_spin = 0.0_DP + !! nbody_system spin kinetic energy + real(DP) :: pe = 0.0_DP + !! nbody_system potential energy + real(DP) :: be = 0.0_DP + !! nbody_system binding energy of all bodies + real(DP) :: te = 0.0_DP + !! nbody_system total energy + real(DP) :: oblpot = 0.0_DP + !! nbody_system potential energy due to oblateness of the central body + real(DP), dimension(NDIM) :: L_orbit = 0.0_DP + !! nbody_system orbital angular momentum vector + real(DP), dimension(NDIM) :: L_spin = 0.0_DP + !! nbody_system spin angular momentum vector + real(DP), dimension(NDIM) :: L_total = 0.0_DP + !! nbody_system angular momentum vector + real(DP) :: ke_orbit_orig = 0.0_DP + !! Initial orbital kinetic energy + real(DP) :: ke_spin_orig = 0.0_DP + !! Initial spin kinetic energy + real(DP) :: pe_orig = 0.0_DP + !! Initial potential energy + real(DP) :: be_orig = 0.0_DP + !! Initial gravitational binding energy + real(DP) :: te_orig = 0.0_DP + !! Initial total energy (sum of all sources of energy tracked) + real(DP) :: be_cb = 0.0_DP + !! Binding energy of central body (usually orders of magnitude larger than the rest of the system, and therefore tracked + !! seperately) + real(DP) :: E_orbit_orig = 0.0_DP + !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP + !! Initial nbody_system mass + real(DP), dimension(NDIM) :: L_total_orig = 0.0_DP + !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: L_orbit_orig = 0.0_DP + !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: L_spin_orig = 0.0_DP + !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: L_escape = 0.0_DP + !! Angular momentum of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP + !! Mass of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: E_collisions = 0.0_DP + !! Energy lost from nbody_system due to collisions + real(DP) :: E_untracked = 0.0_DP + !! Energy gained from nbody_system due to escaped bodies ! Energy, momentum, and mass errors (used in error reporting) real(DP) :: ke_orbit_error = 0.0_DP @@ -392,44 +631,73 @@ module swiftest real(DP) :: Mtot_error = 0.0_DP real(DP) :: Mescape_error = 0.0_DP - logical :: lbeg !! True if this is the beginning of a step. This is used so that test particle steps can be calculated - !! separately from massive bodies. Massive body variables are saved at half steps, and passed to - !! the test particles - logical :: lfirst_io = .true. !! Flag to indicate that this is the first time to write to a file - logical :: lfirst_peri = .true. !! Flag to indicate that this is the first pericenter passage + logical :: lbeg + !! True if this is the beginning of a step. This is used so that test particle steps can be calculated separately from + !! massive bodies. Massive body variables are saved at half steps, and passed to the test particles + logical :: lfirst_io = .true. + !! Flag to indicate that this is the first time to write to a file + logical :: lfirst_peri = .true. + !! Flag to indicate that this is the first pericenter passage contains !> Each integrator will have its own version of the step procedure(abstract_step_system), deferred :: step ! Concrete classes that are common to the basic integrator (only test particles considered for discard) - procedure :: discard => swiftest_discard_system !! Perform a discard step on the nbody_system - procedure :: compact_output => swiftest_io_compact_output !! Prints out out terminal output when display_style is set to COMPACT - procedure :: conservation_report => swiftest_io_conservation_report !! Compute energy and momentum and print out the change with time - procedure :: display_run_information => swiftest_io_display_run_information !! Displays helpful information about the run - procedure :: dump => swiftest_io_dump_system !! Dump the state of the nbody_system to a file - procedure :: get_t0_values => swiftest_io_netcdf_get_t0_values_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - procedure :: read_frame => swiftest_io_netcdf_read_frame_system !! Read in a frame of input data from file - procedure :: read_hdr => swiftest_io_netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format - procedure :: write_hdr => swiftest_io_netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format - procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file - procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: write_frame => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file - procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: dealloc => swiftest_util_dealloc_system !! Deallocates all allocatables and resets all values to defaults. Acts as a base for a finalizer - procedure :: get_energy_and_momentum => swiftest_util_get_energy_and_momentum_system !! Calculates the total nbody_system energy and momentum - procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the nbody_system - procedure :: rescale => swiftest_util_rescale_system !! Rescales the nbody_system into a new set of units - procedure :: initialize_output_file => swiftest_io_initialize_output_file_system !! Write a frame of input data from file - procedure :: initialize => swiftest_util_setup_initialize_system !! Initialize the nbody_system from input files - procedure :: init_particle_info => swiftest_util_setup_initialize_particle_info_system !! Initialize the nbody_system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of nbody_system bodies. - procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the nbody_system and save the maximum value + procedure :: discard => swiftest_discard_system + !! Perform a discard step on the nbody_system + procedure :: compact_output => swiftest_io_compact_output + !! Prints out out terminal output when display_style is set to COMPACT + procedure :: conservation_report => swiftest_io_conservation_report + !! Compute energy and momentum and print out the change with time + procedure :: display_run_information => swiftest_io_display_run_information + !! Displays helpful information about the run + procedure :: dump => swiftest_io_dump_system + !! Dump the state of the nbody_system to a file + procedure :: get_t0_values => swiftest_io_netcdf_get_t0_values_system + !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + procedure :: read_frame => swiftest_io_netcdf_read_frame_system + !! Read in a frame of input data from file + procedure :: read_hdr => swiftest_io_netcdf_read_hdr_system + !! Read a header for an output frame in NetCDF format + procedure :: write_hdr => swiftest_io_netcdf_write_hdr_system + !! Write a header for an output frame in NetCDF format + procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system + !! Read in particle metadata from file + procedure :: read_in => swiftest_io_read_in_system + !! Reads the initial conditions for an nbody system + procedure :: write_frame => swiftest_io_netcdf_write_frame_system + !! Write a frame of input data from file + procedure :: obl_pot => swiftest_obl_pot_system + !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body + procedure :: dealloc => swiftest_util_dealloc_system + !! Deallocates all allocatables and resets all values to defaults. Acts as a base for a finalizer + procedure :: get_energy_and_momentum => swiftest_util_get_energy_and_momentum_system + !! Calculates the total nbody_system energy and momentum + procedure :: get_idvals => swiftest_util_get_idvalues_system + !! Returns an array of all id values in use in the nbody_system + procedure :: rescale => swiftest_util_rescale_system + !! Rescales the nbody_system into a new set of units + procedure :: initialize_output_file => swiftest_io_initialize_output_file_system + !! Write a frame of input data from file + procedure :: initialize => swiftest_util_setup_initialize_system + !! Initialize the nbody_system from input files + procedure :: init_particle_info => swiftest_util_setup_initialize_particle_info_system + !! Initialize the nbody_system from input files + ! procedure :: step_spin => tides_step_spin_system + !! Steps the spins of the massive & central bodies due to tides. + procedure :: set_msys => swiftest_util_set_msys + !! Sets the value of msys from the masses of nbody_system bodies. + procedure :: validate_ids => swiftest_util_valid_id_system + !! Validate the numerical ids passed to the nbody_system and save the maximum value #ifdef COARRAY - procedure :: coclone => swiftest_coarray_coclone_system !! Clones the image 1 body object to all other images in the coarray structure. - procedure :: coarray_collect => swiftest_coarray_collect_system !! Collects all the test particles from other images into the image #1 test particle system - procedure :: coarray_distribute => swiftest_coarray_distribute_system !! Distributes test particles from image #1 out to all images. - procedure :: coarray_balance => swiftest_coarray_balance_system !! Checks whether or not the test particle coarrays need to be rebalanced. + procedure :: coclone => swiftest_coarray_coclone_system + !! Clones the image 1 body object to all other images in the coarray structure. + procedure :: coarray_collect => swiftest_coarray_collect_system + !! Collects all the test particles from other images into the image #1 test particle system + procedure :: coarray_distribute => swiftest_coarray_distribute_system + !! Distributes test particles from image #1 out to all images. + procedure :: coarray_balance => swiftest_coarray_balance_system + !! Checks whether or not the test particle coarrays need to be rebalanced. #endif end type swiftest_nbody_system @@ -438,424 +706,633 @@ module swiftest subroutine abstract_accel(self, nbody_system, param, t, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP - class(swiftest_body), intent(inout) :: self !! Swiftest body data structure - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + class(swiftest_body), intent(inout) :: self + !! Swiftest body data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + real(DP), intent(in) :: t + !! Current simulation time + logical, intent(in) :: lbeg + !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine abstract_accel subroutine abstract_discard_body(self, nbody_system, param) import swiftest_body, swiftest_nbody_system, swiftest_parameters - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine abstract_discard_body subroutine abstract_kick_body(self, nbody_system, param, t, dt, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. + class(swiftest_body), intent(inout) :: self + !! Swiftest generic body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system objec + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + real(DP), intent(in) :: t + !! Current time + real(DP), intent(in) :: dt + !! Stepsize + logical, intent(in) :: lbeg + !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine abstract_kick_body subroutine abstract_set_mu(self, cb) import swiftest_body, swiftest_cb - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine abstract_set_mu subroutine abstract_step_body(self, nbody_system, param, t, dt) import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + real(DP), intent(in) :: t + !! Simulation time + real(DP), intent(in) :: dt + !! Current stepsize end subroutine abstract_step_body subroutine abstract_step_system(self, param, t, dt) import DP, swiftest_nbody_system, swiftest_parameters implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + real(DP), intent(in) :: t + !! Simulation time + real(DP), intent(in) :: dt + !! Current stepsize end subroutine abstract_step_system end interface interface module subroutine swiftest_discard_pl(self, nbody_system, param) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameter end subroutine swiftest_discard_pl module subroutine swiftest_discard_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_discard_system module subroutine swiftest_discard_tp(self, nbody_system, param) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_discard_tp module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) implicit none - real(DP), dimension(:), intent(in) :: mu !! Vector of gravitational constants - real(DP), dimension(:,:), intent(inout) :: x, v !! Position and velocity vectors - integer(I4B), intent(in) :: n !! number of bodies - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - logical, dimension(:), intent(in) :: lmask !! Logical mask of size self%nbody that determines which bodies to drift. - integer(I4B), dimension(:), intent(out) :: iflag !! Vector of error flags. 0 means no problem + real(DP), dimension(:), intent(in) :: mu + !! Vector of gravitational constants + real(DP), dimension(:,:), intent(inout) :: x, v + !! Position and velocity vectors + integer(I4B), intent(in) :: n + !! number of bodies + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters + real(DP), intent(in) :: dt + !! Stepsize + logical, dimension(:), intent(in) :: lmask + !! Logical mask of size self%nbody that determines which bodies to drift. + integer(I4B), dimension(:), intent(out) :: iflag + !! Vector of error flags. 0 means no problem end subroutine swiftest_drift_all module subroutine swiftest_drift_body(self, nbody_system, param, dt) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize + class(swiftest_body), intent(inout) :: self + !! Swiftest particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters + real(DP), intent(in) :: dt + !! Stepsize end subroutine swiftest_drift_body pure elemental module subroutine swiftest_drift_one(mu, rx, ry, rz, vx, vy, vz, dt, iflag) !$omp declare simd(swiftest_drift_one) implicit none - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body to drift - real(DP), intent(inout) :: rx, ry, rz, vx, vy, vz !! Position and velocity of body to drift - real(DP), intent(in) :: dt !! Step size - integer(I4B), intent(out) :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) + real(DP), intent(in) :: mu + !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body to drift + real(DP), intent(inout) :: rx, ry, rz, vx, vy, vz + !! Position and velocity of body to drift + real(DP), intent(in) :: dt + !! Step size + integer(I4B), intent(out) :: iflag + !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) end subroutine swiftest_drift_one + module subroutine swiftest_drift_cb_rotphase_update(self, param, dt) + + !! Author : Kaustub Anand + + !! subroutine to update the rotation phase of the central body + + !! Units: radians + + !! initial 0 is set at the x-axis + + ! Arguments + class(swiftest_cb), intent(inout) :: self + !! Swiftest central body data structure + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters + real(DP), intent(in) :: dt + !! Stepsize + end subroutine + module subroutine swiftest_driver(integrator, param_file_name, display_style) implicit none - character(len=:), intent(in), allocatable :: integrator !! Symbolic code of the requested integrator - character(len=:), intent(in), allocatable :: param_file_name !! Name of the input parameters file - character(len=:), intent(in), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" + character(len=:), intent(in), allocatable :: integrator + !! Symbolic code of the requested integrator + character(len=:), intent(in), allocatable :: param_file_name + !! Name of the input parameters file + character(len=:), intent(in), allocatable :: display_style + !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" end subroutine swiftest_driver pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest generic body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_gr_kick_getaccb_ns_body pure module subroutine swiftest_gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) implicit none - real(DP), dimension(:), intent(in) :: mu !! Gravitational constant - real(DP), dimension(:,:), intent(in) :: x !! Position vectors - logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which bodies to compute - integer(I4B), intent(in) :: n !! Total number of bodies - real(DP), intent(in) :: inv_c2 !! Inverse speed of light squared: 1 / c**2 - real(DP), dimension(:,:), intent(out) :: agr !! Accelerations + real(DP), dimension(:), intent(in) :: mu + !! Gravitational constant + real(DP), dimension(:,:), intent(in) :: x + !! Position vectors + logical, dimension(:), intent(in) :: lmask + !! Logical mask indicating which bodies to compute + integer(I4B), intent(in) :: n + !! Total number of bodies + real(DP), intent(in) :: inv_c2 + !! Inverse speed of light squared: 1 / c**2 + real(DP), dimension(:,:), intent(out) :: agr + !! Accelerations end subroutine swiftest_gr_kick_getacch pure elemental module subroutine swiftest_gr_p4_pos_kick(inv_c2, rx, ry, rz, vx, vy, vz, dt) implicit none - real(DP), intent(in) :: inv_c2 !! One over speed of light squared (1/c**2) - real(DP), intent(inout) :: rx, ry, rz !! Position vector - real(DP), intent(in) :: vx, vy, vz !! Velocity vector - real(DP), intent(in) :: dt !! Step size + real(DP), intent(in) :: inv_c2 + !! One over speed of light squared (1/c**2) + real(DP), intent(inout) :: rx, ry, rz + !! Position vector + real(DP), intent(in) :: vx, vy, vz + !! Velocity vector + real(DP), intent(in) :: dt + !! Step size end subroutine swiftest_gr_p4_pos_kick pure module subroutine swiftest_gr_pseudovel2vel(param, mu, rh, pv, vh) implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body - real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector - real(DP), dimension(:), intent(in) :: pv !! Pseudovelocity velocity vector - see Saha & Tremain (1994), eq. (32) - real(DP), dimension(:), intent(out) :: vh !! Swiftestcentric velocity vector + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters + real(DP), intent(in) :: mu + !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body + real(DP), dimension(:), intent(in) :: rh + !! Swiftestcentric position vector + real(DP), dimension(:), intent(in) :: pv + !! Pseudovelocity velocity vector - see Saha & Tremain (1994), eq. (32) + real(DP), dimension(:), intent(out) :: vh + !! Swiftestcentric velocity vector end subroutine swiftest_gr_pseudovel2vel pure module subroutine swiftest_gr_pv2vh_body(self, param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest particle object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_gr_pv2vh_body pure module subroutine swiftest_gr_vel2pseudovel(param, mu, rh, vh, pv) implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body - real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector - real(DP), dimension(:), intent(in) :: vh !! Swiftestcentric velocity vector - real(DP), dimension(:), intent(out) :: pv !! Pseudovelocity vector - see Saha & Tremain (1994), eq. (32) + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters + real(DP), intent(in) :: mu + !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body + real(DP), dimension(:), intent(in) :: rh + !! Swiftestcentric position vector + real(DP), dimension(:), intent(in) :: vh + !! Swiftestcentric velocity vector + real(DP), dimension(:), intent(out) :: pv + !! Pseudovelocity vector - see Saha & Tremain (1994), eq. (32) end subroutine swiftest_gr_vel2pseudovel pure module subroutine swiftest_gr_vh2pv_body(self, param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest particle object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_gr_vh2pv_body module subroutine swiftest_io_compact_output(self, param, timer) implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters - class(*), intent(in) :: timer !! Object used for computing elapsed wall time + class(swiftest_nbody_system), intent(in) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Input colleciton of user-defined parameters + class(*), intent(in) :: timer + !! Object used for computing elapsed wall time end subroutine swiftest_io_compact_output module subroutine swiftest_io_conservation_report(self, param, lterminal) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Input colleciton of user-defined parameters - logical, intent(in) :: lterminal !! Indicates whether to output information to the terminal screen + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Input colleciton of user-defined parameters + logical, intent(in) :: lterminal + !! Indicates whether to output information to the terminal screen end subroutine swiftest_io_conservation_report module subroutine swiftest_io_display_run_information(self, param, integration_timer, phase) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - type(walltimer), intent(inout) :: integration_timer !! Object used for computing elapsed wall time - character(len=*), optional, intent(in) :: phase !! One of "first" or "last" + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + type(walltimer), intent(inout) :: integration_timer + !! Object used for computing elapsed wall time + character(len=*), optional, intent(in) :: phase + !! One of "first" or "last" end subroutine swiftest_io_display_run_information module subroutine swiftest_io_dump_param(self, param_file_name) implicit none - class(swiftest_parameters),intent(in) :: self !! Output collection of parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + class(swiftest_parameters),intent(in) :: self + !! Output collection of parameters + character(len=*), intent(in) :: param_file_name + !! Parameter input file name (i.e. param.in) end subroutine swiftest_io_dump_param module subroutine swiftest_io_dump_system(self, param, system_history) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_storage), intent(inout) :: system_history !! Stores the system history between output dumps + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + class(swiftest_storage), intent(inout) :: system_history + !! Stores the system history between output dumps end subroutine swiftest_io_dump_system module subroutine swiftest_io_dump_storage(self, param) implicit none - class(swiftest_storage), intent(inout) :: self !! Swiftest simulation history storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_storage), intent(inout) :: self + !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_dump_storage module subroutine swiftest_io_get_args(integrator, param_file_name, display_style, from_cli) implicit none - character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file - character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - logical, intent(in) :: from_cli !! If true, get command-line arguments. Otherwise, use the values of the input variables + character(len=:), allocatable, intent(inout) :: integrator + !! Symbolic code of the requested integrator + character(len=:), allocatable, intent(inout) :: param_file_name + !! Name of the input parameters file + character(len=:), allocatable, intent(inout) :: display_style + !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + logical, intent(in) :: from_cli + !! If true, get command-line arguments. Otherwise, use the values of the input variables end subroutine swiftest_io_get_args module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) implicit none - character(len=*), intent(in) :: buffer !! Input string buffer - integer(I4B), intent(inout) :: ifirst !! Index of the buffer at which to start the search for a token - integer(I4B), intent(out) :: ilast !! Index of the buffer at the end of the returned token - integer(I4B), intent(out) :: ierr !! Error code - character(len=:), allocatable :: token !! Returned token string + character(len=*), intent(in) :: buffer + !! Input string buffer + integer(I4B), intent(inout) :: ifirst + !! Index of the buffer at which to start the search for a token + integer(I4B), intent(out) :: ilast + !! Index of the buffer at the end of the returned token + integer(I4B), intent(out) :: ierr + !! Error code + character(len=:), allocatable :: token + !! Returned token string end function swiftest_io_get_token module subroutine swiftest_io_log_one_message(file, message) implicit none - character(len=*), intent(in) :: file !! Name of file to log + character(len=*), intent(in) :: file + !! Name of file to log character(len=*), intent(in) :: message end subroutine swiftest_io_log_one_message module subroutine swiftest_io_log_start(param, file, header) implicit none - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - character(len=*), intent(in) :: file !! Name of file to log - character(len=*), intent(in) :: header !! Header to print at top of log file + class(swiftest_parameters), intent(in) :: param + !! Current Swiftest run configuration parameters + character(len=*), intent(in) :: file + !! Name of file to log + character(len=*), intent(in) :: header + !! Header to print at top of log file end subroutine swiftest_io_log_start module subroutine swiftest_io_netcdf_flush(self, param) implicit none - class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_flush module subroutine swiftest_io_netcdf_get_t0_values_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_get_t0_values_system module subroutine swiftest_io_netcdf_get_valid_masks(self, plmask, tpmask, plmmask, Gmtiny) implicit none - class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - logical, dimension(:), allocatable, intent(out) :: plmask !! Logical mask indicating which bodies are massive bodies - logical, dimension(:), allocatable, intent(out) :: tpmask !! Logical mask indicating which bodies are test particles - logical, dimension(:), allocatable, intent(out), optional :: plmmask !! Logical mask indicating which bodies are fully interacting massive bodies - real(DP), intent(in), optional :: Gmtiny !! The cutoff G*mass between semi-interacting and fully interacting massive bodies + class(swiftest_netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset + logical, dimension(:), allocatable, intent(out) :: plmask + !! Logical mask indicating which bodies are massive bodies + logical, dimension(:), allocatable, intent(out) :: tpmask + !! Logical mask indicating which bodies are test particles + logical, dimension(:), allocatable, intent(out), optional :: plmmask + !! Logical mask indicating which bodies are fully interacting massive bodies + real(DP), intent(in), optional :: Gmtiny + !! The cutoff G*mass between semi-interacting and fully interacting massive bodies end subroutine swiftest_io_netcdf_get_valid_masks module subroutine swiftest_io_netcdf_initialize_output(self, param) implicit none - class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_netcdf_parameters), intent(inout) :: self + !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_initialize_output module subroutine swiftest_io_netcdf_open(self, param, readonly) implicit none - class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + class(swiftest_netcdf_parameters), intent(inout) :: self + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + logical, optional, intent(in) :: readonly + !! Logical flag indicating that this should be open read only end subroutine swiftest_io_netcdf_open module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + integer(I4B) :: ierr + !! Error code: returns 0 if the read is successful end function swiftest_io_netcdf_read_frame_system module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_read_hdr_system module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies - logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + logical, dimension(:), intent(in) :: plmask + !! Logical array indicating which index values belong to massive bodies + logical, dimension(:), intent(in) :: tpmask + !! Logical array indicating which index values belong to test particles end subroutine swiftest_io_netcdf_read_particle_info_system module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) implicit none - class(swiftest_body), intent(in) :: self !! Swiftest base object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_body), intent(in) :: self + !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_body module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest base object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_cb), intent(inout) :: self + !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_cb module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_system module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(in) :: self + !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_hdr_system module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) implicit none - class(swiftest_body), intent(in) :: self !! Swiftest particle object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_body), intent(in) :: self + !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_info_body module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest particle object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_cb), intent(in) :: self + !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_info_cb module subroutine swiftest_io_remove_nul_char(string) implicit none - character(len=*), intent(inout) :: string !! String to remove nul characters from + character(len=*), intent(inout) :: string + !! String to remove nul characters from end subroutine swiftest_io_remove_nul_char module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none - class(swiftest_parameters), intent(inout) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + class(swiftest_parameters), intent(inout) :: self + !! Collection of parameters + integer(I4B), intent(in) :: unit + !! File unit number + character(len=*), intent(in) :: iotype + !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed + !! with DT. If you do not include a char-literal-constant, the iotype argument contains only DT. + character(len=*), intent(in) :: v_list(:) + !! The first element passes the integrator code to the reader + integer(I4B), intent(out) :: iostat + !! IO status code + character(len=*), intent(inout) :: iomsg + !! Message to pass if iostat /= 0 end subroutine swiftest_io_param_reader module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) implicit none - class(swiftest_parameters), intent(in) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer(I4B), intent(in) :: v_list(:) !! Not used in this procedure - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + class(swiftest_parameters), intent(in) :: self + !! Collection of parameters + integer(I4B), intent(in) :: unit + !! File unit number + character(len=*), intent(in) :: iotype + !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed + !! with DT. If you do not include a char-literal-constant, the iotype argument contains only DT. + integer(I4B), intent(in) :: v_list(:) + !! Not used in this procedure + integer(I4B), intent(out) :: iostat + !! IO status code + character(len=*), intent(inout) :: iomsg + !! Message to pass if iostat /= 0 end subroutine swiftest_io_param_writer end interface interface io_param_writer_one module subroutine swiftest_io_param_writer_one_char(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - character(len=*), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + character(len=*), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_char module subroutine swiftest_io_param_writer_one_DP(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(DP), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + real(DP), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_DP module subroutine swiftest_io_param_writer_one_DParr(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(DP), dimension(:), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + real(DP), dimension(:), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_DParr module subroutine swiftest_io_param_writer_one_I4B(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I4B), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + integer(I4B), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_I4B module subroutine swiftest_io_param_writer_one_I4Barr(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I4B), dimension(:), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + integer(I4B), dimension(:), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_I4Barr module subroutine swiftest_io_param_writer_one_I8B(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I8B), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + integer(I8B), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_I8B module subroutine swiftest_io_param_writer_one_logical(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - logical, intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + logical, intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_logical #ifdef QUADPREC module subroutine swiftest_io_param_writer_one_QP(param_name, param_value, unit) implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(QP), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + character(len=*), intent(in) :: param_name + !! Name of parameter to print + real(QP), intent(in) :: param_value + !! Value of parameter to print + integer(I4B), intent(in) :: unit + !! Open file unit number to print parameter to end subroutine swiftest_io_param_writer_one_QP #endif end interface io_param_writer_one @@ -864,129 +1341,188 @@ end subroutine swiftest_io_param_writer_one_QP module subroutine swiftest_io_read_in_body(self,param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest base object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_read_in_body module subroutine swiftest_io_read_in_cb(self,param) implicit none - class(swiftest_cb), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_cb), intent(inout) :: self + !! Swiftest base object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_read_in_cb module subroutine swiftest_io_read_in_param(self, param_file_name) implicit none - class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + class(swiftest_parameters), intent(inout) :: self + !! Current run configuration parameters + character(len=*), intent(in) :: param_file_name + !! Parameter input file name (i.e. param.in) end subroutine swiftest_io_read_in_param module subroutine swiftest_io_read_in_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param end subroutine swiftest_io_read_in_system module function swiftest_io_read_frame_body(self, iu, param) result(ierr) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + integer(I4B), intent(inout) :: iu + !! Unit number for the output file to write frame to + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + integer(I4B) :: ierr + !! Error code: returns 0 if the read is successful end function swiftest_io_read_frame_body module function swiftest_io_read_frame_system(self, iu, param) result(ierr) implicit none - class(swiftest_nbody_system),intent(inout) :: self !! Swiftest nbody_system object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + class(swiftest_nbody_system),intent(inout) :: self + !! Swiftest nbody_system object + integer(I4B), intent(inout) :: iu + !! Unit number for the output file to read frame from + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + integer(I4B) :: ierr + !! Error code: returns 0 if the read is successful end function swiftest_io_read_frame_system module subroutine swiftest_io_set_display_param(self, display_style) implicit none - class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters - character(*), intent(in) :: display_style !! Style of the output display + class(swiftest_parameters), intent(inout) :: self + !! Current run configuration parameters + character(*), intent(in) :: display_style + !! Style of the output display end subroutine swiftest_io_set_display_param module subroutine swiftest_io_toupper(string) implicit none - character(*), intent(inout) :: string !! String to make upper case + character(*), intent(inout) :: string + !! String to make upper case end subroutine swiftest_io_toupper module subroutine swiftest_io_initialize_output_file_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_netcdf_parameters), intent(inout) :: nc + !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_io_initialize_output_file_system module subroutine swiftest_kick_getacch_int_pl(self, param) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param + !! Current swiftest run configuration parameters end subroutine swiftest_kick_getacch_int_pl module subroutine swiftest_kick_getacch_int_tp(self, param, GMpl, rhp, npl) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors - integer(I4B), intent(in) :: npl !! Number of active massive bodies + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_parameters), intent(inout) :: param + !! Current swiftest run configuration parameters + real(DP), dimension(:), intent(in) :: GMpl + !! Massive body masses + real(DP), dimension(:,:), intent(in) :: rhp + !! Massive body position vectors + integer(I4B), intent(in) :: npl + !! Number of active massive bodies end subroutine swiftest_kick_getacch_int_tp end interface interface swiftest_kick_getacch_int_all module subroutine swiftest_kick_getacch_int_all_flat_rad_pl(npl, nplpl, k_plpl, r, Gmass, radius, acc) implicit none - integer(I4B), intent(in) :: npl !! Number of massive bodies - integer(I8B), intent(in) :: nplpl !! Number of massive body interactions to compute - integer(I4B), dimension(:,:), intent(in) :: k_plpl !! Array of interaction pair indices (flattened upper triangular matrix) - real(DP), dimension(:,:), intent(in) :: r !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in) :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: npl + !! Number of massive bodies + integer(I8B), intent(in) :: nplpl + !! Number of massive body interactions to compute + integer(I4B), dimension(:,:), intent(in) :: k_plpl + !! Array of interaction pair indices (flattened upper triangular matrix) + real(DP), dimension(:,:), intent(in) :: r + !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass + !! Array of massive body G*mass + real(DP), dimension(:), intent(in) :: radius + !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc + !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_flat_rad_pl module subroutine swiftest_kick_getacch_int_all_flat_norad_pl(npl, nplpl, k_plpl, r, Gmass, acc) implicit none - integer(I4B), intent(in) :: npl !! Number of massive bodies - integer(I8B), intent(in) :: nplpl !! Number of massive body interactions to compute - integer(I4B), dimension(:,:), intent(in) :: k_plpl !! Array of interaction pair indices (flattened upper triangular matrix) - real(DP), dimension(:,:), intent(in) :: r !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: npl + !! Number of massive bodies + integer(I8B), intent(in) :: nplpl + !! Number of massive body interactions to compute + integer(I4B), dimension(:,:), intent(in) :: k_plpl + !! Array of interaction pair indices (flattened upper triangular matrix) + real(DP), dimension(:,:), intent(in) :: r + !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass + !! Array of massive body G*mass + real(DP), dimension(:,:), intent(inout) :: acc + !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_flat_norad_pl module subroutine swiftest_kick_getacch_int_all_tri_rad_pl(npl, nplm, r, Gmass, radius, acc) implicit none - integer(I4B), intent(in) :: npl !! Total number of massive bodies - integer(I4B), intent(in) :: nplm !! Number of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: r !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in) :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: npl + !! Total number of massive bodies + integer(I4B), intent(in) :: nplm + !! Number of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: r + !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass + !! Array of massive body G*mass + real(DP), dimension(:), intent(in) :: radius + !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc + !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_tri_rad_pl module subroutine swiftest_kick_getacch_int_all_tri_norad_pl(npl, nplm, r, Gmass, acc) implicit none - integer(I4B), intent(in) :: npl !! Total number of massive bodies - integer(I4B), intent(in) :: nplm !! Number of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: r !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: npl + !! Total number of massive bodies + integer(I4B), intent(in) :: nplm + !! Number of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: r + !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass + !! Array of massive body G*mass + real(DP), dimension(:,:), intent(inout) :: acc + !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_tri_norad_pl module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, rtp, rpl, GMpl, lmask, acc) implicit none - integer(I4B), intent(in) :: ntp !! Number of test particles - integer(I4B), intent(in) :: npl !! Number of massive bodies - real(DP), dimension(:,:), intent(in) :: rtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: rpl !! Massive body particle position vector array - real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass - logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: ntp + !! Number of test particles + integer(I4B), intent(in) :: npl + !! Number of massive bodies + real(DP), dimension(:,:), intent(in) :: rtp + !! Test particle position vector array + real(DP), dimension(:,:), intent(in) :: rpl + !! Massive body particle position vector array + real(DP), dimension(:), intent(in) :: GMpl + !! Array of massive body G*mass + logical, dimension(:), intent(in) :: lmask + !! Logical mask indicating which test particles should be computed + real(DP), dimension(:,:), intent(inout) :: acc + !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_tp end interface @@ -994,57 +1530,97 @@ end subroutine swiftest_kick_getacch_int_all_tp pure module subroutine swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) !$omp declare simd(swiftest_kick_getacch_int_one_pl) implicit none - real(DP), intent(in) :: rji2 !! Square of distance between the two bodies - real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions - real(DP), intent(in) :: Gmi !! G*mass of body i - real(DP), intent(in) :: Gmj !! G*mass of body j - real(DP), intent(inout) :: axi, ayi, azi !! Acceleration vector components of body i - real(DP), intent(inout) :: axj, ayj, azj !! Acceleration vector components of body j + real(DP), intent(in) :: rji2 + !! Square of distance between the two bodies + real(DP), intent(in) :: xr, yr, zr + !! Distances between the two bodies in x, y, and z directions + real(DP), intent(in) :: Gmi + !! G*mass of body i + real(DP), intent(in) :: Gmj + !! G*mass of body j + real(DP), intent(inout) :: axi, ayi, azi + !! Acceleration vector components of body i + real(DP), intent(inout) :: axj, ayj, azj + !! Acceleration vector components of body j end subroutine swiftest_kick_getacch_int_one_pl pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, ax, ay, az) !$omp declare simd(swiftest_kick_getacch_int_one_tp) implicit none - real(DP), intent(in) :: rji2 !! Square of distance between the test particle and massive body - real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions - real(DP), intent(in) :: Gmpl !! G*mass of massive body - real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle + real(DP), intent(in) :: rji2 + !! Square of distance between the test particle and massive body + real(DP), intent(in) :: xr, yr, zr + !! Distances between the two bodies in x, y, and z directions + real(DP), intent(in) :: Gmpl + !! G*mass of massive body + real(DP), intent(inout) :: ax, ay, az + !! Acceleration vector components of test particle end subroutine swiftest_kick_getacch_int_one_tp - module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, GMpl, aoblcb) - implicit none - integer(I4B), intent(in) :: n !! Number of bodies - real(DP), intent(in) :: GMcb !! Central body G*Mass - real(DP), intent(in) :: j2rp2 !! J2 * R**2 for the central body - real(DP), intent(in) :: j4rp4 !! J4 * R**4 for the central body - real(DP), dimension(:,:), intent(in) :: rh !! Heliocentric positions of bodies - logical, dimension(:), intent(in) :: lmask !! Logical mask of bodies to compute aobl - real(DP), dimension(:,:), intent(out) :: aobl !! Barycentric acceleration of bodies due to central body oblateness - real(DP), dimension(:), intent(in), optional :: GMpl !! Masses of input bodies if they are not test particles - real(DP), dimension(:), intent(out), optional :: aoblcb !! Barycentric acceleration of central body (only needed if input bodies are massive) + module subroutine swiftest_obl_rot_matrix(n, rot, rot_matrix, rot_matrix_inv) + implicit none + integer(I4B), intent(in) :: n + !! Number of bodies + real(DP), dimension(NDIM), intent(in) :: rot + !! Central body rotation vector + real(DP), dimension(NDIM, NDIM), intent(inout) :: rot_matrix + !! rotation matrix + real(DP), dimension(NDIM, NDIM), intent(inout) :: rot_matrix_inv + !! inverse of the rotation matrix + end subroutine swiftest_obl_rot_matrix + + module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, rot, GMpl, aoblcb) + implicit none + integer(I4B), intent(in) :: n + !! Number of bodies + real(DP), intent(in) :: GMcb + !! Central body G*Mass + real(DP), intent(in) :: j2rp2 + !! J2 * R**2 for the central body + real(DP), intent(in) :: j4rp4 + !! J4 * R**4 for the central body + real(DP), dimension(:,:), intent(in) :: rh + !! Heliocentric positions of bodies + logical, dimension(:), intent(in) :: lmask + !! Logical mask of bodies to compute aobl + real(DP), dimension(:,:), intent(out) :: aobl + !! Barycentric acceleration of bodies due to central body oblateness + real(DP), dimension(NDIM), intent(in) :: rot + !! Central body rotation matrix + real(DP), dimension(:), intent(in), optional :: GMpl + !! Masses of input bodies if they are not test particles + real(DP), dimension(:), intent(out), optional :: aoblcb + !! Barycentric acceleration of central body (only needed if input bodies are massive) end subroutine swiftest_obl_acc - module subroutine swiftest_obl_acc_pl(self, nbody_system) + module subroutine swiftest_non_spherical_cb_acc_pl(self, nbody_system) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - end subroutine swiftest_obl_acc_pl + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + end subroutine swiftest_non_spherical_cb_acc_pl - module subroutine swiftest_obl_acc_tp(self, nbody_system) + module subroutine swiftest_non_spherical_cb_acc_tp(self, nbody_system) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - end subroutine swiftest_obl_acc_tp + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + end subroutine swiftest_non_spherical_cb_acc_tp module subroutine swiftest_obl_pot_system(self) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object end subroutine swiftest_obl_pot_system module subroutine swiftest_orbel_el2xv_vec(self, cb) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_orbel_el2xv_vec pure module subroutine swiftest_orbel_scget(angle, sx, cx) @@ -1057,198 +1633,288 @@ end subroutine swiftest_orbel_scget pure elemental module subroutine swiftest_orbel_xv2aeq(mu, rx, ry, rz, vx, vy, vz, a, e, q) !$omp declare simd(swiftest_orbel_xv2aeq) implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: rx,ry,rz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: e !! eccentricity - real(DP), intent(out) :: q !! periapsis + real(DP), intent(in) :: mu + !! Gravitational constant + real(DP), intent(in) :: rx,ry,rz + !! Position vector + real(DP), intent(in) :: vx,vy,vz + !! Velocity vector + real(DP), intent(out) :: a + !! semimajor axis + real(DP), intent(out) :: e + !! eccentricity + real(DP), intent(out) :: q + !! periapsis end subroutine swiftest_orbel_xv2aeq pure module subroutine swiftest_orbel_xv2aqt(mu, rx, ry, rz, vx, vy, vz, a, q, capm, tperi) !$omp declare simd(swiftest_orbel_xv2aqt) implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: rx,ry,rz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: q !! periapsis - real(DP), intent(out) :: capm !! mean anomaly - real(DP), intent(out) :: tperi !! time of pericenter passage + real(DP), intent(in) :: mu + !! Gravitational constant + real(DP), intent(in) :: rx,ry,rz + !! Position vector + real(DP), intent(in) :: vx,vy,vz + !! Velocity vector + real(DP), intent(out) :: a + !! semimajor axis + real(DP), intent(out) :: q + !! periapsis + real(DP), intent(out) :: capm + !! mean anomaly + real(DP), intent(out) :: tperi + !! time of pericenter passage end subroutine swiftest_orbel_xv2aqt - pure module subroutine swiftest_orbel_xv2el(mu, rx, ry, rz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: rx,ry,rz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: e !! eccentricity - real(DP), intent(out) :: inc !! inclination - real(DP), intent(out) :: capom !! longitude of ascending node - real(DP), intent(out) :: omega !! argument of periapsis - real(DP), intent(out) :: capm !! mean anomaly - real(DP), intent(out) :: varpi !! longitude of periapsis - real(DP), intent(out) :: lam !! mean longitude - real(DP), intent(out) :: f !! true anomaly - real(DP), intent(out) :: cape !! eccentric anomaly (eccentric orbits) - real(DP), intent(out) :: capf !! hyperbolic anomaly (hyperbolic orbits) + pure module subroutine swiftest_orbel_xv2el(mu, rx, ry, rz, vx, vy, vz, & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + implicit none + real(DP), intent(in) :: mu + !! Gravitational constant + real(DP), intent(in) :: rx,ry,rz + !! Position vector + real(DP), intent(in) :: vx,vy,vz + !! Velocity vector + real(DP), intent(out) :: a + !! semimajor axis + real(DP), intent(out) :: e + !! eccentricity + real(DP), intent(out) :: inc + !! inclination + real(DP), intent(out) :: capom + !! longitude of ascending node + real(DP), intent(out) :: omega + !! argument of periapsis + real(DP), intent(out) :: capm + !! mean anomaly + real(DP), intent(out) :: varpi + !! longitude of periapsis + real(DP), intent(out) :: lam + !! mean longitude + real(DP), intent(out) :: f + !! true anomaly + real(DP), intent(out) :: cape + !! eccentric anomaly (eccentric orbits) + real(DP), intent(out) :: capf + !! hyperbolic anomaly (hyperbolic orbits) end subroutine swiftest_orbel_xv2el module subroutine swiftest_orbel_xv2el_vec(self, cb) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_orbel_xv2el_vec module subroutine swiftest_util_setup_body(self, n, param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_util_setup_body module subroutine swiftest_util_setup_construct_system(nbody_system, param) implicit none - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system + !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_util_setup_construct_system module subroutine swiftest_util_setup_initialize_particle_info_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_util_setup_initialize_particle_info_system module subroutine swiftest_util_setup_initialize_system(self, system_history, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object + class(swiftest_storage), allocatable, intent(inout) :: system_history + !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_util_setup_initialize_system module subroutine swiftest_util_setup_pl(self, n, param) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_util_setup_pl module subroutine swiftest_util_setup_tp(self, n, param) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parametersr end subroutine swiftest_util_setup_tp module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + class(swiftest_body), intent(inout) :: self + !! Swiftest massive body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody_system_object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + real(DP), intent(in) :: t + !! Current time + logical, intent(in) :: lbeg + !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine swiftest_user_kick_getacch_body end interface interface util_append module subroutine swiftest_util_append_arr_info(arr, source, nold, lsource_mask) implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_arr_info module subroutine swiftest_util_append_arr_kin(arr, source, nold, lsource_mask) implicit none - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. - logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source + !! Array to append + integer(I4B), intent(in), optional :: nold + !! Extent of original array. If passed, the source array will begin at arr(nold+1). + !! Otherwise, the size of arr will be used. + logical, dimension(:), intent(in), optional :: lsource_mask + !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_arr_kin end interface interface module subroutine swiftest_util_append_body(self, source, lsource_mask) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_body module subroutine swiftest_util_append_pl(self, source, lsource_mask) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_pl module subroutine swiftest_util_append_tp(self, source, lsource_mask) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to end subroutine swiftest_util_append_tp module subroutine swiftest_util_coord_b2h_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_b2h_pl module subroutine swiftest_util_coord_b2h_tp(self, cb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_b2h_tp module subroutine swiftest_util_coord_h2b_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_h2b_pl module subroutine swiftest_util_coord_h2b_tp(self, cb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_h2b_tp module subroutine swiftest_util_coord_vb2vh_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_vb2vh_pl module subroutine swiftest_util_coord_vb2vh_tp(self, vbcb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb + !! Barycentric velocity of the central body end subroutine swiftest_util_coord_vb2vh_tp module subroutine swiftest_util_coord_vh2vb_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_vh2vb_pl module subroutine swiftest_util_coord_vh2vb_tp(self, vbcb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb + !! Barycentric velocity of the central body end subroutine swiftest_util_coord_vh2vb_tp module subroutine swiftest_util_coord_rh2rb_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_rh2rb_pl module subroutine swiftest_util_coord_rh2rb_tp(self, cb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb + !! Swiftest central body object end subroutine swiftest_util_coord_rh2rb_tp module subroutine swiftest_util_copy_particle_info(self, source) @@ -1259,9 +1925,12 @@ end subroutine swiftest_util_copy_particle_info module subroutine swiftest_util_copy_particle_info_arr(source, dest, idx) implicit none - class(swiftest_particle_info), dimension(:), intent(in) :: source !! Source object to copy into - class(swiftest_particle_info), dimension(:), intent(inout) :: dest !! Swiftest body object with particle metadata information object - integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object + class(swiftest_particle_info), dimension(:), intent(in) :: source + !! Source object to copy into + class(swiftest_particle_info), dimension(:), intent(inout) :: dest + !! Swiftest body object with particle metadata information object + integer(I4B), dimension(:), intent(in), optional :: idx + !! Optional array of indices to draw the source object end subroutine swiftest_util_copy_particle_info_arr module subroutine swiftest_util_dealloc_body(self) @@ -1271,12 +1940,14 @@ end subroutine swiftest_util_dealloc_body module subroutine swiftest_util_dealloc_kin(self) implicit none - class(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + class(swiftest_kinship), intent(inout) :: self + !! Swiftest kinship object end subroutine swiftest_util_dealloc_kin module subroutine swiftest_util_dealloc_cb(self) implicit none - class(swiftest_cb), intent(inout) :: self !! Swiftest central body object + class(swiftest_cb), intent(inout) :: self + !! Swiftest central body object end subroutine swiftest_util_dealloc_cb module subroutine swiftest_util_dealloc_pl(self) @@ -1286,7 +1957,8 @@ end subroutine swiftest_util_dealloc_pl module subroutine swiftest_util_dealloc_storage(self) implicit none - class(swiftest_storage), intent(inout) :: self !! Swiftest storage object + class(swiftest_storage), intent(inout) :: self + !! Swiftest storage object end subroutine swiftest_util_dealloc_storage module subroutine swiftest_util_dealloc_system(self) @@ -1301,39 +1973,54 @@ end subroutine swiftest_util_dealloc_tp module subroutine swiftest_util_fill_body(self, inserts, lfill_list) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_body), intent(in) :: inserts + !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_body module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_body), intent(in) :: inserts + !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_pl module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_body), intent(in) :: inserts + !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_tp end interface interface util_fill module subroutine swiftest_util_fill_arr_info(keeps, inserts, lfill_list) implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_arr_info module subroutine swiftest_util_fill_arr_kin(keeps, inserts, lfill_list) implicit none - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: inserts + !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_arr_kin end interface @@ -1341,43 +2028,60 @@ end subroutine swiftest_util_fill_arr_kin pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) !$omp declare simd(swiftest_util_flatten_eucl_ij_to_k) implicit none - integer(I4B), intent(in) :: n !! Number of bodies - integer(I4B), intent(in) :: i !! Index of the ith body - integer(I4B), intent(in) :: j !! Index of the jth body - integer(I8B), intent(out) :: k !! Index of the flattened matrix + integer(I4B), intent(in) :: n + !! Number of bodies + integer(I4B), intent(in) :: i + !! Index of the ith body + integer(I4B), intent(in) :: j + !! Index of the jth body + integer(I8B), intent(out) :: k + !! Index of the flattened matrix end subroutine swiftest_util_flatten_eucl_ij_to_k pure module subroutine swiftest_util_flatten_eucl_k_to_ij(n, k, i, j) implicit none - integer(I4B), intent(in) :: n !! Number of bodies - integer(I8B), intent(in) :: k !! Index of the flattened matrix - integer(I4B), intent(out) :: i !! Index of the ith body - integer(I4B), intent(out) :: j !! Index of the jth body + integer(I4B), intent(in) :: n + !! Number of bodies + integer(I8B), intent(in) :: k + !! Index of the flattened matrix + integer(I4B), intent(out) :: i + !! Index of the ith body + integer(I4B), intent(out) :: j + !! Index of the jth body end subroutine swiftest_util_flatten_eucl_k_to_ij module subroutine swiftest_util_flatten_eucl_plpl(self, param) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine module subroutine swiftest_util_flatten_eucl_pltp(self, pl, param) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_pl), intent(in) :: pl + !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine module subroutine swiftest_util_get_energy_and_momentum_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_util_get_energy_and_momentum_system module subroutine swiftest_util_get_idvalues_system(self, idvals) implicit none - class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + class(swiftest_nbody_system), intent(in) :: self + !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals + !! Array of all id values saved in this snapshot end subroutine swiftest_util_get_idvalues_system end interface @@ -1409,71 +2113,111 @@ end subroutine swiftest_util_get_potential_energy_triangular interface module subroutine swiftest_util_get_vals_storage(self, idvals, tvals) - class(swiftest_storage), intent(in) :: self !! Swiftest storage object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots - real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + class(swiftest_storage), intent(in) :: self + !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals + !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals + !! Array of all time values in all snapshots end subroutine swiftest_util_get_vals_storage module subroutine swiftest_util_index_array(ind_arr, n) implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] - integer(I4B), intent(in) :: n !! The new size of the index array + integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr + !! Index array. Input is a pre-existing index array where n /= size(ind_arr). + !! Output is a new index array ind_arr = [1, 2, ... n] + integer(I4B), intent(in) :: n + !! The new size of the index array end subroutine swiftest_util_index_array module subroutine swiftest_util_index_map_storage(self) implicit none - class(swiftest_storage), intent(inout) :: self !! Swiftest storage object + class(swiftest_storage), intent(inout) :: self + !! Swiftest storage object end subroutine swiftest_util_index_map_storage module subroutine swiftest_util_make_impactors_pl(self, idx) implicit none - class(swiftest_pl), intent(inout) :: self !! Massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision) + class(swiftest_pl), intent(inout) :: self + !! Massive body object + integer(I4B), dimension(:), intent(in) :: idx + !! Array holding the indices of the two bodies involved in the collision) end subroutine swiftest_util_make_impactors_pl module subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) implicit none - integer(I4B), intent(in) :: n !! Number of bodies - real(DP), dimension(:), intent(in) :: m !! Mass term (mu for HELIO coordinates, and Gmtot for BARY) - real(DP), dimension(:,:), intent(in) :: r !! Position vectors (rh for HELIO coordinates, rb for BARY) - real(DP), dimension(:,:), intent(in) :: v !! Position vectors (vh for HELIO coordinates, rb for BARY) - real(DP), dimension(:), intent(out) :: atp !! Semimajor axis - real(DP), dimension(:), intent(out) :: q !! Periapsis - integer(I4B), dimension(:), intent(inout) :: isperi !! Periapsis passage flag + integer(I4B), intent(in) :: n + !! Number of bodies + real(DP), dimension(:), intent(in) :: m + !! Mass term (mu for HELIO coordinates, and Gmtot for BARY) + real(DP), dimension(:,:), intent(in) :: r + !! Position vectors (rh for HELIO coordinates, rb for BARY) + real(DP), dimension(:,:), intent(in) :: v + !! Position vectors (vh for HELIO coordinates, rb for BARY) + real(DP), dimension(:), intent(out) :: atp + !! Semimajor axis + real(DP), dimension(:), intent(out) :: q + !! Periapsis + integer(I4B), dimension(:), intent(inout) :: isperi + !! Periapsis passage flag end subroutine swiftest_util_peri module subroutine swiftest_util_peri_body(self, nbody_system, param) implicit none - class(swiftest_body), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_body), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_util_peri_body module subroutine swiftest_util_peri_tp(self, nbody_system, param) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameters end subroutine swiftest_util_peri_tp module subroutine swiftest_util_rearray_pl(self, nbody_system, param) implicit none - class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_util_rearray_pl + module subroutine swiftest_util_rearray_tp(self, nbody_system, param) + implicit none + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + end subroutine swiftest_util_rearray_tp + module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tscale) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU - real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters. Returns with new values of the scale vactors and GU + real(DP), intent(in) :: mscale, dscale, tscale + !! Scale factors for mass, distance, and time units, respectively. end subroutine swiftest_util_rescale_system module subroutine swiftest_util_reset_kinship_pl(self, idx) implicit none - class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset + class(swiftest_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: idx + !! Index array of bodies to reset end subroutine swiftest_util_reset_kinship_pl end interface @@ -1482,130 +2226,180 @@ end subroutine swiftest_util_reset_kinship_pl interface util_resize module subroutine swiftest_util_resize_arr_info(arr, nnew) implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size end subroutine swiftest_util_resize_arr_info module subroutine swiftest_util_resize_arr_kin(arr, nnew) implicit none - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr + !! Array to resize + integer(I4B), intent(in) :: nnew + !! New size end subroutine swiftest_util_resize_arr_kin end interface interface module subroutine swiftest_util_resize_body(self, nnew) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + integer(I4B), intent(in) :: nnew + !! New size neded end subroutine swiftest_util_resize_body module subroutine swiftest_util_resize_pl(self, nnew) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: nnew !! New size neded + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + integer(I4B), intent(in) :: nnew + !! New size neded end subroutine swiftest_util_resize_pl module subroutine swiftest_util_resize_storage(storage, nold, nnew) use base, only : base_storage implicit none - class(base_storage), allocatable, intent(inout) :: storage !! Original storage object - integer(I4B), intent(in) :: nold !! Old size - integer(I4B), intent(in) :: nnew !! New size + class(base_storage), allocatable, intent(inout) :: storage + !! Original storage object + integer(I4B), intent(in) :: nold + !! Old size + integer(I4B), intent(in) :: nnew + !! New size end subroutine swiftest_util_resize_storage module subroutine swiftest_util_resize_tp(self, nnew) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: nnew !! New size neded + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + integer(I4B), intent(in) :: nnew + !! New size neded end subroutine swiftest_util_resize_tp module subroutine swiftest_util_set_beg_end_pl(self, rbeg, rend, vbeg) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: rbeg !! Position vectors at beginning of step - real(DP), dimension(:,:), intent(in), optional :: rend !! Positions vectors at end of step - real(DP), dimension(:,:), intent(in), optional :: vbeg !! vbeg is an unused variable to keep this method forward compatible with RMVS + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + real(DP), dimension(:,:), intent(in), optional :: rbeg + !! Position vectors at beginning of step + real(DP), dimension(:,:), intent(in), optional :: rend + !! Positions vectors at end of step + real(DP), dimension(:,:), intent(in), optional :: vbeg + !! vbeg is an unused variable to keep this method forward compatible with RMVS end subroutine swiftest_util_set_beg_end_pl module subroutine swiftest_util_set_ir3h(self) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(inout) :: self + !! Swiftest body object end subroutine swiftest_util_set_ir3h module subroutine swiftest_util_set_msys(self) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody_system object end subroutine swiftest_util_set_msys module subroutine swiftest_util_set_mu_pl(self, cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_set_mu_pl module subroutine swiftest_util_set_mu_tp(self, cb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_set_mu_tp module subroutine swiftest_util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, & origin_rh, origin_vh, discard_time, discard_rh, discard_vh, discard_body_id) implicit none class(swiftest_particle_info), intent(inout) :: self - character(len=*), intent(in), optional :: name !! Non-unique name - character(len=*), intent(in), optional :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) - character(len=*), intent(in), optional :: status !! Particle status description: Active, Merged, Fragmented, etc. - character(len=*), intent(in), optional :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) - real(DP), intent(in), optional :: origin_time !! The time of the particle's formation - integer(I4B), intent(in), optional :: collision_id !! The ID fo the collision that formed the particle - real(DP), dimension(:), intent(in), optional :: origin_rh !! The heliocentric distance vector at the time of the particle's formation - real(DP), dimension(:), intent(in), optional :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation - real(DP), intent(in), optional :: discard_time !! The time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_rh !! The heliocentric distance vector at the time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard - integer(I4B), intent(in), optional :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) + character(len=*), intent(in), optional :: name + !! Non-unique name + character(len=*), intent(in), optional :: particle_type + !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) + character(len=*), intent(in), optional :: status + !! Particle status description: Active, Merged, Fragmented, etc. + character(len=*), intent(in), optional :: origin_type + !! String containing a description of the origin of the particle (e.g. Initial Conditions, Disruption, etc.) + real(DP), intent(in), optional :: origin_time + !! The time of the particle's formation + integer(I4B), intent(in), optional :: collision_id + !! The ID fo the collision that formed the particle + real(DP), dimension(:), intent(in), optional :: origin_rh + !! The heliocentric distance vector at the time of the particle's formation + real(DP), dimension(:), intent(in), optional :: origin_vh + !! The heliocentric velocity vector at the time of the particle's formation + real(DP), intent(in), optional :: discard_time + !! The time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_rh + !! The heliocentric distance vector at the time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_vh + !! The heliocentric velocity vector at the time of the particle's discard + integer(I4B), intent(in), optional :: discard_body_id + !! The id of the other body involved in the discard (0 if no other body involved) end subroutine swiftest_util_set_particle_info module subroutine swiftest_util_set_rhill(self,cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_set_rhill module subroutine swiftest_util_set_renc_I4B(self, scale) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + integer(I4B), intent(in) :: scale + !! Input scale factor (multiplier of Hill's sphere size) end subroutine swiftest_util_set_renc_I4B module subroutine swiftest_util_set_renc_DP(self, scale) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + real(DP), intent(in) :: scale + !! Input scale factor (multiplier of Hill's sphere size) end subroutine swiftest_util_set_renc_DP module subroutine swiftest_util_set_rhill_approximate(self,cb) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb + !! Swiftest central body object end subroutine swiftest_util_set_rhill_approximate module subroutine swiftest_util_snapshot_save(storage, snapshot) use base, only : base_storage implicit none - class(base_storage), allocatable, intent(inout) :: storage !! Storage ncounter storage object - class(*), intent(in) :: snapshot !! Object to snapshot + class(base_storage), allocatable, intent(inout) :: storage + !! Storage ncounter storage object + class(*), intent(in) :: snapshot + !! Object to snapshot end subroutine swiftest_util_snapshot_save module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) implicit none - class(swiftest_storage), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + class(swiftest_storage), intent(inout) :: self + !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t + !! Time of snapshot if different from nbody_system time + character(*), intent(in), optional :: arg + !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine swiftest_util_snapshot_system end interface @@ -1613,16 +2407,22 @@ end subroutine swiftest_util_snapshot_system interface util_sort_rearrange module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange end subroutine swiftest_util_sort_rearrange_arr_info pure module subroutine swiftest_util_sort_rearrange_arr_kin(arr, ind, n) implicit none - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr + !! Destination array + integer(I4B), dimension(:), intent(in) :: ind + !! Index to rearrange against + integer(I4B), intent(in) :: n + !! Number of elements in arr and ind to rearrange end subroutine swiftest_util_sort_rearrange_arr_kin end interface util_sort_rearrange @@ -1630,41 +2430,56 @@ end subroutine swiftest_util_sort_rearrange_arr_kin interface module subroutine swiftest_util_sort_rearrange_body(self, ind) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) end subroutine swiftest_util_sort_rearrange_body module subroutine swiftest_util_sort_rearrange_pl(self, ind) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) end subroutine swiftest_util_sort_rearrange_pl module subroutine swiftest_util_sort_rearrange_tp(self, ind) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) end subroutine swiftest_util_sort_rearrange_tp module subroutine swiftest_util_sort_body(self, sortby, ascending) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine swiftest_util_sort_body module subroutine swiftest_util_sort_pl(self, sortby, ascending) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(swiftest_pl), intent(inout) :: self + !! Swiftest body object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine swiftest_util_sort_pl module subroutine swiftest_util_sort_tp(self, sortby, ascending) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(swiftest_tp), intent(inout) :: self + !! Swiftest body object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine swiftest_util_sort_tp end interface @@ -1672,44 +2487,64 @@ end subroutine swiftest_util_sort_tp interface util_spill module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, ldestructive) implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_arr_info module subroutine swiftest_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) implicit none - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps + !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: discards + !! Array of discards + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_arr_kin end interface interface module subroutine swiftest_util_spill_body(self, discards, lspill_list, ldestructive) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + class(swiftest_body), intent(inout) :: self + !! Swiftest body object + class(swiftest_body), intent(inout) :: discards + !! Discarded object + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_body module subroutine swiftest_util_spill_pl(self, discards, lspill_list, ldestructive) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + class(swiftest_pl), intent(inout) :: self + !! Swiftest massive body object + class(swiftest_body), intent(inout) :: discards + !! Discarded object + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_pl module subroutine swiftest_util_spill_tp(self, discards, lspill_list, ldestructive) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + class(swiftest_tp), intent(inout) :: self + !! Swiftest test particle object + class(swiftest_body), intent(inout) :: discards + !! Discarded object + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_tp end interface @@ -1717,8 +2552,10 @@ end subroutine swiftest_util_spill_tp interface module subroutine swiftest_util_valid_id_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: self + !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_util_valid_id_system module subroutine swiftest_util_version() @@ -1731,24 +2568,30 @@ end subroutine swiftest_util_version module subroutine swiftest_coarray_balance_system(nbody_system, param) !! author: David A. Minton !! - !! Checks whether or not the system needs to be rebalance. Rebalancing occurs when the image with the smallest number of test particles - !! has <90% of that of the image with the largest number of test particles. + !! Checks whether or not the system needs to be rebalance. Rebalancing occurs when the image with the smallest number of + !! test particles has <90% of that of the image with the largest number of test particles. implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_coarray_balance_system module subroutine swiftest_coarray_collect_system(nbody_system, param) implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_coarray_collect_system module subroutine swiftest_coarray_distribute_system(nbody_system, param) implicit none - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: nbody_system + !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters end subroutine swiftest_coarray_distribute_system end interface @@ -1783,49 +2626,56 @@ module subroutine swiftest_coarray_component_collect_info_arr1D(var,dest_img) interface module subroutine swiftest_coarray_coclone_body(self) implicit none - class(swiftest_body),intent(inout),codimension[*] :: self !! Swiftest body object + class(swiftest_body),intent(inout),codimension[*] :: self + !! Swiftest body object end subroutine swiftest_coarray_coclone_body module subroutine swiftest_coarray_coclone_cb(self) implicit none - class(swiftest_cb),intent(inout),codimension[*] :: self !! Swiftest cb object + class(swiftest_cb),intent(inout),codimension[*] :: self + !! Swiftest cb object end subroutine swiftest_coarray_coclone_cb module subroutine swiftest_coarray_coclone_kin(self) implicit none - class(swiftest_kinship),intent(inout),codimension[*] :: self !! Swiftest kinship object + class(swiftest_kinship),intent(inout),codimension[*] :: self + !! Swiftest kinship object end subroutine swiftest_coarray_coclone_kin module subroutine swiftest_coarray_coclone_nc(self) implicit none - class(swiftest_netcdf_parameters),intent(inout),codimension[*] :: self !! Swiftest body object + class(swiftest_netcdf_parameters),intent(inout),codimension[*] :: self + !! Swiftest body object end subroutine swiftest_coarray_coclone_nc module subroutine swiftest_coarray_coclone_pl(self) implicit none - class(swiftest_pl),intent(inout),codimension[*] :: self !! Swiftest pl object + class(swiftest_pl),intent(inout),codimension[*] :: self + !! Swiftest pl object end subroutine swiftest_coarray_coclone_pl module subroutine swiftest_coarray_coclone_tp(self) implicit none - class(swiftest_tp),intent(inout),codimension[*] :: self !! Swiftest tp object + class(swiftest_tp),intent(inout),codimension[*] :: self + !! Swiftest tp object end subroutine swiftest_coarray_coclone_tp module subroutine swiftest_coarray_coclone_system(self) implicit none - class(swiftest_nbody_system),intent(inout),codimension[*] :: self !! Swiftest nbody system object + class(swiftest_nbody_system),intent(inout),codimension[*] :: self + !! Swiftest nbody system object end subroutine swiftest_coarray_coclone_system module subroutine swiftest_coarray_cocollect_body(self) - !! Collects all body object array components from all images and combines them into the image 1 body object implicit none - class(swiftest_body),intent(inout), codimension[*] :: self !! Swiftest body object + class(swiftest_body),intent(inout), codimension[*] :: self + !! Swiftest body object end subroutine swiftest_coarray_cocollect_body module subroutine swiftest_coarray_cocollect_tp(self) - !! Collects all body object array components from all images and combines them into the image 1 body object implicit none - class(swiftest_tp),intent(inout), codimension[*] :: self !! Swiftest tp object + class(swiftest_tp),intent(inout), codimension[*] :: self + !! Swiftest tp object end subroutine swiftest_coarray_cocollect_tp end interface @@ -1833,12 +2683,16 @@ end subroutine swiftest_coarray_cocollect_tp contains subroutine swiftest_final_kin(self) - !! author: David A. Minton - !! - !! Finalize the swiftest kinship object - deallocates all allocatables + + !! author: David A. Minton + + !! + + !! Finalize the swiftest kinship object - deallocates all allocatables implicit none ! Argument - type(swiftest_kinship), intent(inout) :: self !! SyMBA kinship object + type(swiftest_kinship), intent(inout) :: self + !! SyMBA kinship object call self%dealloc() @@ -1847,9 +2701,12 @@ end subroutine swiftest_final_kin subroutine swiftest_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer for the storage data type + + !! author: David A. Minton + + !! + + !! Finalizer for the storage data type implicit none ! Arguments type(swiftest_storage) :: self diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index ab7569187..42c03eb91 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -8,9 +8,119 @@ ! If not, see: https://www.gnu.org/licenses. submodule (swiftest) s_swiftest_obl + use swiftest + use shgrav + contains - module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, GMpl, aoblcb) - !! author: David A. Minton + + pure function matinv3(A) result(B) + !! Performs a direct calculation of the inverse of a 3×3 matrix. + !! + !! from https://fortranwiki.org/fortran/show/Matrix+inversion + !! + + real(DP), intent(in) :: A(3,3) !! Matrix + real(DP) :: B(3,3) !! Inverse matrix + real(DP) :: detinv + + ! Calculate the inverse determinant of the matrix + detinv = 1.0_DP/(A(1,1)*A(2,2)*A(3,3) - A(1,1)*A(2,3)*A(3,2)& + - A(1,2)*A(2,1)*A(3,3) + A(1,2)*A(2,3)*A(3,1)& + + A(1,3)*A(2,1)*A(3,2) - A(1,3)*A(2,2)*A(3,1)) + + ! Calculate the inverse of the matrix + B(1,1) = +detinv * (A(2,2)*A(3,3) - A(2,3)*A(3,2)) + B(2,1) = -detinv * (A(2,1)*A(3,3) - A(2,3)*A(3,1)) + B(3,1) = +detinv * (A(2,1)*A(3,2) - A(2,2)*A(3,1)) + B(1,2) = -detinv * (A(1,2)*A(3,3) - A(1,3)*A(3,2)) + B(2,2) = +detinv * (A(1,1)*A(3,3) - A(1,3)*A(3,1)) + B(3,2) = -detinv * (A(1,1)*A(3,2) - A(1,2)*A(3,1)) + B(1,3) = +detinv * (A(1,2)*A(2,3) - A(1,3)*A(2,2)) + B(2,3) = -detinv * (A(1,1)*A(2,3) - A(1,3)*A(2,1)) + B(3,3) = +detinv * (A(1,1)*A(2,2) - A(1,2)*A(2,1)) + end function + + + module subroutine swiftest_obl_rot_matrix(n, rot, rot_matrix, rot_matrix_inv) + !! author: Kaustub P. Anand + !! + !! Generate a rotation matrix and its inverse to rotate the coordinate frame to align the rotation axis along the z axis for + !! correct spin calculation + !! + + implicit none + ! Arguments + integer(I4B), intent(in) :: n !! Number of bodies + real(DP), dimension(NDIM), intent(in) :: rot !! Central body rotation vector + real(DP), dimension(NDIM, NDIM), intent(inout) :: rot_matrix !! rotation matrix + real(DP), dimension(NDIM, NDIM), intent(inout) :: rot_matrix_inv !! inverse of the rotation matrix + + ! Internals + real(DP) :: theta !! angle to rotate it through + real(DP), dimension(3) :: u, z_hat, check !! unit vector about which we rotate, z_hat, and a check variable + real(DP), dimension(3, 3) :: S_matrix, temp !! rotation matrices, and a temporary variable + integer :: i, j !! dummy variable + + ! Assumed that NDIM = 3 + + rot_matrix(:, :) = 0.0_DP + rot_matrix_inv(:, :) = 0.0_DP + z_hat(:) = [0.0_DP, 0.0_DP, 1.0_DP] + + if (n == 0) return + + if ((abs(rot(1)) < 10*tiny(1.0_DP)) .and. (abs(rot(2)) < 10*tiny(1.0_DP))) then + do i = 1, NDIM + rot_matrix_inv(i, i) = 1.0_DP + rot_matrix(i, i) = 1.0_DP + end do + + return ! rotation axis is about the z-axis, no need to change + end if + + u(:) = rot(:) .cross. z_hat(:) + u(:) = .unit. u(:) + theta = acos(dot_product((.unit. rot(:)), z_hat(:))) + + ! S_matrix(:, :) = [[0.0_DP, -u(3), u(2)], [u(3), 0.0_DP, -u(1)], [-u(2), u(1), 0.0_DP]] ! skew-symmetric matrix + S_matrix(1, :) = [0.0_DP, -u(3), u(2)] + S_matrix(2, :) = [u(3), 0.0_DP, -u(1)] + S_matrix(3, :) = [-u(2), u(1), 0.0_DP] + ! assuming NDIM = 3 + ! CHECK for a general formula for the skew-symmetric matrix + + do j = 1, NDIM + do i = 1, NDIM + if (i == j) then + rot_matrix_inv(i, j) = rot_matrix_inv(i, j) + cos(theta) ! identity matrix + continue + end if + + ! Skew-symmetric matrix + Tensor product matrix + rot_matrix_inv(i, j) = rot_matrix_inv(i, j) + u(i) * u(j) * (1 - cos(theta)) + S_matrix(i, j) * sin(theta) + + end do + end do + + rot_matrix = matinv3(rot_matrix_inv) + + ! Check that the correct rotation matrix is used + ! rot_matrix * rot should be in the z_hat direction + check = matmul(rot, rot_matrix) ! 1x3 matrix x 3x3 matrix + check = .unit. check(:) + + if((abs(check(1)) > epsilon(0.0_DP)) .or. (abs(check(2)) > epsilon(0.0_DP))) then + temp = rot_matrix + rot_matrix = rot_matrix_inv + rot_matrix_inv = temp + end if + + return + end subroutine swiftest_obl_rot_matrix + + + module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, rot, GMpl, aoblcb) + !! author: David A. Minton, Kaustub Anand (2023) !! !! Compute the barycentric accelerations of bodies due to the oblateness of the central body !! Returned values do not include monopole term or terms higher than J4 @@ -26,32 +136,69 @@ module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, GMpl, real(DP), dimension(:,:), intent(in) :: rh !! Heliocentric positions of bodies logical, dimension(:), intent(in) :: lmask !! Logical mask of bodies to compute aobl real(DP), dimension(:,:), intent(out) :: aobl !! Barycentric acceleration of bodies due to central body oblateness + real(DP), dimension(NDIM), intent(in) :: rot !! Central body rotation matrix real(DP), dimension(:), intent(in), optional :: GMpl !! Masses of input bodies if they are not test particles - real(DP), dimension(:), intent(out), optional :: aoblcb !! Barycentric acceleration of central body (only needed if input bodies are massive) + real(DP), dimension(:), intent(out), optional :: aoblcb + !! Barycentric acceleration of central body (only needed if input bodies are massive) + ! Internals integer(I4B) :: i real(DP) :: r2, irh, rinv2, t0, t1, t2, t3, fac1, fac2 + real(DP), dimension(NDIM) :: rh_transformed ! rotated position vector + real(DP), dimension(NDIM, NDIM) :: rot_matrix, rot_matrix_inv ! rotation matrix and its inverse if (n == 0) return aobl(:,:) = 0.0_DP + + ! If the rotation axis is along the z-axis, skip calculating the rotation matrix + if ((abs(rot(1)) < 10*tiny(1.0_DP)) .and. (abs(rot(2)) < 10*tiny(1.0_DP))) then #ifdef DOCONLOC - do concurrent(i = 1:n, lmask(i)) shared(lmask,rh,aobl) local(r2,irh,rinv2,t0,t1,t2,t3,fac1,fac2) + do concurrent(i = 1:n, lmask(i)) shared(lmask,rh,aobl,j2rp2,j4rp4) & + local(r2,irh,rinv2,t0,t1,t2,t3,fac1,fac2) #else - do concurrent(i = 1:n, lmask(i)) + do concurrent(i = 1:n, lmask(i)) #endif - r2 = dot_product(rh(:, i), rh(:, i)) - irh = 1.0_DP / sqrt(r2) - rinv2 = irh**2 - t0 = -GMcb * rinv2 * rinv2 * irh - t1 = 1.5_DP * j2rp2 - t2 = rh(3, i) * rh(3, i) * rinv2 - t3 = 1.875_DP * j4rp4 * rinv2 - fac1 = t0 * (t1 - t3 - (5 * t1 - (14.0_DP - 21.0_DP * t2) * t3) * t2) - fac2 = 2 * t0 * (t1 - (2.0_DP - (14.0_DP * t2 / 3.0_DP)) * t3) - aobl(:, i) = fac1 * rh(:, i) - aobl(3, i) = fac2 * rh(3, i) + aobl(3, i) - end do + r2 = dot_product(rh(:, i), rh(:, i)) + irh = 1.0_DP / sqrt(r2) + rinv2 = irh**2 + t0 = -GMcb * rinv2 * rinv2 * irh + t1 = 1.5_DP * j2rp2 + t2 = rh(3, i) * rh(3, i) * rinv2 + t3 = 1.875_DP * j4rp4 * rinv2 + fac1 = t0 * (t1 - t3 - (5 * t1 - (14.0_DP - 21.0_DP * t2) * t3) * t2) + fac2 = 2 * t0 * (t1 - (2.0_DP - (14.0_DP * t2 / 3.0_DP)) * t3) + aobl(:, i) = fac1 * rh(:, i) + aobl(3, i) = fac2 * rh(3, i) + aobl(3, i) + end do + else + ! generate the rotation matrix + call swiftest_obl_rot_matrix(n, rot, rot_matrix, rot_matrix_inv) + +#ifdef DOCONLOC + do concurrent(i = 1:n, lmask(i)) shared(lmask,rh,aobl,rot_matrix,rot_matrix_inv,j2rp2,j4rp4) & + local(r2,irh,rinv2,t0,t1,t2,t3,fac1,fac2,rh_transformed) +#else + do concurrent(i = 1:n, lmask(i)) +#endif + ! rotate the position vectors + rh_transformed = matmul(rh(:, i), rot_matrix) ! 1x3 vector * 3x3 matrix + r2 = dot_product(rh_transformed, rh_transformed) + irh = 1.0_DP / sqrt(r2) + rinv2 = irh**2 + t0 = -GMcb * rinv2 * rinv2 * irh + t1 = 1.5_DP * j2rp2 + t2 = rh_transformed(3) * rh_transformed(3) * rinv2 + t3 = 1.875_DP * j4rp4 * rinv2 + fac1 = t0 * (t1 - t3 - (5 * t1 - (14.0_DP - 21.0_DP * t2) * t3) * t2) + fac2 = 2 * t0 * (t1 - (2.0_DP - (14.0_DP * t2 / 3.0_DP)) * t3) + aobl(:, i) = fac1 * rh_transformed(:) + aobl(3, i) = fac2 * rh_transformed(3) + aobl(3, i) + + ! rotate the acceleration and position vectors back to the original coordinate frame + aobl(:, i) = matmul(aobl(:, i), rot_matrix_inv) + end do + end if if (present(GMpl) .and. present(aoblcb)) then aoblcb(:) = 0.0_DP @@ -65,7 +212,7 @@ module subroutine swiftest_obl_acc(n, GMcb, j2rp2, j4rp4, rh, lmask, aobl, GMpl, end subroutine swiftest_obl_acc - module subroutine swiftest_obl_acc_pl(self, nbody_system) + module subroutine swiftest_non_spherical_cb_acc_pl(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -83,7 +230,11 @@ module subroutine swiftest_obl_acc_pl(self, nbody_system) associate(pl => self, cb => nbody_system%cb) npl = self%nbody - call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rh, pl%lmask, pl%aobl, pl%Gmass, cb%aobl) + if (allocated(cb%c_lm)) then + call shgrav_acc(self, nbody_system) + else + call swiftest_obl_acc(npl, cb%Gmass, cb%j2rp2, cb%j4rp4, pl%rh, pl%lmask, pl%aobl, cb%rot, pl%Gmass, cb%aobl) + end if #ifdef DOCONLOC do concurrent(i = 1:npl, pl%lmask(i)) shared(cb,pl) @@ -95,11 +246,10 @@ module subroutine swiftest_obl_acc_pl(self, nbody_system) end associate return - - end subroutine swiftest_obl_acc_pl + end subroutine swiftest_non_spherical_cb_acc_pl - module subroutine swiftest_obl_acc_tp(self, nbody_system) + module subroutine swiftest_non_spherical_cb_acc_tp(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -118,7 +268,11 @@ module subroutine swiftest_obl_acc_tp(self, nbody_system) associate(tp => self, cb => nbody_system%cb) ntp = self%nbody - call swiftest_obl_acc(ntp, cb%Gmass, cb%j2rp2, cb%j4rp4, tp%rh, tp%lmask, tp%aobl) + if (allocated(cb%c_lm)) then + call shgrav_acc(self, nbody_system) + else + call swiftest_obl_acc(ntp, cb%Gmass, cb%j2rp2, cb%j4rp4, tp%rh, tp%lmask, tp%aobl, cb%rot) + end if if (nbody_system%lbeg) then aoblcb = cb%aoblbeg else @@ -134,9 +288,9 @@ module subroutine swiftest_obl_acc_tp(self, nbody_system) end do end associate - return - end subroutine swiftest_obl_acc_tp + return + end subroutine swiftest_non_spherical_cb_acc_tp module subroutine swiftest_obl_pot_system(self) @@ -158,6 +312,7 @@ module subroutine swiftest_obl_pot_system(self) associate(nbody_system => self, pl => self%pl, cb => self%cb) npl = self%pl%nbody + if (npl == 0) return if (.not. any(pl%lmask(1:npl))) return #ifdef DOCONLOC do concurrent (i = 1:npl, pl%lmask(i)) shared(cb,pl,oblpot_arr) @@ -176,7 +331,8 @@ end subroutine swiftest_obl_pot_system elemental function swiftest_obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) !! author: David A. Minton !! - !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body from a single massive body + !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body from a + !! single massive body !! Returned value does not include monopole term or terms higher than J4 !! !! Reference: MacMillan, W. D. 1958. The Theory of the Potential, (Dover Publications), 363. diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 5f137b8d6..e1bfbb17b 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1213,32 +1213,36 @@ module subroutine swiftest_util_get_energy_and_momentum_system(self, param) nbody_system%ke_orbit = 0.0_DP nbody_system%ke_spin = 0.0_DP - kepl(:) = 0.0_DP - Lplorbit(:,:) = 0.0_DP - Lplspin(:,:) = 0.0_DP - - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - - nbody_system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) + nbody_system%GMtot = cb%Gmass + if (npl > 0) then + kepl(:) = 0.0_DP + Lplorbit(:,:) = 0.0_DP + Lplspin(:,:) = 0.0_DP + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + nbody_system%GMtot = nbody_system%GMtot + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) + end if + kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) nbody_system%be_cb = -3*cb%Gmass * cb%mass / (5 * cb%radius) Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) + if (npl > 0) then #ifdef DOCONLOC - do concurrent (i = 1:npl, pl%lmask(i)) shared(pl,Lplorbit,kepl) local(h) + do concurrent (i = 1:npl, pl%lmask(i)) shared(pl,Lplorbit,kepl,npl) local(h) #else - do concurrent (i = 1:npl, pl%lmask(i)) + do concurrent (i = 1:npl, pl%lmask(i)) #endif - h(1) = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) - h(2) = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) - h(3) = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) - + h(1) = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) + h(2) = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) + h(3) = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) + ! Angular momentum from orbit - Lplorbit(:,i) = pl%mass(i) * h(:) + Lplorbit(:,i) = pl%mass(i) * h(:) - ! Kinetic energy from orbit - kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) - end do + ! Kinetic energy from orbit + kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) + end do + end if if (param%lrotation) then kespincb = cb%mass * cb%Ip(3) * cb%radius**2 * dot_product(cb%rot(:), cb%rot(:)) @@ -1246,56 +1250,71 @@ module subroutine swiftest_util_get_energy_and_momentum_system(self, param) ! For simplicity, we always assume that the rotation pole is the 3rd principal axis Lcbspin(:) = cb%Ip(3) * cb%mass * cb%radius**2 * cb%rot(:) + if (npl > 0) then #ifdef DOCONLOC - do concurrent (i = 1:npl, pl%lmask(i)) shared(pl,Lplspin,kespinpl) + do concurrent (i = 1:npl, pl%lmask(i)) shared(pl,Lplspin,kespinpl) #else - do concurrent (i = 1:npl, pl%lmask(i)) + do concurrent (i = 1:npl, pl%lmask(i)) #endif - ! Currently we assume that the rotation pole is the 3rd principal axis - ! Angular momentum from spin - Lplspin(:,i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(:,i) + ! Currently we assume that the rotation pole is the 3rd principal axis + ! Angular momentum from spin + Lplspin(:,i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(:,i) - ! Kinetic energy from spin - kespinpl(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * dot_product(pl%rot(:,i), pl%rot(:,i)) - end do + ! Kinetic energy from spin + kespinpl(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * dot_product(pl%rot(:,i), pl%rot(:,i)) + end do - nbody_system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + nbody_system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + else + nbody_system%ke_spin = 0.5_DP * kespincb + end if + if (npl > 0) then #ifdef DOCONLOC - do concurrent (j = 1:NDIM) shared(nbody_system,pl,Lplspin,Lcbspin) + do concurrent (j = 1:NDIM) shared(nbody_system,pl,Lplspin,Lcbspin) #else - do concurrent (j = 1:NDIM) + do concurrent (j = 1:NDIM) #endif - nbody_system%L_spin(j) = Lcbspin(j) + sum(Lplspin(j,1:npl), pl%lmask(1:npl)) - end do + nbody_system%L_spin(j) = Lcbspin(j) + sum(Lplspin(j,1:npl), pl%lmask(1:npl)) + end do + else + nbody_system%L_spin(:) = Lcbspin(:) + end if else nbody_system%ke_spin = 0.0_DP nbody_system%L_spin(:) = 0.0_DP end if - - if (param%lflatten_interactions) then - call swiftest_util_get_potential_energy(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, & - nbody_system%pe) - else - call swiftest_util_get_potential_energy(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) + + if (npl > 0) then + if (param%lflatten_interactions) then + call swiftest_util_get_potential_energy(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, & + nbody_system%pe) + else + call swiftest_util_get_potential_energy(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) + end if end if ! Potential energy from the oblateness term - if (param%loblatecb) then + if (param%lnon_spherical_cb) then call nbody_system%obl_pot() nbody_system%pe = nbody_system%pe + nbody_system%oblpot end if - nbody_system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) + if (npl > 0) then + nbody_system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) #ifdef DOCONLOC - do concurrent (j = 1:NDIM) shared(nbody_system,pl,Lcborbit,Lplorbit,npl) + do concurrent (j = 1:NDIM) shared(nbody_system,pl,Lcborbit,Lplorbit,npl) #else - do concurrent (j = 1:NDIM) + do concurrent (j = 1:NDIM) #endif - nbody_system%L_orbit(j) = Lcborbit(j) + sum(Lplorbit(j,1:npl), pl%lmask(1:npl)) - end do + nbody_system%L_orbit(j) = Lcborbit(j) + sum(Lplorbit(j,1:npl), pl%lmask(1:npl)) + end do + else + nbody_system%ke_orbit = 0.5_DP * kecb + nbody_system%L_orbit(:) = Lcborbit(:) + end if - if ((param%lclose)) then + if ((param%lclose .and. (npl > 0))) then nbody_system%be = sum(-3*pl%Gmass(1:npl)*pl%mass(1:npl)/(5*pl%radius(1:npl)), pl%lmask(1:npl)) else nbody_system%be = 0.0_DP @@ -1704,10 +1723,13 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) if (npl == 0) then if (param%lmtiny_pl) pl%nplm = 0 + ! There are no more massive bodies. Reset the encounter lists and move on + if (allocated(nbody_system%plpl_encounter)) call nbody_system%plpl_encounter%setup(0_I8B) + if (allocated(nbody_system%pltp_encounter)) call nbody_system%pltp_encounter%setup(0_I8B) return end if - ! Reset all of the status flags for this body + ! Reset all of the status flags for the remaining bodies pl%status(1:npl) = ACTIVE do i = 1, npl call pl%info(i)%set_value(status="ACTIVE") @@ -1727,7 +1749,12 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) end if ! Reindex the new list of bodies - call pl%sort("mass", ascending=.false.) + select type(pl) + class is (helio_pl) + call pl%sort("mass", ascending=.false.) + class is (whm_pl) + call pl%sort("ir3h", ascending=.false.) + end select call pl%flatten(param) call pl%set_rhill(cb) @@ -1842,6 +1869,72 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) end subroutine swiftest_util_rearray_pl + module subroutine swiftest_util_rearray_tp(self, nbody_system, param) + !! Author: David A. Minton + !! + !! Clean up the test particle structures to remove discarded bodies + use symba + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + class(swiftest_tp), allocatable :: tmp !! The discarded body list. + integer(I4B) :: i, ntp, npl + integer(I8B) :: k, nenc + logical, dimension(:), allocatable :: lmask + logical :: lencounter + + associate(tp => self, pl => nbody_system%pl, cb => nbody_system%cb, pl_adds => nbody_system%pl_adds) + + ntp = tp%nbody + if (ntp == 0) return + npl = pl%nbody + + ! Remove the discards and destroy the list, as the nbody_system already tracks tp_discards elsewhere + allocate(lmask(ntp)) + lmask(1:ntp) = tp%ldiscard(1:ntp) + if (count(lmask(:)) > 0) then + allocate(tmp, mold=self) + call tp%spill(tmp, lspill_list=lmask, ldestructive=.true.) + ntp = tp%nbody + call tmp%setup(0,param) + deallocate(tmp) + deallocate(lmask) + end if + ntp = tp%nbody + if (ntp == 0) then + ! There are no more test particles. Reset the encounter list and move on + if (allocated(nbody_system%pltp_encounter)) call nbody_system%pltp_encounter%setup(0_I8B) + return + end if + + ! Reset all of the status flags for the remaining bodies + tp%status(1:ntp) = ACTIVE + do i = 1, ntp + call tp%info(i)%set_value(status="ACTIVE") + end do + tp%ldiscard(1:ntp) = .false. + tp%lcollision(1:ntp) = .false. + tp%lmask(1:ntp) = .true. + + if (allocated(nbody_system%pltp_encounter)) then + ! Index values may have changed, so re-index the encounter list + nenc = nbody_system%pltp_encounter%nenc + do k = 1_I8B, nenc + nbody_system%pltp_encounter%index1(k) = findloc(pl%id(1:npl), nbody_system%pltp_encounter%id1(k), dim=1) + nbody_system%pltp_encounter%index2(k) = findloc(tp%id(1:ntp), nbody_system%pltp_encounter%id2(k), dim=1) + end do + + end if + + end associate + + return + end subroutine swiftest_util_rearray_tp + + module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tscale) !! author: David A. Minton !! @@ -2370,6 +2463,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(helio_cb :: nbody_system%cb) allocate(helio_pl :: nbody_system%pl) allocate(helio_tp :: nbody_system%tp) + allocate(helio_pl :: nbody_system%pl_discards) allocate(helio_tp :: nbody_system%tp_discards) end select param%collision_model = "MERGE" @@ -2384,6 +2478,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(whm_cb :: nbody_system%cb) allocate(whm_pl :: nbody_system%pl) allocate(whm_tp :: nbody_system%tp) + allocate(whm_pl :: nbody_system%pl_discards) allocate(whm_tp :: nbody_system%tp_discards) end select param%collision_model = "MERGE" @@ -2394,6 +2489,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(rmvs_cb :: nbody_system%cb) allocate(rmvs_pl :: nbody_system%pl) allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_pl :: nbody_system%pl_discards) allocate(rmvs_tp :: nbody_system%tp_discards) end select param%collision_model = "MERGE" @@ -2412,6 +2508,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(symba_list_pltp :: nbody_system%pltp_encounter) allocate(symba_list_plpl :: nbody_system%plpl_encounter) allocate(collision_list_plpl :: nbody_system%plpl_collision) + allocate(collision_list_pltp :: nbody_system%pltp_collision) end select case (INT_RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' @@ -2473,8 +2570,13 @@ module subroutine swiftest_util_setup_initialize_system(self, system_history, pa class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals + type(encounter_storage) :: encounter_history + type(collision_storage) :: collision_history + + call encounter_history%setup(4096) + call collision_history%setup(4096) + if (allocated(system_history)) then call system_history%dealloc() deallocate(system_history) @@ -2506,6 +2608,40 @@ module subroutine swiftest_util_setup_initialize_system(self, system_history, pa nc%file_name = param%outfile call nbody_system%initialize_output_file(nc, param) call nc%close() + + allocate(collision_basic :: nbody_system%collider) + call nbody_system%collider%setup(nbody_system) + + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then + allocate(encounter_netcdf_parameters :: encounter_history%nc) + select type(nc => encounter_history%nc) + class is (encounter_netcdf_parameters) + nc%file_name = ENCOUNTER_OUTFILE + if (.not.param%lrestart) then + call nc%initialize(param) + call nc%close() + end if + end select + allocate(nbody_system%encounter_history, source=encounter_history) + end if + + allocate(collision_netcdf_parameters :: collision_history%nc) + select type(nc => collision_history%nc) + class is (collision_netcdf_parameters) + nc%file_name = COLLISION_OUTFILE + if (param%lrestart) then + call nc%open(param) ! This will find the nc%max_idslot variable + else + call nc%initialize(param) + end if + call nc%close() + nbody_system%collider%maxid_collision = nc%max_idslot + end select + + allocate(nbody_system%collision_history, source=collision_history) + + nbody_system%collider%max_rot = MAX_ROT_SI * param%TU2S + end associate return @@ -2589,7 +2725,7 @@ module subroutine swiftest_util_setup_body(self, n, param) self%peri(:) = 0.0_DP self%atp(:) = 0.0_DP - if (param%loblatecb) then + if (param%lnon_spherical_cb) then allocate(self%aobl(NDIM, n)) self%aobl(:,:) = 0.0_DP end if diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 1d86fb637..2d22ef299 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -48,11 +48,13 @@ subroutine symba_discard_cb_pl(pl, nbody_system, param) write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & - "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "***********************************************************" // & + "***********************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & - "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "***********************************************************" // & + "***********************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) @@ -65,11 +67,13 @@ subroutine symba_discard_cb_pl(pl, nbody_system, param) write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & - "************************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "************************************************************" // & + "************************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & - "************************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "************************************************************" // & + "************************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=cb%id) @@ -86,11 +90,13 @@ subroutine symba_discard_cb_pl(pl, nbody_system, param) write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & - "************************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "************************************************************" // & + "************************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & - "************************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & + "************************************************************" // & + "************************************************************") call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) @@ -233,17 +239,6 @@ subroutine symba_discard_nonplpl(pl, nbody_system, param) call symba_discard_cb_pl(pl, nbody_system, param) end if if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, nbody_system, param) - if (any(pl%ldiscard(1:npl))) then - ldiscard(1:npl) = pl%ldiscard(1:npl) - - allocate(plsub, mold=pl) - call pl%spill(plsub, ldiscard, ldestructive=.false.) - nsub = plsub%nbody - nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + nsub - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nsub)]) - - end if end associate return @@ -267,7 +262,8 @@ subroutine symba_discard_nonplpl_conservation(pl, nbody_system, param) integer(I4B), dimension(:), allocatable :: discard_index_list associate(npl => pl%nbody) - discard_l_pl(1:npl) = pl%ldiscard(1:npl) .and. .not. pl%lcollision(1:npl) ! These are bodies that are discarded but not flagged as pl-pl collision + discard_l_pl(1:npl) = pl%ldiscard(1:npl) .and. .not. pl%lcollision(1:npl) ! These are bodies that are discarded but not + ! flagged as pl-pl collision ndiscard = count(discard_l_pl(:)) allocate(discard_index_list(ndiscard)) discard_index_list(:) = pack([(i, i = 1, npl)], discard_l_pl(1:npl)) @@ -342,7 +338,8 @@ end subroutine symba_discard_peri_pl module subroutine symba_discard_pl(self, nbody_system, param) !! author: David A. Minton !! - !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central body or escaping the nbody_system + !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central + !! body or escaping the nbody_system implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 9dec2072c..768349e7e 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -256,7 +256,7 @@ module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) re integer(I4B), dimension(:), allocatable :: index1, index2 lany_encounter = .false. - if (self%nbody == 0) return + if (self%nbody == 0 .or. nbody_system%pl%nbody == 0) return associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) call pl%set_renc(irec) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e647e4d37..948eeaacc 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -305,7 +305,9 @@ module subroutine symba_step_reset_system(self, param) nenc_old = nbody_system%pltp_encounter%nenc call nbody_system%pltp_encounter%setup(0_I8B) + call nbody_system%pltp_collision%setup(0_I8B) if (ntp > 0) then + tp%lcollision(1:ntp) = .false. tp%nplenc(1:ntp) = 0 tp%levelg(1:ntp) = -1 tp%levelm(1:ntp) = -1 diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8ed213ba8..46a34a46c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -19,16 +19,19 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) !! This method will automatically resize the destination body if it is too small implicit none !! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to select type(source) class is (symba_pl) call util_append(self%levelg, source%levelg, lsource_mask=lsource_mask) call util_append(self%levelm, source%levelm, lsource_mask=lsource_mask) - - call swiftest_util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class + ! Note: helio_pl does not have its own append method, so we skip back to the base class + call swiftest_util_append_pl(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" call base_util_exit(FAILURE) @@ -45,16 +48,19 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) !! This method will automatically resize the destination body if it is too small implicit none !! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + class(swiftest_body), intent(in) :: source + !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask + !! Logical mask indicating which elements to append to select type(source) class is (symba_tp) call util_append(self%levelg, source%levelg, lsource_mask=lsource_mask) call util_append(self%levelm, source%levelm, lsource_mask=lsource_mask) - - call swiftest_util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class + ! Note: helio_tp does not have its own append method, so we skip back to the base class + call swiftest_util_append_tp(self, source, lsource_mask) class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" call base_util_exit(FAILURE) @@ -70,7 +76,8 @@ module subroutine symba_util_dealloc_pl(self) !! Deallocates all allocatabale arrays implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) @@ -88,6 +95,7 @@ module subroutine symba_util_dealloc_system(self) implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self + !! SyMBA nbody_system object self%irec = -1 call self%helio_nbody_system%dealloc() @@ -102,7 +110,8 @@ module subroutine symba_util_dealloc_tp(self) !! Deallocates all allocatabale arrays implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) @@ -121,17 +130,20 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) !! implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA masive body object - class(swiftest_body), intent(in) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(symba_pl), intent(inout) :: self + !! SyMBA masive body object + class(swiftest_body), intent(in) :: inserts + !! Inserted object + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps associate(keeps => self) select type(inserts) class is (symba_pl) call util_fill(keeps%levelg, inserts%levelg, lfill_list) call util_fill(keeps%levelm, inserts%levelm, lfill_list) - - call swiftest_util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class + ! Note: helio_pl does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" call base_util_exit(FAILURE) @@ -150,18 +162,20 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) !! implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_body), intent(in) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + class(swiftest_body), intent(in) :: inserts + !! Inserted object + logical, dimension(:), intent(in) :: lfill_list + !! Logical array of bodies to merge into the keeps associate(keeps => self) select type(inserts) class is (symba_tp) - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) call util_fill(keeps%levelg, inserts%levelg, lfill_list) call util_fill(keeps%levelm, inserts%levelm, lfill_list) - - call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class + ! Note: helio_tp does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_tp(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" call base_util_exit(FAILURE) @@ -185,11 +199,18 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) !! 2019. hal-0204751 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters ! Internals integer(I8B) :: npl, nplm + if (self%nbody == 0) then + self%nplm = 0 + return + end if + associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) if (param%lmtiny_pl) then @@ -199,7 +220,8 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) nplm = npl end if pl%nplm = int(nplm, kind=I4B) - nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies + ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies + nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B call swiftest_util_flatten_eucl_plpl(pl, param) end associate @@ -214,8 +236,10 @@ module subroutine symba_util_resize_pl(self, nnew) !! Checks the current size of a SyMBA massive body object against the requested size and resizes it if it is too small. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: nnew + !! New size neded call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) @@ -231,8 +255,10 @@ module subroutine symba_util_resize_tp(self, nnew) !! Checks the current size of a test particle object against the requested size and resizes it if it is too small. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), intent(in) :: nnew !! New size neded + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), intent(in):: nnew + !! New size neded call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) @@ -249,12 +275,15 @@ module subroutine symba_util_set_renc(self, scale) !! implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: scale !! Current recursion depth + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: scale + !! Current recursion depth ! Internals integer(I4B) :: i real(DP) :: rshell_irec + if (self%nbody == 0) return associate(pl => self, npl => self%nbody) rshell_irec = 1._DP do i = 1, scale @@ -275,48 +304,22 @@ module subroutine symba_util_setup_initialize_system(self, system_history, param !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object - class(swiftest_storage), allocatable, intent(inout) :: system_history !! Stores the system history between output dumps - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - type(encounter_storage) :: encounter_history - type(collision_storage) :: collision_history + class(symba_nbody_system), intent(inout) :: self + !! SyMBA nbody_system object + class(swiftest_storage),allocatable, intent(inout) :: system_history + !! Stores the system history between output dumps + class(swiftest_parameters), intent(inout) :: param + !! Current run configuration parameters - call encounter_history%setup(4096) - call collision_history%setup(4096) ! Call parent method associate(nbody_system => self) call helio_util_setup_initialize_system(nbody_system, system_history, param) call nbody_system%pltp_encounter%setup(0_I8B) call nbody_system%plpl_encounter%setup(0_I8B) call nbody_system%plpl_collision%setup(0_I8B) + call nbody_system%pltp_collision%setup(0_I8B) - if (param%lenc_save_trajectory .or. param%lenc_save_closest) then - allocate(encounter_netcdf_parameters :: encounter_history%nc) - select type(nc => encounter_history%nc) - class is (encounter_netcdf_parameters) - nc%file_name = ENCOUNTER_OUTFILE - if (.not.param%lrestart) then - call nc%initialize(param) - call nc%close() - end if - end select - allocate(nbody_system%encounter_history, source=encounter_history) - end if - - allocate(collision_netcdf_parameters :: collision_history%nc) - select type(nc => collision_history%nc) - class is (collision_netcdf_parameters) - nc%file_name = COLLISION_OUTFILE - if (param%lrestart) then - call nc%open(param) ! This will find the nc%max_idslot variable - else - call nc%initialize(param) - end if - call nc%close() - end select - allocate(nbody_system%collision_history, source=collision_history) - + if (allocated(nbody_system%collider)) deallocate(nbody_system%collider) select case(param%collision_model) case("MERGE") allocate(collision_basic :: nbody_system%collider) @@ -327,12 +330,6 @@ module subroutine symba_util_setup_initialize_system(self, system_history, param end select call nbody_system%collider%setup(nbody_system) - nbody_system%collider%max_rot = MAX_ROT_SI * param%TU2S - select type(nc => collision_history%nc) - class is (collision_netcdf_parameters) - nbody_system%collider%maxid_collision = nc%max_idslot - end select - end associate return @@ -347,11 +344,14 @@ module subroutine symba_util_setup_pl(self, n, param) !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_util_setup.f90 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class. + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameter + + ! Call allocation method for parent class. call self%helio_pl%setup(n, param) if (n == 0) return @@ -372,9 +372,12 @@ module subroutine symba_util_setup_tp(self, n, param) !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), intent(in) :: n + !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param + !! Current run configuration parameter !> Call allocation method for parent class. call self%helio_tp%setup(n, param) @@ -397,9 +400,12 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) !! sortby is a string indicating which array component to sort. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order ! Internals integer(I4B), dimension(:), allocatable :: ind integer(I4B) :: direction @@ -438,9 +444,12 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) !! sortby is a string indicating which array component to sort. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + character(*), intent(in) :: sortby + !! Sorting attribute + logical, intent(in) :: ascending + !! Logical flag indicating whether or not the sorting should be in ascending or descending order ! Internals integer(I4B), dimension(:), allocatable :: ind integer(I4B) :: direction @@ -480,8 +489,10 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(symba_pl), intent(inout) :: self ! + ! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(pl => self, npl => self%nbody) call util_sort_rearrange(pl%levelg, ind, npl) @@ -500,8 +511,10 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + integer(I4B), dimension(:), intent(in) :: ind + !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(tp => self, ntp => self%nbody) call util_sort_rearrange(tp%nplenc, ind, ntp) @@ -522,10 +535,14 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 implicit none ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + class(symba_pl), intent(inout) :: self + !! SyMBA massive body object + class(swiftest_body), intent(inout) :: discards + !! Discarded object + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter body by removing the discard list ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Spill all the common components @@ -553,17 +570,20 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 implicit none ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + class(symba_tp), intent(inout) :: self + !! SyMBA test particle object + class(swiftest_body), intent(inout) :: discards + !! Discarded object + logical, dimension(:), intent(in) :: lspill_list + !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive + !! Logical flag indicating whether or not this operation should alter body by removing the discard list ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Spill all the common components associate(keeps => self) select type(discards) class is (symba_tp) - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) call util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) call util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index 66937861f..0f58e9d5e 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -43,8 +43,8 @@ module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) call whm_kick_getacch_ah2(cb, pl) call pl%accel_int(param) - if (param%loblatecb) then - call pl%accel_obl(nbody_system) + if (param%lnon_spherical_cb) then + call pl%accel_non_spherical_cb(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -59,7 +59,6 @@ module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) end if if (param%lgr) call pl%accel_gr(param) - if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) end associate @@ -88,32 +87,34 @@ module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) associate(tp => self, pl => nbody_system%pl, cb => nbody_system%cb) npl = nbody_system%pl%nbody ntp = self%nbody - if (ntp == 0 .or. npl == 0) return + if (ntp == 0) return nbody_system%lbeg = lbeg - if (lbeg) then - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) + if(npl > 0) then + if (lbeg) then + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) #ifdef DOCONLOC - do concurrent(i = 1:ntp, tp%lmask(i)) shared(tp,ah0) + do concurrent(i = 1:ntp, tp%lmask(i)) shared(tp,ah0) #else - do concurrent(i = 1:ntp, tp%lmask(i)) + do concurrent(i = 1:ntp, tp%lmask(i)) #endif - tp%ah(:, i) = tp%ah(:, i) + ah0(:) - end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) - else - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) + tp%ah(:, i) = tp%ah(:, i) + ah0(:) + end do + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) + else + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) #ifdef DOCONLOC - do concurrent(i = 1:ntp, tp%lmask(i)) shared(tp,ah0) + do concurrent(i = 1:ntp, tp%lmask(i)) shared(tp,ah0) #else - do concurrent(i = 1:ntp, tp%lmask(i)) + do concurrent(i = 1:ntp, tp%lmask(i)) #endif - tp%ah(:, i) = tp%ah(:, i) + ah0(:) - end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) + tp%ah(:, i) = tp%ah(:, i) + ah0(:) + end do + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) + end if end if - if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lnon_spherical_cb) call tp%accel_non_spherical_cb(nbody_system) if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate diff --git a/src/whm/whm_step.f90 b/src/whm/whm_step.f90 index df361cfc6..24ec567c1 100644 --- a/src/whm/whm_step.f90 +++ b/src/whm/whm_step.f90 @@ -29,7 +29,9 @@ module subroutine whm_step_system(self, param, t, dt) tp%lfirst = pl%lfirst call pl%step(nbody_system, param, t, dt) call tp%step(nbody_system, param, t, dt) + call cb%rotphase_update(param, dt) ! if (param%ltides) call nbody_system%step_spin(param, t, dt) + end associate return end subroutine whm_step_system diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index cb461fb03..5b1218550 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -216,6 +216,7 @@ module subroutine whm_util_setup_initialize_system(self, system_history, param) call self%pl%flatten(param) ! Make sure that the discard list gets allocated initially + call self%pl_discards%setup(0, param) call self%tp_discards%setup(0, param) call self%pl%set_mu(self%cb) call self%tp%set_mu(self%cb) diff --git a/swiftest/CMakeLists.txt b/swiftest/CMakeLists.txt index 45f02ca0d..1d6db80b2 100644 --- a/swiftest/CMakeLists.txt +++ b/swiftest/CMakeLists.txt @@ -17,6 +17,11 @@ FIND_PROGRAM(CYTHON NO_CMAKE_SYSTEM_PATH NO_CMAKE_FIND_ROOT_PATH ) +IF (NOT CYTHON) + MESSAGE(STATUS "Cython not found. Skipping Cython build") + RETURN() +ENDIF() + MESSAGE(STATUS "Cython executable path: ${CYTHON}") SET(CYTHON_ARGS "${CMAKE_CURRENT_SOURCE_DIR}/${SWIFTEST_BINDINGS}.pyx" "--output-file" "${CMAKE_CURRENT_BINARY_DIR}/${SWIFTEST_BINDINGS}.c") STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) @@ -24,18 +29,22 @@ IF (BT STREQUAL "DEBUG") LIST(APPEND CYTHON_ARGS "--gdb") endif () ADD_CUSTOM_COMMAND( - OUTPUT "${SWIFTEST_BINDINGS}.c" - DEPENDS "${SWIFTEST_BINDINGS}.pyx" - VERBATIM - COMMAND "${CYTHON}" ${CYTHON_ARGS} ) + OUTPUT "${SWIFTEST_BINDINGS}.c" + DEPENDS "${SWIFTEST_BINDINGS}.pyx" + VERBATIM + COMMAND "${CYTHON}" ${CYTHON_ARGS} ) PYTHON_ADD_LIBRARY(${SWIFTEST_BINDINGS} MODULE "${CMAKE_CURRENT_BINARY_DIR}/${SWIFTEST_BINDINGS}.c" WITH_SOABI) -IF (NOT BUILD_SHARED_LIBS) - SET_PROPERTY(TARGET ${SWIFTEST_BINDINGS} PROPERTY POSITION_INDEPENDENT_CODE) -ENDIF () TARGET_LINK_LIBRARIES(${SWIFTEST_BINDINGS} PUBLIC ${SWIFTEST_LIBRARY} netCDF::netcdff HDF5::HDF5) + +IF(USE_OPENMP OR USE_SIMD) + TARGET_LINK_LIBRARIES(${SWIFTEST_BINDINGS} PUBLIC SHTOOLS::parallel) +ELSE() + TARGET_LINK_LIBRARIES(${SWIFTEST_BINDINGS} PUBLIC SHTOOLS::serial) +ENDIF () + TARGET_INCLUDE_DIRECTORIES(${SWIFTEST_BINDINGS} PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) # Define the install locations -INSTALL(TARGETS ${SWIFTEST_BINDINGS} LIBRARY DESTINATION ${INSTALL_LIBDIR}) \ No newline at end of file +INSTALL(TARGETS ${SWIFTEST_BINDINGS} LIBRARY DESTINATION ${INSTALL_PYPROJ}) \ No newline at end of file diff --git a/swiftest/__init__.py b/swiftest/__init__.py index 363a34b02..6227cef1f 100644 --- a/swiftest/__init__.py +++ b/swiftest/__init__.py @@ -10,4 +10,5 @@ """ from .constants import * -from .simulation_class import Simulation \ No newline at end of file +from .simulation_class import Simulation +from .shgrav import clm_from_ellipsoid, clm_from_relief \ No newline at end of file diff --git a/swiftest/init_cond.py b/swiftest/init_cond.py index cea5912ba..889780a03 100644 --- a/swiftest/init_cond.py +++ b/swiftest/init_cond.py @@ -39,8 +39,8 @@ def horizons_get_physical_properties(altid,**kwargs): Returns ------- - MSun_over_Mpl : float - The ratio of MSun/M of the body + GMass : float + G*Mass of the body radius : float The radius of the body in m rot: (3) float vector @@ -53,6 +53,22 @@ def get_Gmass(raw_response): and 'GMT' not in s and 'ANGMOM' not in s] if len(GM) == 0: + # Try an alternative name for the Mass found in some satellite queries + M = [s for s in raw_response.split('\n') if 'Mass' in s] + if len(M) > 0: + M = M[0].split('Mass')[-1].strip() + if 'kg' in M: + unit_conv_str = M.split('kg')[0].strip() + unit_conv_str = unit_conv_str.split('^')[1].strip() + unit_conv = 10**int(unit_conv_str) + mult = M.split('=')[1].strip().split(' ')[1].strip('()') + mult = 10**int(mult.split('^')[1].strip()) + M = M.split('=')[1].strip().split(' ')[0].strip() + M = float(M) * mult * unit_conv + try: + return M * swiftest.GC * 1e-9 # Return units of km**3 / s**2 for consistency + except: + return None return None GM = GM[0] if len(GM) > 1: @@ -124,11 +140,12 @@ def get_rotrate(raw_response): def get_rotpole(jpl): RA = jpl.ephemerides()['NPole_RA'][0] DEC = jpl.ephemerides()['NPole_DEC'][0] - + if np.ma.is_masked(RA) or np.ma.is_masked(DEC): return np.array([0.0,0.0,1.0]) - rotpole = SkyCoord(ra=RA * u.degree, dec=DEC * u.degree).cartesian + rotpole = SkyCoord(ra=RA * u.degree, dec=DEC * u.degree,frame='icrs').transform_to('barycentricmeanecliptic').cartesian + return np.array([rotpole.x.value, rotpole.y.value, rotpole.z.value]) if type(altid) != list: @@ -198,7 +215,11 @@ def get_altid(errstr,exclude_spacecraft=True): Returns ------- - MSun_over_Mpl : float + altid: string list | None + A list of alternate ids if more than one object matches the list + altname: string list | None + A list of alternate names if more than one object matches the list + """ if "ID" in errstr: altid = errstr.split('ID')[1] @@ -342,6 +363,16 @@ def solar_system_horizons(name: str, if param['ROTATION']: Ip = Ipsun rot = rotcb + if param['IN_FORM'] == 'XV': + rh = np.array([0.0, 0.0, 0.0]) + vh = np.array([0.0, 0.0, 0.0]) + elif param['IN_FORM'] == 'EL': + a = np.nan + e = np.nan + inc = np.nan + capom = np.nan + omega = np.nan + capm = np.nan else: # Fetch solar system ephemerides from Horizons if ephemeris_id is None: ephemeris_id = name @@ -457,7 +488,11 @@ def vec2xr(param: Dict, **kwargs: Any): instead of passing Ip1, Ip2, and Ip3 separately time : array of floats Time at start of simulation - + c_lm : (2, lmax + 1, lmax + 1) array of floats, optional + Spherical Harmonics coefficients; lmax = max spherical harmonics order + rotphase : float + rotational phase angle of the central body in degrees + Returns ------- ds : xarray dataset @@ -466,10 +501,12 @@ def vec2xr(param: Dict, **kwargs: Any): scalar_dims = ['id'] vector_dims = ['id','space'] space_coords = np.array(["x","y","z"]) + sph_dims = ['sign', 'l', 'm'] # Spherical Harmonics dimensions vector_vars = ["rh","vh","Ip","rot"] - scalar_vars = ["name","a","e","inc","capom","omega","capm","Gmass","radius","rhill","j2rp2","j4rp4"] - time_vars = ["rh","vh","Ip","rot","a","e","inc","capom","omega","capm","Gmass","radius","rhill","j2rp2","j4rp4"] + scalar_vars = ["name","a","e","inc","capom","omega","capm","Gmass","radius","rhill","j2rp2","j4rp4", "rotphase"] + sph_vars = ["c_lm"] + time_vars = ["rh","vh","Ip","rot","a","e","inc","capom","omega","capm","Gmass","radius","rhill","j2rp2","j4rp4", "rotphase"] # Check for valid keyword arguments kwargs = {k:kwargs[k] for k,v in kwargs.items() if v is not None} @@ -483,7 +520,7 @@ def vec2xr(param: Dict, **kwargs: Any): if "time" not in kwargs: kwargs["time"] = np.array([0.0]) - valid_arguments = vector_vars + scalar_vars + ['time','id'] + valid_arguments = vector_vars + scalar_vars + sph_vars + ['time','id'] kwargs = {k:v for k,v in kwargs.items() if k in valid_arguments} @@ -499,4 +536,16 @@ def vec2xr(param: Dict, **kwargs: Any): for v in time_vars: ds[v] = ds[v].expand_dims({"time":1}).assign_coords({"time": kwargs['time']}) - return ds \ No newline at end of file + # create a C_lm Dataset and combine + + if "c_lm" in kwargs: + clm_xr = xr.Dataset(data_vars = {k:(sph_dims, v) for k,v in kwargs.items() if k in sph_vars}, + coords = { + 'sign':(['sign'], [1, -1]), + 'l': (['l'], range(0, kwargs['c_lm'].shape[1])), + 'm':(['m'], range(0, kwargs['c_lm'].shape[2])) + } + ) + ds = xr.combine_by_coords([ds, clm_xr]) + + return ds diff --git a/swiftest/io.py b/swiftest/io.py index 33fdb1e8f..4628fe17a 100644 --- a/swiftest/io.py +++ b/swiftest/io.py @@ -858,9 +858,15 @@ def select_active_from_frame(ds, param, framenum=-1): # Select only the active particles at this time step # Remove the inactive particles if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['rh'].isel(space=0))), drop=True)[count_dim] + if 'rh' in iframe: + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['rh'].isel(space=0))), drop=True)[count_dim] + else: + iactive = iframe[count_dim].where(~np.isnan(iframe['Gmass'])) else: - iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True)[count_dim] + if 'a' in iframe: + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True)[count_dim] + else: + iactive = iframe[count_dim].where(~np.isnan(iframe['Gmass'])) if count_dim == "id": frame = frame.sel(id=iactive.values) elif count_dim == "name": diff --git a/swiftest/shgrav.py b/swiftest/shgrav.py new file mode 100644 index 000000000..6664b3941 --- /dev/null +++ b/swiftest/shgrav.py @@ -0,0 +1,150 @@ +""" + Copyright 2024 - Minton Group at Purdue University + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest 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 Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +# python functions to read in and set up spherical harmonics coefficients for non-standard gravity terms +# using pySHTOOLS see: https://shtools.github.io/SHTOOLS/ +# + +from .constants import GC + +try: + import pyshtools as pysh + PYSHTOOLS_AVAILABLE = True +except ModuleNotFoundError: + PYSHTOOLS_AVAILABLE = False + print("pyshtools is not installed. Some features will be unavailable.") + +if PYSHTOOLS_AVAILABLE: + + def clm_from_ellipsoid(mass, density, a, b = None, c = None, lmax = 6, lref_radius = False, ref_radius = None): + """ + Creates and returns the gravity coefficients for an ellipsoid with principal axes a, b, c upto a certain maximum degree lmax. + Uses pyshtools. No units necessary for a, b, & c. However, they need to be in the same units (DU). + + Parameters + ---------- + mass : float + mass of the central body + density : float + density of the central body + a : float + length of the pricipal axis aligned with the x axis + b : float, optional, default = a + length of the pricipal axis aligned with the y axis + c : float, optional, default = b + length of the pricipal axis aligned with the z axis + lmax : int, optional, default = 6 + The maximum spherical harmonic degree resolvable by the grid. + lref_radius : boolean, optional, default = False + Boolean value to return the reference radius calculated by SHTOOLS + ref_radius : float, optional, default = None + Reference radius to scale the gravitational coefficients to + + Returns + ------- + clm : ndarry, shape (2, lmax+1, lmax+1) + numpy ndarray of the gravitational potential spherical harmonic coefficients. + This is a three-dimensional array formatted as coeffs[i, degree, order], + where i=0 corresponds to positive orders and i=1 to negative orders. + + """ + Gmass = GC * mass # SHTOOLS uses an SI G value, and divides it before using the mass; NO NEED TO CHANGE UNITS + + # cap lmax to ensure fast performance without giving up accuracy + lmax_limit = 6 # lmax_limit = 6 derived from Jean's Law; characteristic wavelength = the radius of the CB + if(lmax > lmax_limit): + lmax = lmax_limit + print(f'Setting maximum spherical harmonic degree to {lmax_limit}') + + # create shape grid + shape_SH = pysh.SHGrid.from_ellipsoid(lmax = lmax, a = a, b = b, c = c) + + # get gravity coefficients + clm_class = pysh.SHGravCoeffs.from_shape(shape_SH, rho = density, gm = Gmass) # 4pi normalization + clm = clm_class.to_array(normalization = '4pi') # export as array with 4pi normalization and not scaling by 4*pi to match normalisation + + # Return reference radius EQUALS the radius of the Central Body + print(f'Ensure that the Central Body radius equals the reference radius.') + + if(lref_radius == True and ref_radius is None): + ref_radius = shape_SH.expand(normalization = '4pi').coeffs[0, 0, 0] + return clm, ref_radius + elif(lref_radius == True and ref_radius is not None): + clm_class = clm_class.change_ref(r0 = ref_radius) + clm = clm_class.to_array(normalization = '4pi') + return clm, ref_radius + else: + return clm + + def clm_from_relief(mass, density, grid, lmax = 6, lref_radius = False, ref_radius = None): + """ + Creates and returns the gravity coefficients for a body with a given DH grid upto a certain maximum degree lmax. + Uses pyshtools. + + Parameters + ---------- + mass : float + mass of the central body + density : float + density of the central body + grid : array, shape [] + DH grid of the surface relief of the body + lmax : int, optional, default = 6 + The maximum spherical harmonic degree resolvable by the grid. + lref_radius : boolean, optional, default = False + Boolean value to return the reference radius calculated by SHTOOLS + ref_radius : float, optional, default = None + Reference radius to scale the gravitational coefficients to + + Returns + ------- + clm : ndarry, shape (2, lmax+1, lmax+1) + numpy ndarray of the gravitational potential spherical harmonic coefficients. + This is a three-dimensional array formatted as coeffs[i, degree, order], + where i=0 corresponds to positive orders and i=1 to negative orders. + + """ + + Gmass = GC * mass # SHTOOLS uses an SI G value, and divides it before using the mass; NO NEED TO CHANGE UNITS + + # cap lmax to 20 to ensure fast performance + lmax_limit = 6 + if(lmax > lmax_limit): # FIND A BETTER WAY to judge this cut off point, i.e., relative change between coefficients + lmax = lmax_limit + print(f'Setting maximum spherical harmonic degree to {lmax_limit}') + + # convert to spherical harmonics + shape_SH = pysh.SHGrid.from_array(grid) + + # get coefficients + clm_class = pysh.SHGravcoeffs.from_shape(shape_SH, rho = density, gm = Gmass) # 4pi normalization + clm = clm_class.to_array(normalization = '4pi') # export as array with 4pi normalization + + # Return reference radius EQUALS the radius of the Central Body + + print(f'Ensure that the Central Body radius equals the reference radius.') + + if(lref_radius == True and ref_radius is None): + ref_radius = shape_SH.expand(normalization = '4pi').coeffs[0, 0, 0] + return clm, ref_radius + elif(lref_radius == True and ref_radius is not None): + clm_class = clm_class.change_ref(r0 = ref_radius) + clm = clm_class.to_array(normalization = '4pi') + return clm, ref_radius + else: + return clm + +else: + def clm_from_ellipsoid(*args, **kwargs): + raise NotImplementedError("Sph_Harmonics is not available because pyshtools is not installed.") + def clm_from_relief(*args, **kwargs): + raise NotImplementedError("Sph_Harmonics is not available because pyshtools is not installed.") + \ No newline at end of file diff --git a/swiftest/simulation_class.py b/swiftest/simulation_class.py index 55f4db28b..a7c2d0438 100644 --- a/swiftest/simulation_class.py +++ b/swiftest/simulation_class.py @@ -238,7 +238,7 @@ def __init__(self,read_param: bool = False, The name of the time unit. When setting one of the standard units via `TU` a name will be automatically set for the unit, so this argument will override the automatic name. Parameter input file equivalent is None - rmin : float, default value is the radius of the Sun in the unit system defined by the unit input arguments. + rmin : float, default value is the radius of the central body in the unit system defined by the unit input arguments. Minimum distance of the simulation Parameter input file equivalent are `CHK_QMIN`, `CHK_RMIN`, `CHK_QMIN_RANGE[0]` rmax : float, default value is 10000 AU in the unit system defined by the unit input arguments. @@ -448,8 +448,11 @@ def run(self, return # Save initial conditions - if not self.restart: + if self.restart: + self.save(framenum=-1) + else: self.clean() + self.save(framenum=0) # Write out the current parameter set before executing run self.write_param(verbose=False,**kwargs) @@ -776,7 +779,7 @@ def set_parameter(self, "MU_name": None, "DU_name": None, "TU_name": None, - "rmin": constants.RSun / constants.AU2M, + "rmin": None, "rmax": 10000.0, "qmin_coord": "HELIO", "gmtiny": 0.0, @@ -784,9 +787,9 @@ def set_parameter(self, "nfrag_reduction": 30.0, "close_encounter_check": True, "general_relativity": True, - "collision_model": "FRAGGLE", + "collision_model": "MERGE", "minimum_fragment_mass": None, - "minimum_fragment_gmass": 0.0, + "minimum_fragment_gmass": None, "rotation": True, "compute_conservation_values": False, "extra_force": False, @@ -819,8 +822,8 @@ def set_parameter(self, # Setters returning parameter dictionary values param_dict = {} - param_dict.update(self.set_integrator(**kwargs)) param_dict.update(self.set_unit_system(**kwargs)) + param_dict.update(self.set_integrator(**kwargs)) param_dict.update(self.set_simulation_time(**kwargs)) param_dict.update(self.set_init_cond_files(**kwargs)) param_dict.update(self.set_output_files(**kwargs)) @@ -851,12 +854,12 @@ def get_parameter(self, # Getters returning parameter dictionary values param_dict = {} + param_dict.update(self.get_unit_system(**kwargs)) param_dict.update(self.get_integrator(**kwargs)) param_dict.update(self.get_simulation_time(**kwargs)) param_dict.update(self.get_init_cond_files(**kwargs)) param_dict.update(self.get_output_files(**kwargs)) param_dict.update(self.get_distance_range(**kwargs)) - param_dict.update(self.get_unit_system(**kwargs)) param_dict.update(self.get_feature(**kwargs)) self.get_ephemeris_date(**kwargs) @@ -2008,7 +2011,8 @@ def _update_param_units(self, MU2KG_old, DU2M_old, TU2S_old): if CHK_QMIN_RANGE is not None: CHK_QMIN_RANGE = CHK_QMIN_RANGE.split(" ") for i, v in enumerate(CHK_QMIN_RANGE): - CHK_QMIN_RANGE[i] = float(CHK_QMIN_RANGE[i]) * self.param['DU2M'] / DU2M_old + if float(v) > 0.0: + CHK_QMIN_RANGE[i] = float(v) * DU2M_old / self.param['DU2M'] self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" if TU2S_old is not None: @@ -2150,6 +2154,7 @@ def add_solar_system_body(self, ephemeris_id: int | List[int] | None = None, date: str | None = None, source: str = "HORIZONS", + align_to_central_body_rotation: bool = False, **kwargs: Any ) -> None: """ @@ -2178,7 +2183,10 @@ def add_solar_system_body(self, set by `set_ephemeris_date`. source : str, default "Horizons" The source of the ephemerides. - Currently only the JPL Horizons ephemeris is implemented, so this is ignored. + Currently only the JPL Horizons ephemeris is implemented, so this is ignored. + align_to_central_body_rotation : bool, default False + If True, the cartesian coordinates will be aligned to the rotation pole of the central body. This is only valid for when + rotation is enabled. **kwargs : Any Additional keyword arguments to pass to the query method (i.e. astroquery.Horizons) @@ -2265,12 +2273,10 @@ def add_solar_system_body(self, dsnew = init_cond.vec2xr(self.param,**kwargs) - dsnew = self._combine_and_fix_dsnew(dsnew) + dsnew = self._combine_and_fix_dsnew(dsnew,align_to_central_body_rotation, **kwargs) if dsnew['id'].max(dim='name') > 0 and dsnew['name'].size > 0: self.save(verbose=False) - self.init_cond = self.data.copy(deep=True) - return def set_ephemeris_date(self, @@ -2420,8 +2426,12 @@ def add_body(self, rhill: float | List[float] | npt.NDArray[np.float_] | None=None, rot: List[float] | List[npt.NDArray[np.float_]] | npt.NDArray[np.float_] | None=None, Ip: List[float] | npt.NDArray[np.float_] | None=None, + rotphase: float | List[float] | npt.NDArray[np.float_] | None=None, J2: float | List[float] | npt.NDArray[np.float_] | None=None, - J4: float | List[float] | npt.NDArray[np.float_] | None=None + J4: float | List[float] | npt.NDArray[np.float_] | None=None, + c_lm: List[float] | List[npt.NDArray[np.float_]] | npt.NDArray[np.float_] | None = None, + align_to_central_body_rotation: bool = False, + **kwargs: Any ) -> None: """ Adds a body (test particle or massive body) to the internal DataSet given a set up 6 vectors (orbital elements @@ -2464,7 +2474,17 @@ def add_body(self, Rotation rate vectors if these are massive bodies with rotation enabled. Ip : (3) or (n,3) array-like of float, optional Principal axes moments of inertia vectors if these are massive bodies with rotation enabled. - + rotphase : float, optional + rotation phase angle in degreesif these are massive bodies with rotation enabled + J2 : float, optional + Normalized J2 values (e.g. J2*R**2, where R is the central body radius) if this is a central body (only one of J2 or c_lm can be passed) + J4 : float, optional + Normalized J4 values (e.g. J4*R**4, where R is the central body radius) if this is a central body (only one of J4 or c_lm can be passed) + c_lm : (2,l_max+1,l_max+1) array-like of float, optional + Spherical harmonics coefficients if this is a central body (only one of J2/J4 or c_lm can be passed) + align_to_central_body_rotation : bool, default False + If True, the cartesian coordinates will be aligned to the rotation pole of the central body. This is only valid for when + rotation is enabled. Returns ------- None @@ -2531,6 +2551,22 @@ def input_to_array_3d(val,n=None): val = val.T return val, n + + def input_to_clm_array(val, n): + # Create function to convert c_lm array to numpy array + if val is None: + return None, n + elif isinstance(val, np.ndarray): + pass + else: + try: + val = np.array(val,dtype=np.float64) + except: + raise ValueError(f"{val} cannot be converted to a numpy array") + ndims = len(val.shape) + if ndims != 3 or val.shape[0] != 2 or val.shape[1] != val.shape[2]: + raise ValueError(f'C_lm is an incorrect shape. Expected (2, l_max + 1, l_max + 1). got {val.shape} instead.') + return val, n nbodies = None name,nbodies = input_to_array(name,"s",nbodies) @@ -2552,6 +2588,9 @@ def input_to_array_3d(val,n=None): vh,nbodies = input_to_array_3d(vh,nbodies) rot,nbodies = input_to_array_3d(rot,nbodies) Ip,nbodies = input_to_array_3d(Ip,nbodies) + rotphase, nbodies = input_to_array(rotphase, "f", nbodies) + + c_lm, nbodies = input_to_clm_array(c_lm, nbodies) if len(self.data) == 0: maxid = -1 @@ -2576,18 +2615,55 @@ def input_to_array_3d(val,n=None): raise ValueError("Cannot use mass and Gmass inputs simultaneously!") else: Gmass = self.GU * mass - + + is_central_body = False + if J2 is not None or J4 is not None: + is_central_body = True + if c_lm is not None: + raise ValueError("Cannot use J2/J4 and c_lm inputs simultaneously!") + if c_lm is not None: + is_central_body = True + if J2 is not None or J4 is not None: + raise ValueError("Cannot use J2/J4 and c_lm inputs simultaneously!") + + if rh is not None and vh is None: + raise ValueError("If rh is passed, vh must also be passed") + if vh is not None and rh is None: + raise ValueError("If vh is passed, rh must also be passed") + + if rh is not None: + if a is not None or e is not None or inc is not None or capom is not None or omega is not None or capm is not None: + raise ValueError("Only cartesian values or orbital elements may be passed, but not both.") + if is_central_body: + if a is not None or e is not None or inc is not None or capom is not None or omega is not None or capm is not None: + raise ValueError("Orbital elements cannot be passed for a central body.") + if nbodies > 1: + raise ValueError("Only one central body may be passed.") + if self.param['IN_FORM'] == "XV": + if rh is None: + rh = np.zeros((1,3)) + if vh is None: + vh = np.zeros((1,3)) + elif self.param['IN_FORM'] == "EL": + a = np.array([np.nan]) + e = np.array([np.nan]) + inc = np.array([np.nan]) + capom = np.array([np.nan]) + omega = np.array([np.nan]) + capm = np.array([np.nan]) + dsnew = init_cond.vec2xr(self.param, name=name, a=a, e=e, inc=inc, capom=capom, omega=omega, capm=capm, id=id, - Gmass=Gmass, radius=radius, rhill=rhill, Ip=Ip, rh=rh, vh=vh,rot=rot, j2rp2=J2, j4rp4=J4, time=time) + Gmass=Gmass, radius=radius, rhill=rhill, Ip=Ip, rh=rh, vh=vh,rot=rot, j2rp2=J2, j4rp4=J4, c_lm=c_lm, rotphase=rotphase, time=time) - dsnew = self._combine_and_fix_dsnew(dsnew) + dsnew = self._combine_and_fix_dsnew(dsnew,align_to_central_body_rotation,**kwargs) self.save(verbose=False) - self.init_cond = self.data.copy(deep=True) return def _combine_and_fix_dsnew(self, - dsnew: xr.Dataset + dsnew: xr.Dataset, + align_to_central_body_rotation: bool = False, + **kwargs: Any ) -> xr.Dataset: """ Combines the new Dataset with the old one. Also computes the values of ntp and npl and sets the proper types. @@ -2596,6 +2672,9 @@ def _combine_and_fix_dsnew(self, ---------- dsnew : xarray Dataset Dataset with new bodies + align_to_central_body_rotation : bool, default False + If True, the cartesian coordinates will be aligned to the rotation pole of the central body. This is only valid for when + rotation is enabled. Returns ------- @@ -2622,6 +2701,7 @@ def _combine_and_fix_dsnew(self, dsnew = io.fix_types(dsnew, ftype=np.float32) self.data = io.fix_types(self.data, ftype=np.float32) + self.set_central_body(align_to_central_body_rotation) def get_nvals(ds): if "name" in ds.dims: count_dim = "name" @@ -2641,6 +2721,7 @@ def get_nvals(ds): dsnew = get_nvals(dsnew) self.data = get_nvals(self.data) + self.data = self.data.sortby("id") self.data = io.reorder_dims(self.data) @@ -2873,7 +2954,7 @@ def read_output_file(self, param_tmp['BIN_OUT'] = self.simdir / self.param['NC_IN'] self.init_cond = io.swiftest2xr(param_tmp, verbose=False, dask=dask) else: - self.init_cond = self.data.isel(time=0) + self.init_cond = self.data.isel(time=[0]).copy(deep=True) if self.read_encounters: self.read_encounter_file(dask=dask) @@ -3044,6 +3125,8 @@ def save(self, if not self.simdir.exists(): self.simdir.mkdir(parents=True, exist_ok=True) + + self.init_cond = self.data.isel(time=[framenum]).copy(deep=True) if codename == "Swiftest": infile_name = Path(self.simdir) / param['NC_IN'] @@ -3060,7 +3143,7 @@ def save(self, return - def initial_conditions_from_bin(self, + def initial_conditions_from_data(self, framenum: int=-1, new_param: os.PathLike=None, new_param_file: os.PathLike="param.new.in", @@ -3163,3 +3246,63 @@ def clean(self): os.remove(f) return + def set_central_body(self, + align_to_central_body_rotation: bool = False, + **kwargs: Any): + """ + Sets the central body to be the most massive body in the dataset. Cartesian position and velocity Cartesian coordinates are rotated If align_to_central_body_rotation is True, the rotation pole is set to the z-axis. + + Parameters + ---------- + align_to_central_body_rotation : bool, default False + If True, the rotation pole is set to the z-axis. + + Returns + ------- + None + + """ + + if "Gmass" not in self.data: + warnings.warn("No bodies with Gmass values found in dataset. Cannot set central body.",stacklevel=2) + return + + cbid = self.data.Gmass.argmax().values[()] + if 'name' in self.data.dims: + cbidx = self.data.id.isel(name=cbid).values[()] + cbname = self.data.name.isel(name=cbid).values[()] + elif 'id' in self.data.dims: + cbidx = self.data.id.isel(id=cbid).values[()] + cbname = self.data.name.isel(id=cbid).values[()] + else: + raise ValueError("No 'name' or 'id' dimensions found in dataset.") + + if cbidx != 0: + if 'name' in self.data.dims: + if 0 in self.data.id.values: + name_0 = self.data.name.where(self.data.id == 0, drop=True).values[()] + self.data['id'].loc[dict(name=name_0)] = cbidx + self.data['id'].loc[dict(name=cbname)] = 0 + else: + if 0 in self.data.id.values: + self.data['id'].loc[dict(id=0)] = cbidx + self.data['id'].loc[dict(id=cbidx)] = 0 + + # Ensure that the central body is at the origin + if 'name' in self.data.dims: + cbda = self.data.sel(name=cbname) + else: + cbda = self.data.sel(id=cbidx) + + pos_skip = ['space','Ip','rot'] + for var in self.data.variables: + if 'space' in self.data[var].dims and var not in pos_skip: + self.data[var] -= cbda[var] + + if align_to_central_body_rotation and 'rot' in cbda: + self.data = tool.rotate_to_vector(self.data,cbda.rot.isel(time=0).values[()]) + + if self.param['CHK_CLOSE']: + if 'CHK_RMIN' not in self.param: + self.param['CHK_RMIN'] = cbda.radius.values.item() + return \ No newline at end of file diff --git a/swiftest/tool.py b/swiftest/tool.py index 083945dd3..159e45b5b 100644 --- a/swiftest/tool.py +++ b/swiftest/tool.py @@ -11,6 +11,8 @@ import numpy as np import xarray as xr +from scipy.spatial.transform import Rotation as R + def magnitude(ds,x): """ Computes the magnitude of a vector quantity from a Dataset. @@ -420,7 +422,7 @@ def xv2el_one(mu,rvec,vvec): argument of periapsis (degrees) M : float mean anomaly (degrees) - varpi : flaot + varpi : float longitude of periapsis (degrees) f : float true anomaly (degrees) @@ -507,4 +509,71 @@ def xv2el_vec(mu, rvec, vvec): """ vecfunc = np.vectorize(xv2el_one, signature='(),(3),(3)->(),(),(),(),(),(),(),(),()') - return vecfunc(mu, rvec, vvec) \ No newline at end of file + return vecfunc(mu, rvec, vvec) + + +def rotate_to_vector(ds, new_pole, skip_vars=['space','Ip']): + """ + Rotates the coordinate system such that the z-axis is aligned with an input pole. The new pole is defined by the input vector. + This will change all variables in the Dataset that have the "space" dimension, except for those passed to the skip_vars parameter. + + Parameters + ---------- + ds : Xarray Dataset + Dataset containing the vector quantity + new_pole : (3) float array + New pole vector + skip_vars : list of str, optional + List of variable names to skip. The default is ['space','Ip']. + + Returns + ------- + ds : Xarray Dataset + Dataset with the new pole vector applied to all variables with the "space" dimension + """ + + if 'space' not in ds.dims: + print("No space dimension in Dataset") + return ds + + # Verify that the new pole is a 3-element array + if len(new_pole) != 3: + print("New pole must be a 3-element array") + return ds + + # Normalize the new pole vector to ensure it is a unit vector + pole_mag = np.linalg.norm(new_pole) + unit_pole = new_pole / pole_mag + + # Define the original and target vectors + target_vector = np.array([0, 0, 1]) # Rotate so that the z-axis is aligned with the new pole + original_vector = unit_pole.reshape(1, 3) + + # Use align_vectors to get the rotation that aligns the z-axis with Mars_rot + rotation, _ = R.align_vectors(target_vector, original_vector) + + # Define a function to apply the rotation, which will be used with apply_ufunc + def apply_rotation(vector, rotation): + return rotation.apply(vector) + + # Function to apply rotation to a DataArray + def rotate_dataarray(da, rotation): + return xr.apply_ufunc( + apply_rotation, + da, + kwargs={'rotation': rotation}, + input_core_dims=[['space']], + output_core_dims=[['space']], + vectorize=True, + dask='parallelized', + output_dtypes=[da.dtype] + ) + + # Loop through each variable in the dataset and apply the rotation if 'space' dimension is present + for var in ds.variables: + if 'space' in ds[var].dims and var not in skip_vars: + ds[var] = rotate_dataarray(ds[var], rotation) + + return ds + + \ No newline at end of file diff --git a/version.txt b/version.txt index dbe03d474..032892e0c 100644 --- a/version.txt +++ b/version.txt @@ -1 +1 @@ -2023.12.2 \ No newline at end of file +2024.2.0 \ No newline at end of file